Calling qsort from C

The following code reproduces a segfault I’m getting with pgfortran. It’s a reduced version of a larger code that works fine with gfortran and ifort, but that I cannot yet run with pgi. I’m wondering whether it’s a compiler bug, and/or if there are any workarounds.

Note my code often uses the ‘host-association function’ type approach shown in sort_index_cint below - so I’d prefer workarounds that are consistent with that.

module qsort_mod
    use iso_c_binding

    implicit none

    private
    public :: sort_index_cint, test_qsort_mod

    interface

        ! Call qsort from C
        subroutine qsort_C(array,elem_count,elem_size,compare) bind(C,name="qsort")
          import c_ptr, c_size_t, c_funptr
          type(c_ptr), value       :: array
          integer(c_size_t), value :: elem_count
          integer(c_size_t), value :: elem_size
          type(c_funptr), value    :: compare !int(*compare)(const void *, const void *)
        end subroutine qsort_C !standard C library qsort

    end interface


    contains

    !
    ! A basic argsort
    ! Return 'inds' such that array(inds(i)) <= array(inds(i+1))
    !
    subroutine sort_index_cint(inds, array, n)
        integer(c_int), intent(in) :: n
        integer(c_int), intent(in) :: array(n)
        integer(c_int), intent(inout), target :: inds(n)

        integer(c_size_t) :: elem_count, elem_size 
        integer(c_int) :: i
 
        inds = (/ (i, i=1, n) /)

        elem_count = int(n, c_size_t)
        elem_size = int( storage_size(inds(1))/8, c_size_t)
      
        call qsort_C(c_loc(inds(1)), elem_count, elem_size, c_funloc(compar3))
    
        contains
            ! Comparison function, uses 'array(n)' by host association
            integer(c_int) function compar3(i1, i2) bind(C)
                integer(c_int) :: i1, i2
        
                if(array(i1) > array(i2)) compar3 = 1_c_int
                if(array(i1) == array(i2)) compar3 = 0_c_int
                if(array(i1) < array(i2)) compar3 = -1_c_int

            end function

    end subroutine 

    !
    ! Unit test
    !
    subroutine test_qsort_mod()

        integer(c_int) :: x(10), sorted_x(10), index_order_x(10), inds(10)

        ! Sort of integers
        x = [1, 3, 2, 5, 4, 7, 6, 9, 8, 1] 
        call sort_index_cint(inds, x, 10)

        ! The values we expect
        sorted_x = [1, 1, 2, 3, 4, 5, 6, 7, 8, 9]
        index_order_x = [1, 10, 3, 2, 5, 4, 7, 6, 9, 8]

        if(all(inds - index_order_x == 0)) then
            print*, 'PASS'
        else
            print*, 'FAIL'
         endif

    end subroutine
end module

program run
    use qsort_mod
    call test_qsort_mod
end program

I compile and run like this:
$ pgfortran qsort_mod.f90
$ ./a.out
Segmentation fault (core dumped)

A similar approach works with gfortran:
$ gfortran qsort_mod.f90
$ ./a.out
PASS

Thanks

Hi Gareth1234,

I believe the problem here is that you’re using a F2008 feature that we don’t support as of yet. In F2003, contained subroutines could only be called by the parent or other subroutines contained by the same parent. Hence your code would not be legal in F2003. F2008 lifted this restriction and allows other external routines to call contained subroutines. While we do support some F2008 features, this is one we have not yet implemented.

We are in the process of rewriting our Fortran compiler as part of the Flang F18 project (https://github.com/flang-compiler/f18), which will support F2018 (as well as full F2008). Hence, we don’t plan on adding this feature to our current Fortran compiler until we make the switch to F18. Though, it’s still to be determined when this switch will occur.

-Mat