67 lines
1.6 KiB
Fortran
67 lines
1.6 KiB
Fortran
! { 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
|
|
|
|
! { dg-final { cleanup-modules "m" } }
|