Index: fortran/symbol.c =================================================================== *** fortran/symbol.c (révision 226157) --- fortran/symbol.c (copie de travail) *************** *** 3168,3216 **** FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p) { ! if (p->gfc_new) { ! /* 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 (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) ! { ! 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; } - } /* 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. */ --- 3168,3216 ---- 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) { ! /* 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; ! 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); } + } ! 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. */ Index: testsuite/gfortran.dg/common_22.f90 =================================================================== *** testsuite/gfortran.dg/common_22.f90 (révision 0) --- testsuite/gfortran.dg/common_22.f90 (copie de travail) *************** *** 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 + + 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