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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aedee5e979d27a25273a2ad5d73dbca03a91ca41..3f36021c0a1a60e21dd596bdd8cac8577e80ec90 100644 (file)
--- 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 d66ea533ca7cf3e655d75a7bbdb52a775da53553..ca17829cb872ccb10bca27036a0d647a7111d3a4 100644 (file)
--- 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 c09ab0d08b09b934c995b0f85198fdaeba67aa8b..9ec0be0e38edf2e36ce694296598eb6812605792 100644 (file)
--- 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 (file)
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