re PR fortran/16861 ([4.0 only] segfault with doubly used module)
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-23 Paul Thomas <pault@gcc.gnu.org> PR fortran/16861 * gfortran.dg/nested_modules_3.f90: New. From-SVN: r104574
This commit is contained in:
Paul Thomas
parent
e1e73e8db7
commit
acff2da93c
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue