1 files changed, 66 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/recursive_check_6.f03 b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
new file mode 100644
index 000000000..478539e6a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/recursive_check_6.f03
@@ -0,0 +1,66 @@
+! { 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" } }