re PR fortran/31214 (User-defined operator using entry leads to ICE)

2007-08-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31214
	* symbol.c (get_unique_symtree): Moved from module.c.
	* module.c (get_unique_symtree): Moved to symbol.c.
	* decl.c (get_proc_name): Transfer the typespec from the local
	symbol to the module symbol, in the case that an entry is also
	a module procedure.  Ensure the local symbol is cleaned up by
	pointing to it with a unique symtree.

	* dump_parse_tree (gfc_show_code_node): Add EXEC_ASSIGN_CALL.

2007-08-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31214
	* gfortran.dg/entry_13.f90: New test.

	* gfortran.dg/entry_12.f90: Clean up .mod file.

From-SVN: r127213

6 files changed, 45 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e29300..e9b2ed3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-08-04  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31214
+	* gfortran.dg/entry_13.f90: New test.
+
+	* gfortran.dg/entry_12.f90: Clean up .mod file.
+
 2008-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/32969
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a94085f..d674aeb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -681,8 +681,27 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
     {
       /* Present if entry is declared to be a module procedure.  */
       rc = gfc_find_symbol (name, gfc_current_ns->parent, 0, result);
+
       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
+		 && (*result)->ts.type == BT_UNKNOWN
+		 && sym->attr.flavor == FL_UNKNOWN)
+	/* Pick up the typespec for the entry, if declared in the function
+	   body.  Note that this symbol is FL_UNKNOWN because it will
+	   only have appeared in a type declaration.  The local symtree
+	   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.  */
+	  {
+	    (*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;
+	  }
     }
   else
     rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c99fc42..ac6a6f5 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1084,6 +1084,7 @@ gfc_show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_CALL:
+    case EXEC_ASSIGN_CALL:
       if (c->resolved_sym)
 	gfc_status ("CALL %s ", c->resolved_sym->name);
       else if (c->symtree)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a87366f..329fae2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2124,6 +2124,7 @@ gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
 gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
 gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
 gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
+gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
 void gfc_free_symbol (gfc_symbol *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index fc30eae..baba5c7 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1822,20 +1822,6 @@ mio_charlen (gfc_charlen **clp)
 }
 
 
-/* Return a symtree node with a name that is guaranteed to be unique
-   within the namespace and corresponds to an illegal fortran name.  */
-
-static gfc_symtree *
-get_unique_symtree (gfc_namespace *ns)
-{
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  static int serial = 0;
-
-  sprintf (name, "@%d", serial++);
-  return gfc_new_symtree (&ns->sym_root, name);
-}
-
-
 /* See if a name is a generated name.  */
 
 static int
@@ -2287,7 +2273,7 @@ mio_symtree_ref (gfc_symtree **stp)
       if (in_load_equiv && p->u.rsym.symtree == NULL)
 	{
 	  /* Since this is not used, it must have a unique name.  */
-	  p->u.rsym.symtree = get_unique_symtree (gfc_current_ns);
+	  p->u.rsym.symtree = gfc_get_unique_symtree (gfc_current_ns);
 
 	  /* Make the symbol.  */
 	  if (p->u.rsym.sym == NULL)
@@ -3418,7 +3404,7 @@ read_cleanup (pointer_info *p)
     {
       /* Add hidden symbols to the symtree.  */
       q = get_integer (p->u.rsym.ns);
-      st = get_unique_symtree ((gfc_namespace *) q->u.pointer);
+      st = gfc_get_unique_symtree ((gfc_namespace *) q->u.pointer);
 
       st->n.sym = p->u.rsym.sym;
       st->n.sym->refs++;
@@ -3598,7 +3584,7 @@ read_module (void)
 	      /* Create a symtree node in the current namespace for this
 		 symbol.  */
 	      st = check_unique_name (p)
-		   ? get_unique_symtree (gfc_current_ns)
+		   ? gfc_get_unique_symtree (gfc_current_ns)
 		   : gfc_new_symtree (&gfc_current_ns->sym_root, p);
 
 	      st->ambiguous = ambiguous;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 40e3435..3aae04c 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2129,6 +2129,20 @@ gfc_find_symtree (gfc_symtree *st, const char *name)
 }
 
 
+/* Return a symtree node with a name that is guaranteed to be unique
+   within the namespace and corresponds to an illegal fortran name.  */
+
+gfc_symtree *
+gfc_get_unique_symtree (gfc_namespace *ns)
+{
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  static int serial = 0;
+
+  sprintf (name, "@%d", serial++);
+  return gfc_new_symtree (&ns->sym_root, name);
+}
+
+
 /* Given a name find a user operator node, creating it if it doesn't
    exist.  These are much simpler than symbols because they can't be
    ambiguous with one another.  */