gcc/testsuite/gfortran.dg/internal_dummy_2.f08

   1 ! { dg-do run }
   2 ! [ dg-options "-std=f2008" }
   3
   4 ! PR fortran/34162
   5 ! Internal procedures as actual arguments (like restricted closures).
   6 ! Check it works basically.
   7
   8 ! Contributed by Daniel Kraft, d@domob.eu.
   9
  10 MODULE m
  11   IMPLICIT NONE
  12
  13   ABSTRACT INTERFACE
  14     FUNCTION returnValue ()
  15       INTEGER :: returnValue
  16     END FUNCTION returnValue
  17
  18     SUBROUTINE doSomething ()
  19     END SUBROUTINE doSomething
  20   END INTERFACE
  21
  22 CONTAINS
  23
  24   FUNCTION callIt (proc)
  25     PROCEDURE(returnValue) :: proc
  26     INTEGER :: callIt
  27
  28     callIt = proc ()
  29   END FUNCTION callIt
  30
  31   SUBROUTINE callSub (proc)
  32     PROCEDURE(doSomething) :: proc
  33
  34     CALL proc ()
  35   END SUBROUTINE callSub
  36
  37 END MODULE m
  38
  39 PROGRAM main
  40   USE :: m
  41   IMPLICIT NONE
  42
  43   INTEGER :: a
  44
  45   a = 42
  46   IF (callIt (myA) /= 42) CALL abort ()
  47
  48   CALL callSub (incA)
  49   IF (a /= 43) CALL abort ()
  50
  51 CONTAINS
  52
  53   FUNCTION myA ()
  54     INTEGER :: myA
  55     myA = a
  56   END FUNCTION myA
  57
  58   SUBROUTINE incA ()
  59     a = a + 1
  60   END SUBROUTINE incA
  61
  62 END PROGRAM main
  63
  64 ! { dg-final { cleanup-modules "m" } }