! { dg-do run } ! { dg-options "-std=f2008 -fall-intrinsics" } ! 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) CALL abort () END IF IF (PRESENT (previous)) THEN IF (previous () /= level - 2) CALL abort () END IF IF (level == 1) THEN first => myLevel END IF IF (first () /= 1) CALL abort () 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