blob: 48302cf30245a4da1646f9dd4531e79b6f8e3a0f [file] [log] [blame]
! { dg-do run }
! { dg-options "-std=f2008 " }
! PR fortran/34162
! Internal procedures as actual arguments (like restricted closures).
! More challenging test involving recursion.
! Contributed by Daniel Kraft, d@domob.eu.
MODULE m
IMPLICIT NONE
ABSTRACT INTERFACE
FUNCTION returnValue ()
INTEGER :: returnValue
END FUNCTION returnValue
END INTERFACE
PROCEDURE(returnValue), POINTER :: first
CONTAINS
RECURSIVE SUBROUTINE test (level, current, previous)
INTEGER, INTENT(IN) :: level
PROCEDURE(returnValue), OPTIONAL :: previous, current
IF (PRESENT (current)) THEN
IF (current () /= level - 1) STOP 1
END IF
IF (PRESENT (previous)) THEN
IF (previous () /= level - 2) STOP 2
END IF
IF (level == 1) THEN
first => myLevel
END IF
IF (first () /= 1) STOP 3
IF (level == 10) RETURN
IF (PRESENT (current)) THEN
CALL test (level + 1, myLevel, current)
ELSE
CALL test (level + 1, myLevel)
END IF
CONTAINS
FUNCTION myLevel ()
INTEGER :: myLevel
myLevel = level
END FUNCTION myLevel
END SUBROUTINE test
END MODULE m
PROGRAM main
USE :: m
IMPLICIT NONE
CALL test (1)
END PROGRAM main