view gcc/testsuite/gfortran.dg/submodule_30.f08 @ 144:8f4e72ab4e11

fix segmentation fault caused by nothing next cur_op to end
author Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 21:23:56 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { dg-do run }
!
! Test the fix for PR82550 in which the reference to 'p' in 'foo'
! was not being correctly handled.
!
! Contributed by Reinhold Bader  <Bader@lrz.de>
!
module m_subm_18_pos
  implicit none
  integer :: i = 0
  interface
    module subroutine foo(fun_ptr)
      procedure(p), pointer, intent(out) :: fun_ptr
    end subroutine
  end interface
contains
  subroutine p()
    i = 1
  end subroutine p
end module m_subm_18_pos
submodule (m_subm_18_pos) subm_18_pos
    implicit none
contains
    module subroutine foo(fun_ptr)
      procedure(p), pointer, intent(out) :: fun_ptr
      fun_ptr => p
    end subroutine
end submodule
program p_18_pos
  use m_subm_18_pos
  implicit none
  procedure(), pointer :: x
  call foo(x)
  call x()
  if (i == 1) then
     write(*,*) 'OK'
  else
     write(*,*) 'FAIL'
     STOP 1
  end if
end program p_18_pos