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