===================================================================
@@ -0,0 +1,18 @@
+! { dg-do compile }
+!pr59746
+ 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
===================================================================
@@ -3069,56 +3069,56 @@
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->attr.in_common && p->common_block && p->common_block->head
+ && (p->gfc_new || !p->old_symbol->attr.in_common))
{
- /* 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;
+ 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;
+ 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;
+ 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. */
+
if (p->attr.flavor == FL_DERIVED)
gfc_delete_symtree (&p->ns->sym_root, gfc_get_string ("%c%s",
- (char) TOUPPER ((unsigned char) p->name[0]),
- &p->name[1]));
+ (char) TOUPPER ((unsigned char) p->name[0]),
+ &p->name[1]));
else
gfc_delete_symtree (&p->ns->sym_root, p->name);
@@ -3127,7 +3127,6 @@
else
restore_old_symbol (p);
}
-
latest_undo_chgset->syms.truncate (0);
latest_undo_chgset->tbps.truncate (0);