1! { dg-do run } 2! { dg-options "-std=f2008 " } 3 4! PR fortran/34162 5! Internal procedures as actual arguments (like restricted closures). 6! More challenging test involving recursion. 7 8! Contributed by Daniel Kraft, d@domob.eu. 9 10MODULE m 11 IMPLICIT NONE 12 13 ABSTRACT INTERFACE 14 FUNCTION returnValue () 15 INTEGER :: returnValue 16 END FUNCTION returnValue 17 END INTERFACE 18 19 PROCEDURE(returnValue), POINTER :: first 20 21CONTAINS 22 23 RECURSIVE SUBROUTINE test (level, current, previous) 24 INTEGER, INTENT(IN) :: level 25 PROCEDURE(returnValue), OPTIONAL :: previous, current 26 27 IF (PRESENT (current)) THEN 28 IF (current () /= level - 1) STOP 1 29 END IF 30 31 IF (PRESENT (previous)) THEN 32 IF (previous () /= level - 2) STOP 2 33 END IF 34 35 IF (level == 1) THEN 36 first => myLevel 37 END IF 38 IF (first () /= 1) STOP 3 39 40 IF (level == 10) RETURN 41 42 IF (PRESENT (current)) THEN 43 CALL test (level + 1, myLevel, current) 44 ELSE 45 CALL test (level + 1, myLevel) 46 END IF 47 48 CONTAINS 49 50 FUNCTION myLevel () 51 INTEGER :: myLevel 52 myLevel = level 53 END FUNCTION myLevel 54 55 END SUBROUTINE test 56 57END MODULE m 58 59PROGRAM main 60 USE :: m 61 IMPLICIT NONE 62 63 CALL test (1) 64END PROGRAM main 65