1! { dg-do compile }
2
3! PR fortran/37779
4! Check that a call to a procedure's containing procedure counts as recursive
5! and is rejected if the containing procedure is not RECURSIVE.
6
7MODULE m
8  IMPLICIT NONE
9
10CONTAINS
11
12  SUBROUTINE test_sub ()
13    CALL bar ()
14  CONTAINS
15    SUBROUTINE bar ()
16      IMPLICIT NONE
17      PROCEDURE(test_sub), POINTER :: procptr
18
19      CALL test_sub () ! { dg-error "not RECURSIVE" }
20      procptr => test_sub ! { dg-warning "Non-RECURSIVE" }
21      CALL foobar (test_sub) ! { dg-warning "Non-RECURSIVE" }
22    END SUBROUTINE bar
23  END SUBROUTINE test_sub
24
25  INTEGER FUNCTION test_func () RESULT (x)
26    x = bar ()
27  CONTAINS
28    INTEGER FUNCTION bar ()
29      IMPLICIT NONE
30      PROCEDURE(test_func), POINTER :: procptr
31
32      bar = test_func () ! { dg-error "not RECURSIVE" }
33      procptr => test_func ! { dg-warning "Non-RECURSIVE" }
34      CALL foobar (test_func) ! { dg-warning "Non-RECURSIVE" }
35    END FUNCTION bar
36  END FUNCTION test_func
37
38  SUBROUTINE sub_entries ()
39  ENTRY sub_entry_1 ()
40  ENTRY sub_entry_2 ()
41    CALL bar ()
42  CONTAINS
43    SUBROUTINE bar ()
44      CALL sub_entry_1 () ! { dg-error "is not RECURSIVE" }
45    END SUBROUTINE bar
46  END SUBROUTINE sub_entries
47
48  INTEGER FUNCTION func_entries () RESULT (x)
49  ENTRY func_entry_1 () RESULT (x)
50  ENTRY func_entry_2 () RESULT (x)
51    x = bar ()
52  CONTAINS
53    INTEGER FUNCTION bar ()
54      bar = func_entry_1 () ! { dg-error "is not RECURSIVE" }
55    END FUNCTION bar
56  END FUNCTION func_entries
57
58  SUBROUTINE main ()
59    CALL test_sub ()
60    CALL sub_entries ()
61    PRINT *, test_func (), func_entries ()
62  END SUBROUTINE main
63
64END MODULE m
65