re PR fortran/27269 (Segfault with EQUIVALENCEs in modules together with ONLY clauses)

2006-05-02 Paul Thomas <pault@gcc.gnu.org>

        PR fortran/27269
        * module.c: Add static flag in_load_equiv.
        (mio_expr_ref): Return if no symtree and in_load_equiv.
        (load_equiv): If any of the equivalence members have no symtree, free
        the equivalence and the associated expressions.

        PR fortran/27324
        * trans-common.c (gfc_trans_common): Invert the order of calls to
        finish equivalences and gfc_commit_symbols.

        PR fortran/27269
        PR fortran/27324
        * gfortran.dg/module_equivalence_2.f90: New test.

From-SVN: r113465
This commit is contained in:
Paul Thomas 2006-05-02 14:13:17 +00:00 committed by Roger Sayle
parent 597fb86c90
commit 613e2ac8d3
5 changed files with 85 additions and 6 deletions

View File

@ -1,3 +1,15 @@
2006-05-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/27269
* module.c: Add static flag in_load_equiv.
(mio_expr_ref): Return if no symtree and in_load_equiv.
(load_equiv): If any of the equivalence members have no symtree, free
the equivalence and the associated expressions.
PR fortran/27324
* trans-common.c (gfc_trans_common): Invert the order of calls to
finish equivalences and gfc_commit_symbols.
2006-04-29 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/25681

View File

@ -182,6 +182,9 @@ static gfc_use_rename *gfc_rename_list;
static pointer_info *pi_root;
static int symbol_number; /* Counter for assigning symbol numbers */
/* Tells mio_expr_ref not to load unused equivalence members. */
static bool in_load_equiv;
/*****************************************************************/
@ -2135,6 +2138,11 @@ mio_symtree_ref (gfc_symtree ** stp)
{
require_atom (ATOM_INTEGER);
p = get_integer (atom_int);
/* An unused equivalence member; bail out. */
if (in_load_equiv && p->u.rsym.symtree == NULL)
return;
if (p->type == P_UNKNOWN)
p->type = P_SYMBOL;
@ -3008,14 +3016,18 @@ load_commons(void)
mio_rparen();
}
/* load_equiv()-- Load equivalences. */
/* load_equiv()-- Load equivalences. The flag in_load_equiv informs
mio_expr_ref of this so that unused variables are not loaded and
so that the expression can be safely freed.*/
static void
load_equiv(void)
{
gfc_equiv *head, *tail, *end;
gfc_equiv *head, *tail, *end, *eq;
bool unused;
mio_lparen();
in_load_equiv = true;
end = gfc_current_ns->equiv;
while(end != NULL && end->next != NULL)
@ -3039,16 +3051,40 @@ load_equiv(void)
mio_expr(&tail->expr);
}
/* Unused variables have no symtree. */
unused = false;
for (eq = head; eq; eq = eq->eq)
{
if (!eq->expr->symtree)
{
unused = true;
break;
}
}
if (unused)
{
for (eq = head; eq; eq = head)
{
head = eq->eq;
gfc_free_expr (eq->expr);
gfc_free (eq);
}
}
if (end == NULL)
gfc_current_ns->equiv = head;
else
end->next = head;
end = head;
if (head != NULL)
end = head;
mio_rparen();
}
mio_rparen();
in_load_equiv = false;
}
/* Recursive function to traverse the pointer_info tree and load a

View File

@ -1057,9 +1057,10 @@ gfc_trans_common (gfc_namespace *ns)
/* Translate all named common blocks. */
gfc_traverse_symtree (ns->common_root, named_common);
/* Commit the newly created symbols for common blocks. */
gfc_commit_symbols ();
/* Translate local equivalence. */
finish_equivalences (ns);
/* Commit the newly created symbols for common blocks and module
equivalences. */
gfc_commit_symbols ();
}

View File

@ -1,3 +1,9 @@
2006-05-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/27269
PR fortran/27324
* gfortran.dg/module_equivalence_2.f90: New test.
2006-05-02 Jakub Jelinek <jakub@redhat.com>
PR middle-end/27337

View File

@ -0,0 +1,24 @@
! { dg-do run }
! Tests the fix for PR27269 and PR27xxx.
! The former caused a segfault in trying to process
! module b, with an unused equivalence in a. The latter
! produced an assembler error due to multiple declarations
! for a module equivalence, when one of the variables was
! initialized, as M in module a.
!
module a
integer, parameter :: dp = selected_real_kind (10)
real(dp) :: reM, M = 1.77d0
equivalence (M, reM)
end module a
module b
use a, only : dp
end module b
use a
use b
if (reM .ne. 1.77d0) call abort ()
reM = 0.57d1
if (M .ne. 0.57d1) call abort ()
end