git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Bud Davis 2015-08-08 10:40:06 +00:00 committed by Mikael Morin
parent 1aeec6dc1f
commit 0d251765be
4 changed files with 73 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
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

74
gcc/fortran/symbol.c
View File

@ -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 (p->common_block->head == p && !p->common_next)
{
/* 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)
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);
}
}
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;
}
gcc_assert(cparent->common_next == p);
cparent->common_next = csym->common_next;
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;
}
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. */

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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

24
gcc/testsuite/gfortran.dg/common_22.f90 Normal file
View File

@ -0,0 +1,24 @@
! { 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