2006-08-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28788
* gfortran.dg/used_types_4.f90: New test.
* gfortran.dg/derived_init_2.f90: Modify to check sibling
association of derived types.
* gfortran.dg/used_types_2.f90: Add module cleanup.
* gfortran.dg/used_types_3.f90: The same.
PR fortran/28771
* gfortran.dg/assumed_charlen_in_main.f90: Modify to check
fix of regression.
2006-08-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28788
* gfortran.dg/used_types_4.f90: New test.
* gfortran.dg/derived_init_2.f90: Modify to check sibling
association of derived types.
* gfortran.dg/used_types_2.f90: Add module cleanup.
* gfortran.dg/used_types_3.f90: The same.
PR fortran/28771
* gfortran.dg/assumed_charlen_in_main.f90: Modify to check
fix of regression.
From-SVN: r116369
+2006-08-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28788
+ * symbol.c (shift_types): Shift the derived type references in
+ formal namespaces.
+ (gfc_use_derived): Return if the derived type symbol is already
+ in another namspace. Add searches for the derived type in
+ sibling namespaces.
+
+ PR fortran/28771
+ * decl.c (add_init_expr_to_sym): Restore the original but
+ restricted to parameter arrays to fix a regression.
+
2006-08-23 Steven G. Kargl <kargls@comcast.net>
* gfortran.texi: Fix last commit where a "no" was deleted and
sym->ts.cl = gfc_get_charlen ();
sym->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = sym->ts.cl;
+
+ if (sym->attr.flavor == FL_PARAMETER
+ && init->expr_type == EXPR_ARRAY)
+ sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
}
/* Update initializer character length according symbol. */
else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
return sym;
}
-/* Recursive function to switch derived types of all symbol in a
- namespace. */
+/* Recursive function to switch derived types of all symbols in a
+ namespace. The formal namespaces contain references to derived
+ types that can be left hanging by gfc_use_derived, so these must
+ be switched too. */
static void
switch_types (gfc_symtree * st, gfc_symbol * from, gfc_symbol * to)
sym = st->n.sym;
if (sym->ts.type == BT_DERIVED && sym->ts.derived == from)
sym->ts.derived = to;
+
+ if (sym->formal_ns && sym->formal_ns->sym_root)
+ switch_types (sym->formal_ns->sym_root, from, to);
switch_types (st->left, from, to);
switch_types (st->right, from, to);
gfc_typespec *t;
gfc_symtree *st;
gfc_component *c;
+ gfc_namespace *ns;
int i;
- if (sym->ns->parent == NULL)
+ if (sym->ns->parent == NULL || sym->ns != gfc_current_ns)
{
- /* Already defined in highest possible namespace. */
+ /* Already defined in highest possible or sibling namespace. */
if (sym->components != NULL)
return sym;
return NULL;
}
+ /* Look in sibling namespaces for a derived type of the same name. */
+ if (s == NULL && sym->attr.use_assoc && sym->ns->sibling)
+ {
+ ns = sym->ns->sibling;
+ for (; ns; ns = ns->sibling)
+ {
+ s = NULL;
+ if (sym->ns == ns)
+ break;
+
+ if (gfc_find_symbol (sym->name, ns, 1, &s))
+ {
+ gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
+ return NULL;
+ }
+
+ if (s != NULL && s->attr.flavor == FL_DERIVED)
+ break;
+ }
+ }
+
if (s == NULL || s->attr.flavor != FL_DERIVED)
{
/* Check to see if type has been renamed in parent namespace.
return s;
}
+ /* See if sym is identical to renamed, use-associated derived
+ types in sibling namespaces. */
+ if (sym->attr.use_assoc
+ && sym->ns->parent
+ && sym->ns->parent->contained)
+ {
+ ns = sym->ns->parent->contained;
+ for (; ns; ns = ns->sibling)
+ {
+ if (sym->ns == ns)
+ break;
+
+ s = find_renamed_type (sym, ns->sym_root);
+
+ if (s != NULL)
+ {
+ switch_types (sym->ns->sym_root, sym, s);
+ return s;
+ }
+ }
+ }
+
/* The local definition is all that there is. */
if (sym->components != NULL)
{
+2006-08-23 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28788
+ * gfortran.dg/used_types_4.f90: New test.
+ * gfortran.dg/derived_init_2.f90: Modify to check sibling
+ association of derived types.
+ * gfortran.dg/used_types_2.f90: Add module cleanup.
+ * gfortran.dg/used_types_3.f90: The same.
+
+ PR fortran/28771
+ * gfortran.dg/assumed_charlen_in_main.f90: Modify to check
+ fix of regression.
+
2006-08-23 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR 28813
! survive in the main program without causing an error.
!
! Contributed by Martin Reinecke <martin@mpa-garching.mpg.de>
-!
+! Modified to test fix of regression reported by P.Schaffnit@access.rwth-aachen.de
+
+subroutine poobar ()
+ ! The regression caused an ICE here
+ CHARACTER ( LEN = * ), PARAMETER :: Markers(5) = (/ "Error ", &
+ & "Fehler", &
+ & "Erreur", &
+ & "Stop ", &
+ & "Arret " /)
+ character(6) :: recepteur (5)
+ recepteur = Markers
+end subroutine poobar
+
+! If the regression persisted, the compilation would stop before getting here
program test
character(len=*), parameter :: foo = 'test' ! Parameters must work.
character(len=4) :: bar = foo
character(len=*) :: foobar = 'This should fail' ! { dg-error "must be a dummy" }
print *, bar
+ call poobar ()
end
-! { dg-do run }
-! PR 25217: INTENT(OUT) dummies of derived type with default initializers shall
+! { dg-do run }\r
+! PR 25217: INTENT(OUT) dummies of derived type with default initializers shall\r
! be (re)initialized upon procedure entry, unless they are ALLOCATABLE.
-program main
-
- implicit none
-
- type :: drv
- integer :: a(3) = [ 1, 2, 3 ]
- character(3) :: s = "abc"
- real, pointer :: p => null()
- end type drv
- type(drv) :: aa
- type(drv), allocatable :: ab(:)
- real, target :: x
-
- aa%a = [ 4, 5, 6]
- aa%s = "def"
- aa%p => x
- call sub(aa)
-
- call sub2(ab)
-
+! Modified to take account of the regression, identified by Martin Tees
+! http://gcc.gnu.org/ml/fortran/2006-08/msg00276.html and fixed with
+! PR 28788.\r
+module dt
+ type :: drv\r
+ integer :: a(3) = [ 1, 2, 3 ]\r
+ character(3) :: s = "abc"\r
+ real, pointer :: p => null()\r
+ end type drv\r
+end module dt
+
+module subs
contains
-
+ subroutine foo(fb)
+ use dt\r
+ type(drv), intent(out) :: fb
+ call sub (fb)
+ end subroutine foo
+\r
subroutine sub(fa)
- type(drv), intent(out) :: fa
-
- if (any(fa%a /= [ 1, 2, 3 ])) call abort()
- if (fa%s /= "abc") call abort()
- if (associated(fa%p)) call abort()
+ use dt\r
+ type(drv), intent(out) :: fa\r
+\r
+ if (any(fa%a /= [ 1, 2, 3 ])) call abort()\r
+ if (fa%s /= "abc") call abort()\r
+ if (associated(fa%p)) call abort()\r
end subroutine sub
-
- subroutine sub2(fa)
- type(drv), allocatable, intent(out) :: fa(:)
- end subroutine sub2
-
-end program main
+end module subs
+
+program main\r
+ use dt
+ use subs\r
+ implicit none\r
+ type(drv) :: aa\r
+ type(drv), allocatable :: ab(:)\r
+ real, target :: x = 99, y = 999\r
+\r
+ aa = drv ([ 4, 5, 6], "def", x)\r
+ call sub(aa)\r
+\r
+ aa = drv ([ 7, 8, 9], "ghi", y)\r
+ call foo(aa)\r
+end program main\r
+\r
+! { dg-final { cleanup-modules "dt subs" } }
\ No newline at end of file
foobar = .FALSE.
c = bar (x)
END FUNCTION foobar
+! { dg-final { cleanup-modules "types foo" } }
a%ofTypA(i,j) = ofTypB(k,j)
end subroutine buggy
end module modC
+! { dg-final { cleanup-modules "modA modB modC" } }
--- /dev/null
+! { dg-do compile }\r
+! Tests the fix for PR28788, a regression in which an ICE was caused\r
+! by the failure of derived type association for the arguments of\r
+! InitRECFAST because the formal namespace derived types references\r
+! were not being reassociated to the module.\r
+!\r
+! Contributed by Martin Reinecke <martin@mpa-garching.mpg.de> \r
+! \r
+module Precision\r
+ integer, parameter :: dl = KIND(1.d0)\r
+end module Precision\r
+\r
+module ModelParams\r
+ use precision\r
+ type CAMBparams\r
+ real(dl)::omegab,h0,tcmb,yhe\r
+ end type\r
+ type (CAMBparams) :: CP\r
+contains\r
+ subroutine CAMBParams_Set(P)\r
+ type(CAMBparams), intent(in) :: P\r
+ end subroutine CAMBParams_Set\r
+end module ModelParams\r
+\r
+module TimeSteps\r
+ use precision\r
+ use ModelParams\r
+end module TimeSteps\r
+\r
+module ThermoData\r
+ use TimeSteps\r
+contains\r
+ subroutine inithermo(taumin,taumax)\r
+ use precision\r
+ use ModelParams ! Would ICE here\r
+ real(dl) taumin,taumax\r
+ call InitRECFAST(CP%omegab,CP%h0,CP%tcmb,CP%yhe)\r
+ end subroutine inithermo\r
+end module ThermoData\r
+! { dg-final { cleanup-modules "PRECISION ModelParams TimeSteps ThermoData" } }
projects / platform / upstream / gcc.git / commitdiff