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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5932bcbbcd13e1544d509957550b34f328b59a66..76b0344e73c2965e1331d57b7110770dfb90e261 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index b3695e744202818693766e976aa3531f0f5a1083..1066e2ef52f5f1d3cc53c97d7f0d64843d93dd94 100644 (file)
--- a/gcc/fortran/module.c
+++ b/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
-       arguments, the symbols for indices need to be different from
-       from those in the module proper(ns = 1).  */
-      if (sym !=NULL && info->u.rsym.ns != 1)
-       sym = find_true_name (info->u.rsym.true_name,
-               gfc_get_string ("%s@%d",module_name, series++));
+        /* See if the symbol has already been loaded by a previous module.
+        If so, we reference the existing symbol and prevent it from
+        being loaded again.  This should not happen if the symbol being
+        read is an index for an assumed shape dummy array (ns != 1).  */
 
-      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_current_ns);
+                     gfc_new_symbol (info->u.rsym.true_name,
+                                     gfc_current_ns);
 
                  sym->module = gfc_get_string (info->u.rsym.module);
                }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3f32377eff0a11a951d18466567218b56f59ddf8..0c43597323e8c569fbeca749df3a59e9c2064af5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/nested_modules_3.f90 b/gcc/testsuite/gfortran.dg/nested_modules_3.f90
new file mode 100644 (file)
index 0000000..364460c
--- /dev/null
+++ b/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