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

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

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 the symbol was added to any common block, it
-	  if (p->attr.in_common && p->common_block && p->common_block->head)
+	     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
+	      gfc_symtree st, *st0;
-		 needs to be removed to stop the resolver looking
+	      st0 = find_common_symtree (p->ns->common_root,
-		 for a (possibly) dead symbol.  */
+					 p->common_block);
-
+	      if (st0)
-	      if (p->common_block->head == p && !p->common_next)
 		{
-		  gfc_symtree st, *st0;
+		  st.name = st0->name;
-		  st0 = find_common_symtree (p->ns->common_root,
+		  gfc_delete_bbt (&p->ns->common_root, &st, compare_symtree);
-					     p->common_block);
+		  free (st0);
-		  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->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.  */

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

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