re PR fortran/24558 (ENTRY doesn't work in module procedures)

2006-06-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24558
	PR fortran/20877
	PR fortran/25047
	* decl.c (get_proc_name): Add new argument to flag that a
	module function entry is being treated. If true, correct
	error condition, add symtree to module namespace and add
	a module procedure.
	(gfc_match_function_decl, gfc_match_entry,
	gfc_match_subroutine): Use the new argument in calls to
	get_proc_name.
	* resolve.c (resolve_entries): ENTRY symbol reference to
	to master entry namespace if a module function.
	* trans-decl.c (gfc_create_module_variable): Return if
	the symbol is an entry.
	* trans-exp.c (gfc_conv_variable): Check that parent_decl
	is not NULL.

2006-06-10  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24558
	* gfortran.dg/entry_6.f90: New test.

	PR fortran/20877
	PR fortran/25047
	* gfortran.dg/entry_7.f90: New test.

From-SVN: r114526

5 files changed, 72 insertions, 13 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a576a2e..c68fd8c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2006-06-10  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/24558
+	PR fortran/20877
+	PR fortran/25047
+	* decl.c (get_proc_name): Add new argument to flag that a
+	module function entry is being treated. If true, correct
+	error condition, add symtree to module namespace and add
+	a module procedure.
+	(gfc_match_function_decl, gfc_match_entry,
+	gfc_match_subroutine): Use the new argument in calls to
+	get_proc_name.
+	* resolve.c (resolve_entries): ENTRY symbol reference to
+	to master entry namespace if a module function.
+	* trans-decl.c (gfc_create_module_variable): Return if
+	the symbol is an entry.
+	* trans-exp.c (gfc_conv_variable): Check that parent_decl
+	is not NULL.
+
 2006-06-09  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/27916
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0f2436a..e8b1626 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -596,13 +596,20 @@ end:
    parent, then the symbol is just created in the current unit.  */
 
 static int
-get_proc_name (const char *name, gfc_symbol ** result)
+get_proc_name (const char *name, gfc_symbol ** result,
+	       bool module_fcn_entry)
 {
   gfc_symtree *st;
   gfc_symbol *sym;
   int rc;
 
-  if (gfc_current_ns->parent == NULL)
+  /* Module functions have to be left in their own namespace because
+     they have potentially (almost certainly!) already been referenced.
+     In this sense, they are rather like external functions.  This is
+     fixed up in resolve.c(resolve_entries), where the symbol name-
+     space is set to point to the master function, so that the fake
+     result mechanism can work.  */
+  if (module_fcn_entry)
     rc = gfc_get_symbol (name, NULL, result);
   else
     rc = gfc_get_symbol (name, gfc_current_ns->parent, result);
@@ -628,7 +635,8 @@ get_proc_name (const char *name, gfc_symbol ** result)
       if (sym->ts.kind != 0
 	    && sym->attr.proc == 0
 	    && gfc_current_ns->parent != NULL
-	    && sym->attr.access == 0)
+	    && sym->attr.access == 0
+	    && !module_fcn_entry)
 	gfc_error_now ("Procedure '%s' at %C has an explicit interface"
 		       " and must not have attributes declared at %L",
 		       name, &sym->declared_at);
@@ -637,18 +645,23 @@ get_proc_name (const char *name, gfc_symbol ** result)
   if (gfc_current_ns->parent == NULL || *result == NULL)
     return rc;
 
-  st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+  /* Module function entries will already have a symtree in
+     the current namespace but will need one at module level.  */
+  if (module_fcn_entry)
+    st = gfc_new_symtree (&gfc_current_ns->parent->sym_root, name);
+  else
+    st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
 
   st->n.sym = sym;
   sym->refs++;
 
   /* See if the procedure should be a module procedure */
 
-  if (sym->ns->proc_name != NULL
-      && sym->ns->proc_name->attr.flavor == FL_MODULE
-      && sym->attr.proc != PROC_MODULE
-      && gfc_add_procedure (&sym->attr, PROC_MODULE,
-			    sym->name, NULL) == FAILURE)
+  if (((sym->ns->proc_name != NULL
+	  && sym->ns->proc_name->attr.flavor == FL_MODULE
+	  && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
+	&& gfc_add_procedure (&sym->attr, PROC_MODULE,
+			      sym->name, NULL) == FAILURE)
     rc = 2;
 
   return rc;
@@ -2564,7 +2577,7 @@ gfc_match_function_decl (void)
       return MATCH_NO;
     }
 
-  if (get_proc_name (name, &sym))
+  if (get_proc_name (name, &sym, false))
     return MATCH_ERROR;
   gfc_new_block = sym;
 
@@ -2667,6 +2680,7 @@ gfc_match_entry (void)
   match m;
   gfc_entry_list *el;
   locus old_loc;
+  bool module_procedure;
 
   m = gfc_match_name (name);
   if (m != MATCH_YES)
@@ -2727,16 +2741,26 @@ gfc_match_entry (void)
       return MATCH_ERROR;
     }
 
+  module_procedure = gfc_current_ns->parent != NULL
+      && gfc_current_ns->parent->proc_name
+      && gfc_current_ns->parent->proc_name->attr.flavor == FL_MODULE;
+
   if (gfc_current_ns->parent != NULL
       && gfc_current_ns->parent->proc_name
-      && gfc_current_ns->parent->proc_name->attr.flavor != FL_MODULE)
+      && !module_procedure)
     {
       gfc_error("ENTRY statement at %C cannot appear in a "
 		"contained procedure");
       return MATCH_ERROR;
     }
 
-  if (get_proc_name (name, &entry))
+  /* Module function entries need special care in get_proc_name
+     because previous references within the function will have
+     created symbols attached to the current namespace.  */
+  if (get_proc_name (name, &entry,
+		     gfc_current_ns->parent != NULL
+		     && module_procedure
+		     && gfc_current_ns->proc_name->attr.function))
     return MATCH_ERROR;
 
   proc = gfc_current_block ();
@@ -2865,7 +2889,7 @@ gfc_match_subroutine (void)
   if (m != MATCH_YES)
     return m;
 
-  if (get_proc_name (name, &sym))
+  if (get_proc_name (name, &sym, false))
     return MATCH_ERROR;
   gfc_new_block = sym;
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 33e21df..384b5a4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -385,6 +385,16 @@ resolve_entries (gfc_namespace * ns)
   ns->entries = el;
   ns->proc_name->attr.entry = 1;
 
+  /* If it is a module function, it needs to be in the right namespace
+     so that gfc_get_fake_result_decl can gather up the results. The
+     need for this arose in get_proc_name, where these beasts were
+     left in their own namespace, to keep prior references linked to
+     the entry declaration.*/
+  if (ns->proc_name->attr.function
+	&& ns->parent
+	&& ns->parent->proc_name->attr.flavor == FL_MODULE)
+    el->sym->ns = ns;
+
   /* Add an entry statement for it.  */
   c = gfc_get_code ();
   c->op = EXEC_ENTRY;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 30d51b9..b4fa7f5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2653,6 +2653,11 @@ gfc_create_module_variable (gfc_symbol * sym)
 {
   tree decl;
 
+  /* Module functions with alternate entries are dealt with later and
+     would get caught by the next condition.  */
+  if (sym->attr.entry)
+    return;
+
   /* Only output symbols from this module.  */
   if (sym->ns != module_namespace)
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e5524f..44143d1 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -361,6 +361,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 
       if ((se->expr == parent_decl && return_value)
 	   || (sym->ns && sym->ns->proc_name
+	       && parent_decl
 	       && sym->ns->proc_name->backend_decl == parent_decl
 	       && (alternate_entry || entry_master)))
 	parent_flag = 1;