re PR fortran/25818 ([4.1 only] Problem with handling optional and entry master arguments)

2006-12-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25818
	* trans-array.c (gfc_trans_g77_array): If the variable is
	optional or not always present, make the statement conditional
	on presence of the argument.
	* gfortran.h : Add symbol_attribute not_always_present.
	* resolve.c (check_argument_lists): New function to check if
	arguments are not present in all entries.

	PR fortran/30084
	* module.c (mio_component_ref): Move treatment of unique name
	variables, during output, to fix_mio_expr.
	(fix_mio_expr): New function that fixes defective expressions
	before they are written to the module file.
	(mio_expr): Call the new function.
	(resolve_entries): Call check_argument_lists.

2006-12-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25818
	* gfortran.dg/entry_array_specs_2.f: New test.

	PR fortran/30084
	* gfortran.dg/nested_modules_6.f90: New test.

From-SVN: r120155

1 files changed, 45 insertions, 19 deletions

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index f54ef8e..dc138d3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2194,27 +2194,9 @@ mio_symtree_ref (gfc_symtree ** stp)
 {
   pointer_info *p;
   fixup_t *f;
-  gfc_symtree * ns_st = NULL;
 
   if (iomode == IO_OUTPUT)
-    {
-      /* If this is a symtree for a symbol that came from a contained module
-	 namespace, it has a unique name and we should look in the current
-	 namespace to see if the required, non-contained symbol is available
-	 yet. If so, the latter should be written.  */
-      if ((*stp)->n.sym && check_unique_name((*stp)->name))
-	ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
-				    (*stp)->n.sym->name);
-
-      /* On the other hand, if the existing symbol is the module name or the
-	 new symbol is a dummy argument, do not do the promotion.  */
-      if (ns_st && ns_st->n.sym
-	    && ns_st->n.sym->attr.flavor != FL_MODULE
-	    && !(*stp)->n.sym->attr.dummy)
-	mio_symbol_ref (&ns_st->n.sym);
-      else
-	mio_symbol_ref (&(*stp)->n.sym);
-    }
+    mio_symbol_ref (&(*stp)->n.sym);
   else
     {
       require_atom (ATOM_INTEGER);
@@ -2554,6 +2536,48 @@ static const mstring intrinsics[] =
     minit (NULL, -1)
 };
 
+
+/* Remedy a couple of situations where the gfc_expr's can be defective.  */
+ 
+static void
+fix_mio_expr (gfc_expr *e)
+{
+  gfc_symtree *ns_st = NULL;
+  const char *fname;
+
+  if (iomode != IO_OUTPUT)
+    return;
+
+  if (e->symtree)
+    {
+      /* If this is a symtree for a symbol that came from a contained module
+	 namespace, it has a unique name and we should look in the current
+	 namespace to see if the required, non-contained symbol is available
+	 yet. If so, the latter should be written.  */
+      if (e->symtree->n.sym && check_unique_name(e->symtree->name))
+	ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
+				    e->symtree->n.sym->name);
+
+      /* On the other hand, if the existing symbol is the module name or the
+	 new symbol is a dummy argument, do not do the promotion.  */
+      if (ns_st && ns_st->n.sym
+	    && ns_st->n.sym->attr.flavor != FL_MODULE
+	    && !e->symtree->n.sym->attr.dummy)
+	e->symtree = ns_st;
+    }
+  else if (e->expr_type == EXPR_FUNCTION && e->value.function.name)
+    {
+      /* In some circumstances, a function used in an initialization
+	 expression, in one use associated module, can fail to be
+	 coupled to its symtree when used in a specification
+	 expression in another module.  */
+      fname = e->value.function.esym ? e->value.function.esym->name :
+				       e->value.function.isym->name;
+      e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
+    }
+}
+
+
 /* Read and write expressions.  The form "()" is allowed to indicate a
    NULL expression.  */
 
@@ -2598,6 +2622,8 @@ mio_expr (gfc_expr ** ep)
   mio_typespec (&e->ts);
   mio_integer (&e->rank);
 
+  fix_mio_expr (e);
+
   switch (e->expr_type)
     {
     case EXPR_OP: