+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
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
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);
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.
}
+/* 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
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);
}
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);
}
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;
gcc_assert(cparent->common_next == p);
cparent->common_next = csym->common_next;
}
+ p->common_next = NULL;
}
if (p->gfc_new)
{
+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
--- /dev/null
+! { 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