diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 39 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/nested_modules_3.f90 | 55 |
4 files changed, 98 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5932bcbbcd1..76b0344e73c 100644 --- 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 b3695e74420..1066e2ef52f 100644 --- 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 3f32377eff0..0c43597323e 100644 --- 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 index 00000000000..364460c6138 --- /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 |