URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [recursive_check_6.f03] - Rev 312
Go to most recent revision | Compare with Previous | Blame | View Log
! { 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" } }
Go to most recent revision | Compare with Previous | Blame | View Log