re PR fortran/33499 (Rejects valid module with a contained function with an ENTRY)

2007-11-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33499
	* decl.c (get_proc_name): If ENTRY statement occurs before type
	specification, set the symbol untyped and ensure that it is in
	the procedure namespace.

2007-11-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33499
	* gfortran.dg/entry_16.f90: New test.

From-SVN: r130403

4 files changed, 73 insertions, 9 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aedee5e..3f36021 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-11-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33499
+	* decl.c (get_proc_name): If ENTRY statement occurs before type
+	specification, set the symbol untyped and ensure that it is in
+	the procedure namespace.
+
 2007-11-24  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/33541
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d66ea53..ca17829 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -715,9 +715,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
 
       if (*result == NULL)
 	rc = gfc_get_symbol (name, NULL, result);
-      else if (gfc_get_symbol (name, NULL, &sym) == 0
-		 && sym
-		 && sym->ts.type != BT_UNKNOWN
+      else if (!gfc_get_symbol (name, NULL, &sym) && sym
 		 && (*result)->ts.type == BT_UNKNOWN
 		 && sym->attr.flavor == FL_UNKNOWN)
 	/* Pick up the typespec for the entry, if declared in the function
@@ -726,13 +724,24 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
 	   is set to point to the module symbol and a unique symtree
 	   to the local version.  This latter ensures a correct clearing
 	   of the symbols.  */
-	  {
+	{
+	  /* If the ENTRY proceeds its specification, we need to ensure
+	     that this does not raise a "has no IMPLICIT type" error.  */
+	  if (sym->ts.type == BT_UNKNOWN)
+		sym->attr.untyped = 1;
+
 	    (*result)->ts = sym->ts;
-	    gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
-	    st->n.sym = *result;
-	    st = gfc_get_unique_symtree (gfc_current_ns);
-	    st->n.sym = sym;
-	  }
+
+	  /* Put the symbol in the procedure namespace so that, should
+	     the ENTRY preceed its specification, the specification
+	     can be applied.  */
+	  (*result)->ns = gfc_current_ns;
+
+	  gfc_find_sym_tree (name, gfc_current_ns, 0, &st);
+	  st->n.sym = *result;
+	  st = gfc_get_unique_symtree (gfc_current_ns);
+	  st->n.sym = sym;
+	}
     }
   else
     rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c09ab0d..9ec0be0 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-11-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33499
+	* gfortran.dg/entry_16.f90: New test.
+
 2007-11-24  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/34192
diff --git a/gcc/testsuite/gfortran.dg/entry_16.f90 b/gcc/testsuite/gfortran.dg/entry_16.f90
new file mode 100644
index 0000000..ba8eff8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_16.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! Tests the fix for PR33499 in which the ENTRY cx_radc was not
+! getting its TYPE.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE complex
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC :: cx, OPERATOR(+), OPERATOR(.eq.)
+  TYPE cx
+    integer :: re
+    integer :: im
+  END TYPE cx
+  INTERFACE OPERATOR (+)
+    MODULE PROCEDURE cx_cadr, cx_radc
+  END INTERFACE
+  INTERFACE OPERATOR (.eq.)
+    MODULE PROCEDURE cx_eq
+  END INTERFACE
+  CONTAINS
+  FUNCTION cx_cadr(z, r)
+  ENTRY cx_radc(r, z)
+    TYPE (cx) :: cx_cadr, cx_radc
+    TYPE (cx), INTENT(IN) :: z
+    integer, INTENT(IN) :: r
+    cx_cadr%re = z%re + r
+    cx_cadr%im = z%im
+  END FUNCTION cx_cadr
+  FUNCTION cx_eq(u, v)
+    TYPE (cx), INTENT(IN) :: u, v
+    logical :: cx_eq
+    cx_eq = (u%re .eq. v%re) .and. (u%im .eq. v%im)
+  END FUNCTION cx_eq
+END MODULE complex
+
+  use complex
+  type(cx) :: a = cx (1, 2), c, d
+  logical :: f
+  integer :: b = 3
+  if (.not.((a + b) .eq. (b + a))) call abort ()
+  if (.not.((a + b) .eq. cx (4, 2))) call abort ()
+end