Subversion Repositories openrisc

! { 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" } }