diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/internal_dummy_2.f08')
-rw-r--r-- | gcc/testsuite/gfortran.dg/internal_dummy_2.f08 | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/internal_dummy_2.f08 b/gcc/testsuite/gfortran.dg/internal_dummy_2.f08 new file mode 100644 index 000000000..7ec6ad4c6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_dummy_2.f08 @@ -0,0 +1,64 @@ +! { dg-do run } +! { dg-options "-std=f2008 -fall-intrinsics" } + +! PR fortran/34162 +! Internal procedures as actual arguments (like restricted closures). +! Check it works basically. + +! Contributed by Daniel Kraft, d@domob.eu. + +MODULE m + IMPLICIT NONE + + ABSTRACT INTERFACE + FUNCTION returnValue () + INTEGER :: returnValue + END FUNCTION returnValue + + SUBROUTINE doSomething () + END SUBROUTINE doSomething + END INTERFACE + +CONTAINS + + FUNCTION callIt (proc) + PROCEDURE(returnValue) :: proc + INTEGER :: callIt + + callIt = proc () + END FUNCTION callIt + + SUBROUTINE callSub (proc) + PROCEDURE(doSomething) :: proc + + CALL proc () + END SUBROUTINE callSub + +END MODULE m + +PROGRAM main + USE :: m + IMPLICIT NONE + + INTEGER :: a + + a = 42 + IF (callIt (myA) /= 42) CALL abort () + + CALL callSub (incA) + IF (a /= 43) CALL abort () + +CONTAINS + + FUNCTION myA () + INTEGER :: myA + myA = a + END FUNCTION myA + + SUBROUTINE incA () + a = a + 1 + END SUBROUTINE incA + +END PROGRAM main + +! { dg-final { cleanup-modules "m" } } |