https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100183
Bug ID: 100183 Summary: Segmentation fault at runtime when passing an internal procedure as argument Product: gcc Version: 10.2.1 Status: UNCONFIRMED Severity: normal Priority: P3 Component: fortran Assignee: unassigned at gcc dot gnu.org Reporter: jellby at yahoo dot com Target Milestone: --- I've only been able to reproduce it with: $ uname -a Darwin minimac.moose.housegordon.com 20.3.0 Darwin Kernel Version 20.3.0: Thu Jan 21 00:06:51 PST 2021; root:xnu-7195.81.3~1/RELEASE_ARM64_T8101 arm64 $ gfortran -version GNU Fortran (Homebrew GCC 10.2.0_4) 10.2.1 20201220 Compiling and running the following code works fine, but with -O1 it gives a segmentation fault. Alternatively, undefining INTERNAL_PROC_ARG works with -O1. $ cat test.F90 #define INTERNAL_PROC_ARG [45/90681] module sorting implicit none private public :: argsort real, pointer :: mod_rV(:) interface logical pure function compare_int_t(a, b) integer, intent(in) :: a, b end function end interface contains logical pure function my_compare_rV(x, y) integer, intent(in) :: x, y my_compare_rV = mod_rV(x) <= mod_rV(y) end function function argsort(V) result(idx) real, target, intent(inout) :: V(:) integer :: idx(lbound(V, 1):ubound(V, 1)), i idx = [(i, i = lbound(V, 1), ubound(V, 1))] # ifdef INTERNAL_PROC_ARG call sort(idx, my_compare) # else mod_rV => V call sort(idx, my_compare_rV) # endif contains logical pure function my_compare(x, y) integer, intent(in) :: x, y my_compare = V(x) <= V(y) end function end function argsort subroutine sort(A, compare) integer, intent(inout) :: A(:) procedure(compare_int_t) :: compare integer :: i, j, t do i = lbound(A, 1), ubound(A, 1) do j = i + 1, ubound(A, 1) if (.not. compare(A(i), A(j))) then t = A(i) A(i) = A(j) A(j) = t end if end do end do end subroutine sort end module sorting program test use sorting, only: argsort implicit none integer :: i integer, parameter :: seed(50) = [(i, i = 1, size(seed))] real :: lambdas(5) integer :: idx(size(lambdas)) call random_seed(put=seed) call random_number(lambdas) write(6,*) 'Before sorting:' write(6,*) lambdas(:) idx(:) = argsort(lambdas) write(6,*) 'Argsort:' write(6,*) idx(:) write(6,*) 'Sorted:' write(6,*) lambdas(idx(:)) end program test $ gfortran -O1 test.F90 -o test ; ./test Before sorting: 0.471070886 0.117344737 0.357547939 0.318134785 0.696753800 zsh: segmentation fault ./test $ gfortran -O0 test.F90 -o test ; ./test Before sorting: 0.471070886 0.117344737 0.357547939 0.318134785 0.696753800 Argsort: 2 4 3 1 5 Sorted: 0.117344737 0.318134785 0.357547939 0.471070886 0.696753800