From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/recursive_check_6.f03 | 66 +++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/recursive_check_6.f03

(limited to 'gcc/testsuite/gfortran.dg/recursive_check_6.f03')

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" } }
-- 
cgit v1.2.3