gcc/testsuite/gfortran.dg/proc_ptr_20.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 40450: [F03] procedure pointer as actual argument
   4 !
   5 ! Contributed by John McFarland <john.mcfarland@swri.org>
   6
   7 MODULE m
   8  ABSTRACT INTERFACE
   9  SUBROUTINE sub()
  10  END SUBROUTINE sub
  11  END INTERFACE
  12
  13 CONTAINS
  14
  15  SUBROUTINE passf(f2)
  16    PROCEDURE(sub), POINTER:: f2
  17    CALL callf(f2)
  18  END SUBROUTINE passf
  19
  20  SUBROUTINE callf(f3)
  21    PROCEDURE(sub), POINTER :: f3
  22    PRINT*, 'calling f'
  23    CALL f3()
  24  END SUBROUTINE callf
  25 END MODULE m
  26
  27
  28 PROGRAM prog
  29  USE m
  30  PROCEDURE(sub), POINTER :: f1
  31  f1 => s
  32  CALL passf(f1)
  33
  34 CONTAINS
  35
  36  SUBROUTINE s
  37    PRINT*, 'sub'
  38  END SUBROUTINE s
  39 END PROGRAM prog
  40
  41 ! { dg-final { cleanup-modules "m" } }
  42