OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Mikael Morin 2014-01-26 14:49:47 +00:00
parent d4fc9f05a3
commit ec5a3959f3
5 changed files with 156 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
2014-01-26 Mikael Morin <mikael@gcc.gnu.org>
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 <janus@gcc.gnu.org>
Backport from mainline

129
gcc/fortran/module.c
View File

@ -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

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2014-01-26 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-16 Jakub Jelinek <jakub@redhat.com>
PR target/59839

44
gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 Normal file
View File

@ -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 <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

36
gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 Normal file
View File

@ -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 <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