re PR fortran/16861 ([4.0 only] segfault with doubly used module)

2005-09-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16861
	* module.c (mio_component_ref): Return if the symbol is NULL
	and wait for another iteration during module reads.
	(mio_symtree_ref): Suppress the writing of contained symbols,
	when a symbol is available in the main namespace.
	(read_module): Restrict scope of special treatment of contained
	symbols to variables only and suppress redundant call to
	find_true_name.

2005-09-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/16861
	* gfortran.dg/nested_modules_3.f90: New.

From-SVN: r104574

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2005-09-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16861
+	* module.c (mio_component_ref): Return if the symbol is NULL
+	and wait for another iteration during module reads.
+	(mio_symtree_ref): Suppress the writing of contained symbols,
+	when a symbol is available in the main namespace.
+	(read_module): Restrict scope of special treatment of contained
+	symbols to variables only and suppress redundant call to
+	find_true_name.
+
 2005-09-22  Steven G. Kargl  <kargls@comcast.net>
 
 	PR fortran/24005

gcc/fortran/module.c

@@ -1873,6 +1873,12 @@ mio_component_ref (gfc_component ** cp, gfc_symbol * sym)
     {
       mio_internal_string (name);
 
+      /* It can happen that a component reference can be read before the
+	 associated derived type symbol has been loaded. Return now and
+	 wait for a later iteration of load_needed.  */
+      if (sym == NULL)
+	return;
+
       if (sym->components != NULL && p->u.pointer == NULL)
 	{
 	  /* Symbol already loaded, so search by name.  */
@@ -2085,10 +2091,18 @@ mio_symtree_ref (gfc_symtree ** stp)
 {
   pointer_info *p;
   fixup_t *f;
+  gfc_symtree * ns_st = NULL;
 
   if (iomode == IO_OUTPUT)
     {
-      mio_symbol_ref (&(*stp)->n.sym);
+      /* 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);
+
+      mio_symbol_ref (ns_st ? &ns_st->n.sym : &(*stp)->n.sym);
     }
   else
     {
@@ -3099,7 +3113,7 @@ read_module (void)
   const char *p;
   char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_intrinsic_op i;
-  int ambiguous, j, nuse, series, symbol;
+  int ambiguous, j, nuse, symbol;
   pointer_info *info;
   gfc_use_rename *u;
   gfc_symtree *st;
@@ -3119,7 +3133,6 @@ read_module (void)
   mio_lparen ();
 
   /* Create the fixup nodes for all the symbols.  */
-  series = 0;
 
   while (peek_atom () != ATOM_RPAREN)
     {
@@ -3144,14 +3157,16 @@ read_module (void)
 
       sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module);
 
-      /* If a module contains subroutines with assumed shape dummy
+        /* See if the symbol has already been loaded by a previous module.
-       arguments, the symbols for indices need to be different from
+	 If so, we reference the existing symbol and prevent it from
-       from those in the module proper(ns = 1).  */
+	 being loaded again.  This should not happen if the symbol being
-      if (sym !=NULL && info->u.rsym.ns != 1)
+	 read is an index for an assumed shape dummy array (ns != 1).  */
-	sym = find_true_name (info->u.rsym.true_name,
-		gfc_get_string ("%s@%d",module_name, series++));
 
-      if (sym == NULL)
+      sym = find_true_name (info->u.rsym.true_name, info->u.rsym.module);
+
+      if (sym == NULL
+	   || (sym->attr.flavor == FL_VARIABLE
+	       && info->u.rsym.ns !=1))
 	continue;
 
       info->u.rsym.state = USED;
@@ -3213,8 +3228,8 @@ read_module (void)
 	      if (sym == NULL)
 		{
 		  sym = info->u.rsym.sym =
-		      gfc_new_symbol (info->u.rsym.true_name
+		      gfc_new_symbol (info->u.rsym.true_name,
-				      , gfc_current_ns);
+				      gfc_current_ns);
 
 		  sym->module = gfc_get_string (info->u.rsym.module);
 		}

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2005-09-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/16861
+	* gfortran.dg/nested_modules_3.f90: New.
+
 2005-09-22 Steven G. Kargl  <kargls@comcast.net>
 
 	PR fortran/24005

gcc/testsuite/gfortran.dg/nested_modules_3.f90

@@ -0,0 +1,55 @@
+! { dg-do run }
+!
+! This tests the improved version of the patch for PR16861.  Testing
+! after committing the first version, revealed that this test did
+! not work but was not regtested for, either.
+!
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+MODULE foo
+  TYPE type1
+    INTEGER i1
+  END TYPE type1
+END MODULE
+
+MODULE bar
+CONTAINS
+  SUBROUTINE sub1 (x, y)
+    USE foo
+    TYPE (type1)  :: x
+    INTEGER  :: y(x%i1)
+    y = 1
+  END SUBROUTINE SUB1
+  SUBROUTINE sub2 (u, v)
+    USE foo
+    TYPE (type1)  :: u
+    INTEGER  :: v(u%i1)
+    v = 2
+  END SUBROUTINE SUB2
+END MODULE
+
+MODULE foobar
+  USE foo
+  USE bar
+CONTAINS
+  SUBROUTINE sub3 (s, t)
+    USE foo
+    TYPE (type1)  :: s
+    INTEGER  :: t(s%i1)
+    t = 3
+  END SUBROUTINE SUB3
+END MODULE foobar
+
+PROGRAM use_foobar
+  USE foo
+  USE foobar
+  INTEGER :: j(3) = 0
+  TYPE (type1)   :: z
+  z%i1 = 3
+  CALL sub1 (z, j)
+  z%i1 = 2
+  CALL sub2 (z, j)
+  z%i1 = 1
+  CALL sub3 (z, j)
+  IF (ALL (j.ne.(/3,2,1/))) CALL abort ()
+END PROGRAM use_foobar