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