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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116552 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aa2b4fa..a922dff 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c36c456..450f7cf 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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);

diff --git a/gcc/testsuite/gfortran.dg/used_types_5.f90 b/gcc/testsuite/gfortran.dg/used_types_5.f90
new file mode 100644 (file)
index 0000000..427ede1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_5.f90
@@ -0,0 +1,59 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/used_types_6.f90 b/gcc/testsuite/gfortran.dg/used_types_6.f90
new file mode 100644 (file)
index 0000000..52fa554
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/used_types_6.f90
@@ -0,0 +1,37 @@
+! { 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" } }