gcc/testsuite/gfortran.dg/proc_ptr_common_1.f90

   1 ! { dg-do run }
   2
   3 ! PR fortran/36592
   4 !
   5 ! Procedure Pointers inside COMMON blocks.
   6 !
   7 ! Contributed by Janus Weil <janus@gcc.gnu.org>.
   8
   9 subroutine one()
  10   implicit none
  11   common /com/ p1,p2,a,b
  12   procedure(real), pointer :: p1,p2
  13   integer :: a,b
  14   if (a/=5 .or. b/=-9 .or. p1(0.0)/=1.0 .or. p2(0.0)/=0.0) call abort()
  15 end subroutine one
  16
  17 program main
  18   implicit none
  19   integer :: x,y
  20   intrinsic sin,cos
  21   procedure(real), pointer :: func1
  22   real, external :: func2
  23   pointer func2
  24   common /com/ func1,func2,x,y
  25   x = 5
  26   y = -9
  27   func1 => cos
  28   func2 => sin
  29   call one()
  30 end program main
  31