! { dg-do compile } ! PR fortran/37779 ! Check that a call to a procedure's containing procedure counts as recursive ! and is rejected if the containing procedure is not RECURSIVE. MODULE m IMPLICIT NONE CONTAINS SUBROUTINE test_sub () CALL bar () CONTAINS SUBROUTINE bar () IMPLICIT NONE PROCEDURE(test_sub), POINTER :: procptr CALL test_sub () ! { dg-error "not RECURSIVE" } procptr => test_sub ! { dg-warning "Non-RECURSIVE" } CALL foobar (test_sub) ! { dg-warning "Non-RECURSIVE" } END SUBROUTINE bar END SUBROUTINE test_sub INTEGER FUNCTION test_func () RESULT (x) x = bar () CONTAINS INTEGER FUNCTION bar () IMPLICIT NONE PROCEDURE(test_func), POINTER :: procptr bar = test_func () ! { dg-error "not RECURSIVE" } procptr => test_func ! { dg-warning "Non-RECURSIVE" } CALL foobar (test_func) ! { dg-warning "Non-RECURSIVE" } END FUNCTION bar END FUNCTION test_func SUBROUTINE sub_entries () ENTRY sub_entry_1 () ENTRY sub_entry_2 () CALL bar () CONTAINS SUBROUTINE bar () CALL sub_entry_1 () ! { dg-error "is not RECURSIVE" } END SUBROUTINE bar END SUBROUTINE sub_entries INTEGER FUNCTION func_entries () RESULT (x) ENTRY func_entry_1 () RESULT (x) ENTRY func_entry_2 () RESULT (x) x = bar () CONTAINS INTEGER FUNCTION bar () bar = func_entry_1 () ! { dg-error "is not RECURSIVE" } END FUNCTION bar END FUNCTION func_entries SUBROUTINE main () CALL test_sub () CALL sub_entries () PRINT *, test_func (), func_entries () END SUBROUTINE main END MODULE m