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