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
+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.
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. */
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;
}
}
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;
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);
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }