Hello,
I'm unburrying the patch from the thread starting at:
https://gcc.gnu.org/ml/gcc-patches/2014-03/msg00439.html
I provide the patch in two flavors read-only (without whitespace
changes) and write-only (with them).
This has been tested on x86_64-unknown-linux-gnu. OK for trunk?
Mikael
2015-07-29 Bud Davis <jmda...@link.com>
Mikael Morin <mik...@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-07-29 Bud Davis <jmda...@link.com>
PR fortran/59746
* gfortran.dg/common_22.f90: New.
*** /tmp/ro4P6U_symbol.c 2015-07-29 20:08:48.675970662 +0200
--- gcc/fortran/symbol.c 2015-07-29 19:48:25.580979685 +0200
*************** gfc_restore_last_undo_checkpoint (void)
*** 3168,3177 ****
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
! if (p->gfc_new)
! {
! /* 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
--- 3168,3177 ----
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
! /* 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)
{
/* If the symbol was added to any common block, it
needs to be removed to stop the resolver looking
*************** gfc_restore_last_undo_checkpoint (void)
*** 3206,3216 ****
}
gcc_assert(cparent->common_next == p);
-
cparent->common_next = csym->common_next;
}
}
!
/* 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. */
--- 3206,3216 ----
}
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. */
*** /dev/null 2015-07-28 11:36:43.193098438 +0200
--- gcc/testsuite/gfortran.dg/common_22.f90 2015-07-29 19:59:59.864974563 +0200
***************
*** 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 <jmda...@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
Index: fortran/symbol.c
===================================================================
*** fortran/symbol.c (révision 226157)
--- fortran/symbol.c (copie de travail)
***************
*** 3168,3216 ****
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
! if (p->gfc_new)
{
! /* 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)
{
! 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;
}
- }
/* 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. */
--- 3168,3216 ----
FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
{
! /* 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)
{
! /* 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)
{
! 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. */
Index: testsuite/gfortran.dg/common_22.f90
===================================================================
*** testsuite/gfortran.dg/common_22.f90 (révision 0)
--- testsuite/gfortran.dg/common_22.f90 (copie de travail)
***************
*** 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 <jmda...@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
