Fix common-related error recovery ICE.
authorMikael Morin <mikael@gcc.gnu.org>
Sun, 18 Oct 2015 17:17:21 +0000 (17:17 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Sun, 18 Oct 2015 17:17:21 +0000 (17:17 +0000)
Fix an inconsistent state, between the in_common attribute
and the common_block pointer.

 - adding a symbol to a common block list in gfc_match_common is delayed
   after the call to gfc_add_in_common.
 - gfc_restore_latest_undo_checkpoint is changed to check the common_block
   pointer directly instead of the in_common attribute.
 - gfc_restore_old_symbol is changed to also restore
   the common-related pointers.  This is done using a new function created
   to factor the related memory management.
 - In gfc_restore_last_undo_checkpoint, when a symbol has been removed
   from the common block linked list, its common_next pointer is cleared.

PR fortran/67758
gcc/fortran/
* gfortran.h (gfc_symbol): Expand comment.
* match.c (gfc_match_common): Delay adding the symbol to
the common_block after the gfc_add_in_common call.
* symbol.c (gfc_free_symbol): Move common block memory handling...
(gfc_set_symbol_common_block): ... here as a new function.
(restore_old_symbol): Restore common block fields.
(gfc_restore_last_undo_checkpoint):
Check the common_block pointer instead of the in_common attribute.
When a symbol has been removed from the common block linked list,
clear its common_next pointer.
gcc/testsuite/
* gfortran.dg/common_25.f90: New file.

From-SVN: r228947

gcc/fortran/ChangeLog
gcc/fortran/gfortran.h
gcc/fortran/match.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/common_25.f90 [new file with mode: 0644]

index 51b07de4f026484ea2ee78cf57c286ad69fa5891..53d309447b70c0f6d1f0673aad183d01f17bd6d6 100644 (file)
@@ -1,3 +1,17 @@
+2015-10-18  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/67758
+       * gfortran.h (gfc_symbol): Expand comment.
+       * match.c (gfc_match_common): Delay adding the symbol to
+       the common_block after the gfc_add_in_common call.
+       * symbol.c (gfc_free_symbol): Move common block memory handling...
+       (gfc_set_symbol_common_block): ... here as a new function.
+       (restore_old_symbol): Restore common block fields.
+       (gfc_restore_last_undo_checkpoint):
+       Check the common_block pointer instead of the in_common attribute.
+       When a symbol has been removed from the common block linked list,
+       clear its common_next pointer.
+
 2015-10-18  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/67177
index 9c0084be77c63e7e7c817544297d3fe5425181f6..b2894cc22c46f8c36cba88f67dc918cdd9509d2d 100644 (file)
@@ -1411,8 +1411,12 @@ typedef struct gfc_symbol
 
   struct gfc_symbol *common_next;      /* Links for COMMON syms */
 
-  /* This is in fact a gfc_common_head but it is only used for pointer
-     comparisons to check if symbols are in the same common block.  */
+  /* This is only used for pointer comparisons to check if symbols
+     are in the same common block.
+     In opposition to common_block, the common_head pointer takes into account
+     equivalences: if A is in a common block C and A and B are in equivalence,
+     then both A and B have common_head pointing to C, while A's common_block
+     points to C and B's is NULL.  */
   struct gfc_common_head* common_head;
 
   /* Make sure setup code for dummy arguments is generated in the correct
index 29437c36599297236f9ce45ccf737d158b89b1bc..74f26b7b7fe5e5ffeae34ef2ff27148a0b653269 100644 (file)
@@ -4365,16 +4365,6 @@ gfc_match_common (void)
                goto cleanup;
            }
 
-         sym->common_block = t;
-         sym->common_block->refs++;
-
-         if (tail != NULL)
-           tail->common_next = sym;
-         else
-           *head = sym;
-
-         tail = sym;
-
          /* Deal with an optional array specification after the
             symbol name.  */
          m = gfc_match_array_spec (&as, true, true);
@@ -4409,6 +4399,16 @@ gfc_match_common (void)
             if any, and continue matching.  */
          gfc_add_in_common (&sym->attr, sym->name, NULL);
 
+         sym->common_block = t;
+         sym->common_block->refs++;
+
+         if (tail != NULL)
+           tail->common_next = sym;
+         else
+           *head = sym;
+
+         tail = sym;
+
          sym->common_head = t;
 
          /* Check to see if the symbol is already in an equivalence group.
index 35a3496c08bfcdc7407346518490863f7d4e1c97..a9a0dc07e5b2e3b10b318b45a1b8d84c1d357782 100644 (file)
@@ -2585,6 +2585,25 @@ gfc_find_uop (const char *name, gfc_namespace *ns)
 }
 
 
+/* Update a symbol's common_block field, and take care of the associated
+   memory management.  */
+
+static void
+set_symbol_common_block (gfc_symbol *sym, gfc_common_head *common_block)
+{
+  if (sym->common_block == common_block)
+    return;
+
+  if (sym->common_block && sym->common_block->name[0] != '\0')
+    {
+      sym->common_block->refs--;
+      if (sym->common_block->refs == 0)
+       free (sym->common_block);
+    }
+  sym->common_block = common_block;
+}
+
+
 /* Remove a gfc_symbol structure and everything it points to.  */
 
 void
@@ -2612,12 +2631,7 @@ gfc_free_symbol (gfc_symbol *sym)
 
   gfc_free_namespace (sym->f2k_derived);
 
-  if (sym->common_block && sym->common_block->name[0] != '\0')
-    { 
-      sym->common_block->refs--; 
-      if (sym->common_block->refs == 0)
-       free (sym->common_block);
-    }
+  set_symbol_common_block (sym, NULL);
 
   free (sym);
 }
@@ -3090,6 +3104,9 @@ restore_old_symbol (gfc_symbol *p)
       p->formal = old->formal;
     }
 
+  set_symbol_common_block (p, old->common_block);
+  p->common_head = old->common_head;
+
   p->old_symbol = old->old_symbol;
   free (old);
 }
@@ -3178,15 +3195,13 @@ gfc_restore_last_undo_checkpoint (void)
 
   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)
+      /* Symbol in a common block was new. Or was old and just put in common */
+      if (p->common_block
+         && (p->gfc_new || !p->old_symbol->common_block))
        {
          /* 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;
@@ -3218,6 +3233,7 @@ gfc_restore_last_undo_checkpoint (void)
              gcc_assert(cparent->common_next == p);
              cparent->common_next = csym->common_next;
            }
+         p->common_next = NULL;
        }
       if (p->gfc_new)
        {
index b477f0d27f9ff7da25f3c0a97f19c13660393da0..95d68856e3a8cda4449b926967925df09d9ad538 100644 (file)
@@ -1,3 +1,8 @@
+2015-10-18  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/67758
+       * gfortran.dg/common_25.f90: New file.
+
 2015-10-18  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/67177
diff --git a/gcc/testsuite/gfortran.dg/common_25.f90 b/gcc/testsuite/gfortran.dg/common_25.f90
new file mode 100644 (file)
index 0000000..b5921ba
--- /dev/null
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! PR fortran/67758
+!
+! Check the absence of ICE after emitting the error message
+!
+! This test is  the free form variant of common_24.f.
+
+      REAL :: X
+      COMMON /FMCOM / X(80 000 000)  ! { dg-error "Expected another dimension" }
+      CALL T(XX(A))
+      COMMON /FMCOM / XX(80 000 000) ! { dg-error "Expected another dimension" }
+      END