Commit 0d251765 by Bud Davis Committed by Mikael Morin

When undoing symbols, also restore common block lists

gcc/fortran/
2015-08-08  Bud Davis  <jmdavis@link.com>
	    Mikael Morin  <mikael@gcc.gnu.org>

	PR fortran/59746
	* symbol.c (gfc_restore_last_undo_checkpoint): Delete a common block
	symbol if it was put in the list.

gcc/testsuite/
2015-08-08  Bud Davis  <jmdavis@link.com>

	PR fortran/59746
	* gfortran.dg/common_22.f90: New.


Co-Authored-By: Mikael Morin <mikael@gcc.gnu.org>

From-SVN: r226732
parent 1aeec6dc
2015-08-08 Bud Davis <jmdavis@link.com>
Mikael Morin <mikael@gcc.gnu.org>
PR fortran/59746
* symbol.c (gfc_restore_last_undo_checkpoint): Delete a common block
symbol if it was put in the list.
2015-08-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/64104
......
......@@ -3168,49 +3168,49 @@ gfc_restore_last_undo_checkpoint (void)
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
if (p->gfc_new)
/* Symbol was new. Or was old and just put in common */
if ((p->gfc_new
|| (p->attr.in_common && !p->old_symbol->attr.in_common ))
&& p->attr.in_common && p->common_block && p->common_block->head)
{
/* Symbol was new. */
if (p->attr.in_common && p->common_block && p->common_block->head)
{
/* If the symbol was added to any common block, it
needs to be removed to stop the resolver looking
for a (possibly) dead symbol. */
/* If the symbol was added to any common block, it
needs to be removed to stop the resolver looking
for a (possibly) dead symbol. */
if (p->common_block->head == p && !p->common_next)
if (p->common_block->head == p && !p->common_next)
{
gfc_symtree st, *st0;
st0 = find_common_symtree (p->ns->common_root,
p->common_block);
if (st0)
{
gfc_symtree st, *st0;
st0 = find_common_symtree (p->ns->common_root,
p->common_block);
if (st0)
{
st.name = st0->name;
gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree);
free (st0);
}
st.name = st0->name;
gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree);
free (st0);
}
}
if (p->common_block->head == p)
p->common_block->head = p->common_next;
else
{
gfc_symbol *cparent, *csym;
cparent = p->common_block->head;
csym = cparent->common_next;
while (csym != p)
{
cparent = csym;
csym = csym->common_next;
}
if (p->common_block->head == p)
p->common_block->head = p->common_next;
else
{
gfc_symbol *cparent, *csym;
gcc_assert(cparent->common_next == p);
cparent = p->common_block->head;
csym = cparent->common_next;
cparent->common_next = csym->common_next;
while (csym != p)
{
cparent = csym;
csym = csym->common_next;
}
}
gcc_assert(cparent->common_next == p);
cparent->common_next = csym->common_next;
}
}
if (p->gfc_new)
{
/* The derived type is saved in the symtree with the first
letter capitalized; the all lower-case version to the
derived type contains its associated generic function. */
......
2015-08-08 Bud Davis <jmdavis@link.com>
PR fortran/59746
* gfortran.dg/common_22.f90: New.
2015-08-08 Segher Boessenkool <segher@kernel.crashing.org>
PR rtl-optimization/67028
......
! { dg-do compile }
!
! PR fortran/59746
! Check that symbols present in common block are properly cleaned up
! upon error.
!
! Contributed by Bud Davis <jmdavis@link.com>
CALL RCCFL (NVE,IR,NU3,VE (1,1,1,I))
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
! the PR only contained the two above.
! success is no segfaults or infinite loops.
! let's check some combinations
CALL ABC (INTG)
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
CALL DEF (NT1)
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
CALL GHI (NRESL)
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
COMMON /CCFILE/ INTG,NT1,NT2,NT3,NVM,NVE,NFRLE,NRESF,NRESL !{ dg-error "Unexpected COMMON" }
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