Hello,
Dominique noticed that the test coming with the preceding PR67758 patch
[1] was failing if compiled as free form.
[1] https://gcc.gnu.org/ml/gcc-patches/2015-10/msg00301.html
The problem is again an inconsistent state, but this time between the
in_common attribute and the common_block pointer.
So, here is another iteration, hopefully fixing the remaining problems.
The changes are:
- 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.
Both of these changes fix the testcase independently, but with some
regressions, so there is additionally:
- 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.
Regression tested on x86_64-linux. OK for trunk?
Mikael
2015-10-06 Mikael Morin <mik...@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-06 Mikael Morin <mik...@gcc.gnu.org>
PR fortran/67758
* gfortran.dg/common_25.f90: New file.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 9c0084b..b2894cc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 29437c3..74f26b7 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -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.
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 35a3496..a9a0dc0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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)
{
! { 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
