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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b071f873ab64d56071281551d21c2765267b0fda..bc2a28b030abf687b6553b51b29e7dd3b4a83c58 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 52c5234276af0a80c7bb3d9da3b9db09b4894780..0f33608aa612d85e8943362b270c454b19ea2661 100644 (file)
--- 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 38b6f9ee49bc2c744afad0857d3b6d7ad4558259..24dd966e7198ba447e5c3df1a857c56305990e8b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/common_22.f90 b/gcc/testsuite/gfortran.dg/common_22.f90
new file mode 100644 (file)
index 0000000..e225409
--- /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  <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