From 0d251765bed679b14b4f9f2d5ade7870b7b9d7c5 Mon Sep 17 00:00:00 2001 From: Bud Davis Date: Sat, 8 Aug 2015 10:40:06 +0000 Subject: [PATCH] When undoing symbols, also restore common block lists gcc/fortran/ 2015-08-08 Bud Davis Mikael Morin 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 PR fortran/59746 * gfortran.dg/common_22.f90: New. Co-Authored-By: Mikael Morin From-SVN: r226732 --- gcc/fortran/ChangeLog | 7 +++ gcc/fortran/symbol.c | 68 ++++++++++++------------- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/common_22.f90 | 24 +++++++++ 4 files changed, 70 insertions(+), 34 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/common_22.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b071f873ab6..bc2a28b030a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2015-08-08 Bud Davis + Mikael Morin + + 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 PR fortran/64104 diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 52c5234276a..0f33608aa61 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 38b6f9ee49b..24dd966e719 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-08-08 Bud Davis + + PR fortran/59746 + * gfortran.dg/common_22.f90: New. + 2015-08-08 Segher Boessenkool PR rtl-optimization/67028 diff --git a/gcc/testsuite/gfortran.dg/common_22.f90 b/gcc/testsuite/gfortran.dg/common_22.f90 new file mode 100644 index 00000000000..e2254099d72 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/common_22.f90 @@ -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 + + 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 -- 2.30.2