[Bug fortran/100183] New: Segmentation fault at runtime when passing an internal procedure as argument

[jellby at yahoo dot com]

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