From ec5a3959f3a0f33bdb6f57dca8963f4ada775f2f Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Sun, 26 Jan 2014 14:49:47 +0000 Subject: [PATCH] re PR fortran/58007 ([OOP] ICE in free_pi_tree(): Unresolved fixup - resolve_fixups does not fixup component of __class_bsr_Bsr_matrix) fortran/ PR fortran/58007 * module.c (fp2, find_pointer2): Remove. (mio_component_ref): Don't forcedfully set the containing derived type symbol for loading. Remove unused argument. (mio_ref): Update caller (skip_list): New argument nest_level. Initialize level with the new argument. (read_module): Add forced pointer components association for derived type symbols. testsuite/ PR fortran/58007 * gfortran.dg/unresolved_fixup_1.f90: New test. * gfortran.dg/unresolved_fixup_2.f90: New test. From-SVN: r207119 --- gcc/fortran/ChangeLog | 12 ++ gcc/fortran/module.c | 129 ++++++++---------- gcc/testsuite/ChangeLog | 6 + .../gfortran.dg/unresolved_fixup_1.f90 | 44 ++++++ .../gfortran.dg/unresolved_fixup_2.f90 | 36 +++++ 5 files changed, 156 insertions(+), 71 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4cd4f6829bcb..3e39f881be65 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2014-01-26 Mikael Morin + + PR fortran/58007 + * module.c (fp2, find_pointer2): Remove. + (mio_component_ref): Don't forcedfully set the containing derived type + symbol for loading. Remove unused argument. + (mio_ref): Update caller + (skip_list): New argument nest_level. Initialize level with the new + argument. + (read_module): Add forced pointer components association for derived + type symbols. + 2014-01-11 Janus Weil Backport from mainline diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index f6662b479978..5e4739f14ca3 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -387,37 +387,6 @@ get_integer (int integer) } -/* Recursive function to find a pointer within a tree by brute force. */ - -static pointer_info * -fp2 (pointer_info *p, const void *target) -{ - pointer_info *q; - - if (p == NULL) - return NULL; - - if (p->u.pointer == target) - return p; - - q = fp2 (p->left, target); - if (q != NULL) - return q; - - return fp2 (p->right, target); -} - - -/* During reading, find a pointer_info node from the pointer value. - This amounts to a brute-force search. */ - -static pointer_info * -find_pointer2 (void *p) -{ - return fp2 (pi_root, p); -} - - /* Resolve any fixups using a known pointer. */ static void @@ -2500,45 +2469,13 @@ mio_pointer_ref (void *gp) the namespace and is not loaded again. */ static void -mio_component_ref (gfc_component **cp, gfc_symbol *sym) +mio_component_ref (gfc_component **cp) { - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_component *q; pointer_info *p; p = mio_pointer_ref (cp); if (p->type == P_UNKNOWN) p->type = P_COMPONENT; - - if (iomode == IO_OUTPUT) - mio_pool_string (&(*cp)->name); - else - { - mio_internal_string (name); - - if (sym && sym->attr.is_class) - sym = sym->components->ts.u.derived; - - /* 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. */ - q = gfc_find_component (sym, name, true, true); - - if (q) - associate_integer_pointer (p, q); - } - - /* Make sure this symbol will eventually be loaded. */ - p = find_pointer2 (sym); - if (p->u.rsym.state == UNUSED) - p->u.rsym.state = NEEDED; - } } @@ -2920,7 +2857,7 @@ mio_ref (gfc_ref **rp) case REF_COMPONENT: mio_symbol_ref (&r->u.c.sym); - mio_component_ref (&r->u.c.component, r->u.c.sym); + mio_component_ref (&r->u.c.component); break; case REF_SUBSTRING: @@ -3775,7 +3712,9 @@ mio_full_f2k_derived (gfc_symbol *sym) /* Unlike most other routines, the address of the symbol node is already - fixed on input and the name/module has already been filled in. */ + fixed on input and the name/module has already been filled in. + If you update the symbol format here, don't forget to update read_module + as well (look for "seek to the symbol's component list"). */ static void mio_symbol (gfc_symbol *sym) @@ -3920,14 +3859,17 @@ find_symbol (gfc_symtree *st, const char *name, } -/* Skip a list between balanced left and right parens. */ +/* Skip a list between balanced left and right parens. + By setting NEST_LEVEL one assumes that a number of NEST_LEVEL opening parens + have been already parsed by hand, and the remaining of the content is to be + skipped here. The default value is 0 (balanced parens). */ static void -skip_list (void) +skip_list (int nest_level = 0) { int level; - level = 0; + level = nest_level; do { switch (parse_atom ()) @@ -4561,7 +4503,6 @@ read_module (void) info->u.rsym.ns = atom_int; get_module_locus (&info->u.rsym.where); - skip_list (); /* See if the symbol has already been loaded by a previous module. If so, we reference the existing symbol and prevent it from @@ -4572,10 +4513,56 @@ read_module (void) if (sym == NULL || (sym->attr.flavor == FL_VARIABLE && info->u.rsym.ns !=1)) - continue; + { + skip_list (); + continue; + } info->u.rsym.state = USED; info->u.rsym.sym = sym; + /* The current symbol has already been loaded, so we can avoid loading + it again. However, if it is a derived type, some of its components + can be used in expressions in the module. To avoid the module loading + failing, we need to associate the module's component pointer indexes + with the existing symbol's component pointers. */ + if (sym->attr.flavor == FL_DERIVED) + { + gfc_component *c; + + /* First seek to the symbol's component list. */ + mio_lparen (); /* symbol opening. */ + skip_list (); /* skip symbol attribute. */ + skip_list (); /* typespec. */ + require_atom (ATOM_INTEGER); /* namespace ref. */ + require_atom (ATOM_INTEGER); /* common ref. */ + skip_list (); /* formal args. */ + /* no value. */ + skip_list (); /* array_spec. */ + require_atom (ATOM_INTEGER); /* result. */ + /* not a cray pointer. */ + + mio_lparen (); /* component list opening. */ + for (c = sym->components; c; c = c->next) + { + pointer_info *p; + const char *comp_name; + int n; + + mio_lparen (); /* component opening. */ + mio_integer (&n); + p = get_integer (n); + if (p->u.pointer == NULL) + associate_integer_pointer (p, c); + mio_pool_string (&comp_name); + gcc_assert (comp_name == c->name); + skip_list (1); /* component end. */ + } + mio_rparen (); /* component list closing. */ + + skip_list (1); /* symbol end. */ + } + else + skip_list (); /* Some symbols do not have a namespace (eg. formal arguments), so the automatic "unique symtree" mechanism must be suppressed diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5dbd1ea8781b..a0320c6401b8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-01-26 Mikael Morin + + PR fortran/58007 + * gfortran.dg/unresolved_fixup_1.f90: New test. + * gfortran.dg/unresolved_fixup_2.f90: New test. + 2014-01-16 Jakub Jelinek PR target/59839 diff --git a/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 b/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 new file mode 100644 index 000000000000..07fbce3d5957 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro +! Reduced by Tobias Burnus and Janus Weil + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +contains + subroutine init_interface (A) + class(sparse_matrix), intent(in) :: A + end subroutine + real function get_value_interface() + end function +end module + +module ellpack + use matrix +end module + +module bsr + use matrix + type, extends(sparse_matrix) :: bsr_matrix + contains + procedure :: get_neighbors + end type +contains + function get_neighbors (A) + class(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use ellpack + use bsr +end diff --git a/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 b/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 new file mode 100644 index 000000000000..ca0a05a629a1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! +! PR fortran/58007 +! Unresolved fiixup while loading a module. +! +! This tests that the specification expression A%MAX_DEGREE in module BSR is +! correctly loaded and resolved in program MAIN. +! +! Original testcase from Daniel Shapiro + +module matrix + type :: sparse_matrix + integer :: max_degree + end type +end module + +module bsr + use matrix + + type, extends(sparse_matrix) :: bsr_matrix + end type + + integer :: i1 + integer :: i2 + integer :: i3 +contains + function get_neighbors (A) + type(bsr_matrix), intent(in) :: A + integer :: get_neighbors(A%max_degree) + end function +end module + +program main + use matrix + use bsr +end -- 2.47.2