re PR fortran/28788 (ICE on valid code)

2006-08-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28788
	REGRESSION FIX
	* symbol.c (gfc_use_derived): Never eliminate the symbol,
	following reassociation of use associated derived types.

2006-08-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28788
	* gfortran.dg/used_types_5.f90: New test.
	* gfortran.dg/used_types_6.f90: New test.

From-SVN: r116552

gcc/fortran/ChangeLog

+2006-08-29  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28788
+	REGRESSION FIX
+	* symbol.c (gfc_use_derived): Never eliminate the symbol,
+	following reassociation of use associated derived types.
+
 2006-08-26  Steven G. Kargl  <kargls@comcast.net>
 
 	* arith.h: Update Copyright dates.  Fix whitespace.

gcc/fortran/symbol.c

@@ -1495,16 +1495,10 @@ gfc_use_derived (gfc_symbol * sym)
 
   if (s == NULL || s->attr.flavor != FL_DERIVED)
     {
-      /* Check to see if type has been renamed in parent namespace.
-	 Leave cleanup of local symbols until the end of the
-	 compilation because doing it here is complicated by
-	 multiple association with the same type.  */
+      /* Check to see if type has been renamed in parent namespace.  */
       s = find_renamed_type (sym, sym->ns->parent->sym_root);
       if (s != NULL)
-	{
-	  switch_types (sym->ns->sym_root, sym, s);
-	  return s;
-	}
+	goto return_use_assoc;
 
       /* See if sym is identical to renamed, use-associated derived
 	 types in sibling namespaces.  */
@@ -1521,10 +1515,7 @@ gfc_use_derived (gfc_symbol * sym)
 	      s = find_renamed_type (sym, ns->sym_root);
 
 	      if (s != NULL)
-		{
-		  switch_types (sym->ns->sym_root, sym, s);
-		  return s;
-		}
+		goto return_use_assoc;
 	    }
 	}
 
@@ -1557,6 +1548,9 @@ gfc_use_derived (gfc_symbol * sym)
 	t->derived = s;
     }
 
+  if (sym->attr.use_assoc)
+    goto return_use_assoc;
+
   st = gfc_find_symtree (sym->ns->sym_root, sym->name);
   st->n.sym = s;
 
@@ -1573,6 +1567,14 @@ gfc_use_derived (gfc_symbol * sym)
 
   return s;
 
+return_use_assoc:
+  /* Use associated types are not freed at this stage because some
+     references remain to 'sym'.  We retain the symbol and leave it
+     to be cleaned up by gfc_free_namespace, at the end of the
+     compilation.  */
+  switch_types (sym->ns->sym_root, sym, s);
+  return s;
+
 bad:
   gfc_error ("Derived type '%s' at %C is being used before it is defined",
 	     sym->name);

gcc/testsuite/gfortran.dg/used_types_5.f90

+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788, as noted in reply #9 in the Bugzilla
+! entry by Martin Reinecke <martin@mpa-garching.mpg.de>.
+! The problem was caused by certain types of references
+! that point to a deleted derived type symbol, after the
+! type has been associated to another namespace. An
+! example of this is the specification expression for x
+! in subroutine foo below.  At the same time, this tests
+! the correct association of typeaa between a module
+! procedure and a new definition of the type in MAIN.
+!
+module types
+
+  type :: typea
+    sequence
+    integer :: i
+  end type typea
+
+  type :: typeaa
+    sequence
+    integer :: i
+  end type typeaa
+
+  type(typea) :: it = typea(2)
+
+end module types
+!------------------------------
+module global
+
+  use types, only: typea, it
+
+contains
+
+  subroutine foo (x)
+    use types
+    type(typeaa) :: ca
+    real :: x(it%i)
+    common /c/ ca
+    x = 42.0
+    ca%i = 99
+  end subroutine foo
+
+end module global
+!------------------------------
+  use global, only: typea, foo
+  type :: typeaa
+    sequence
+    integer :: i
+  end type typeaa
+  type(typeaa) :: cam
+  real :: x(4)
+  common /c/ cam
+  x = -42.0
+  call foo(x)
+  if (any (x .ne. (/42.0, 42.0, -42.0, -42.0/))) call abort ()
+  if (cam%i .ne. 99) call abort ()
+end
+! { dg-final { cleanup-modules "types global" } }

gcc/testsuite/gfortran.dg/used_types_6.f90

+! { dg-do compile }
+! Tests the fix for a further regression caused by the
+! fix for PR28788, as noted in reply #13 in the Bugzilla
+! entry by Martin Tee  <aovb94@dsl.pipex.com>.
+! The problem was caused by contained, use associated
+! derived types with pointer components of a derived type
+! use associated in a sibling procedure, where both are
+! associated by an ONLY clause. This is the reporter's
+! test case.
+!
+MODULE type_mod
+  TYPE a
+    INTEGER  :: n(10)
+  END TYPE a
+
+  TYPE b
+    TYPE (a), POINTER :: m(:) => NULL ()
+  END TYPE b
+END MODULE type_mod
+
+MODULE seg_mod
+CONTAINS
+  SUBROUTINE foo (x)
+    USE type_mod, ONLY : a     ! failed
+    IMPLICIT NONE
+    TYPE (a)  :: x
+    RETURN
+  END SUBROUTINE foo
+
+  SUBROUTINE bar (x)
+    USE type_mod, ONLY : b     ! failed
+    IMPLICIT NONE
+    TYPE (b)  :: x
+    RETURN
+  END SUBROUTINE bar
+END MODULE seg_mod
+! { dg-final { cleanup-modules "type_mod seg_mod" } }