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