Skip to content

R
riscv-gcc-1
Commit ddafd21a by Mikael Morin
Options

re PR fortran/58007 ([OOP] ICE in free_pi_tree(): Unresolved fixup -… 

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 (MOD_VERSION): Bump.
        (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
        (mio_symbol): Dump component list earlier.
        (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: r206759
parent 646bdeab
Showing with 157 additions and 82 deletions
gcc/fortran/ChangeLog
2014-01-18 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/58007
* module.c (MOD_VERSION): Bump.
(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
(mio_symbol): Dump component list earlier.
(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-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/58026
......
gcc/fortran/module.c
......@@ -82,7 +82,7 @@ along with GCC; see the file COPYING3. If not see
/* Don't put any single quote (') in MOD_VERSION, if you want it to be
recognized. */
#define MOD_VERSION "11"
#define MOD_VERSION "12"
/* Structure that describes a position within a module file. */
......@@ -390,37 +390,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
......@@ -2588,45 +2557,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;
}
}
......@@ -2983,7 +2920,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:
......@@ -3855,7 +3792,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)
......@@ -3865,6 +3804,14 @@ mio_symbol (gfc_symbol *sym)
mio_lparen ();
mio_symbol_attribute (&sym->attr);
/* Note that components are always saved, even if they are supposed
to be private. Component access is checked during searching. */
mio_component_list (&sym->components, sym->attr.vtype);
if (sym->components != NULL)
sym->component_access
= MIO_NAME (gfc_access) (sym->component_access, access_types);
mio_typespec (&sym->ts);
if (sym->ts.type == BT_CLASS)
sym->attr.class_ok = 1;
......@@ -3893,15 +3840,6 @@ mio_symbol (gfc_symbol *sym)
if (sym->attr.cray_pointee)
mio_symbol_ref (&sym->cp_pointer);
/* Note that components are always saved, even if they are supposed
to be private. Component access is checked during searching. */
mio_component_list (&sym->components, sym->attr.vtype);
if (sym->components != NULL)
sym->component_access
= MIO_NAME (gfc_access) (sym->component_access, access_types);
/* Load/save the f2k_derived namespace of a derived-type symbol. */
mio_full_f2k_derived (sym);
......@@ -3997,14 +3935,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 ())
......@@ -4638,7 +4579,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
......@@ -4649,10 +4589,45 @@ 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. */
mio_lparen (); /* component list opening. */
for (c = sym->components; c; c = c->next)
{
pointer_info *p;
int n;
mio_lparen (); /* component opening. */
mio_integer (&n);
p = get_integer (n);
if (p->u.pointer == NULL)
associate_integer_pointer (p, c);
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
......
gcc/testsuite/ChangeLog
2014-01-18 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/58007
* gfortran.dg/unresolved_fixup_1.f90: New test.
* gfortran.dg/unresolved_fixup_2.f90: New test.
2014-01-18 Jakub Jelinek <jakub@redhat.com>
PR target/58944
......@@ -19,7 +25,7 @@
2014-01-17 Jeff Law <law@redhat.com>
PR middle-end/57904
PR middle-end/57904
* gfortran.dg/pr57904.f90: New test.
2014-01-17 Paolo Carlini <paolo.carlini@oracle.com>
......
gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 0 → 100644
! { 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 <shapero@uw.edu>
! Reduced by Tobias Burnus <burnus@net-b.de> and Janus Weil <janus@gcc.gnu.org>
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
gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 0 → 100644
! { 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 <shapero@uw.edu>
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment