From patchwork Tue Oct 6 17:52:16 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 526862 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 8DF83140D6C for ; Wed, 7 Oct 2015 04:52:37 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=BcpVMqQP; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; q=dns; s= default; b=xh7OqOp+aI5/xma7FoxHlvWoe7L0IhKrP+ww9R0PKaUdZeXdnWCah ZyMc2R535/dVLmgHQUres4LUSEYvA/G38rF6FK9BD/1LeKvjeVXPJXoc68tXogur KB+V8t4uGIytue4CiwilqEbbi6N99mP/DKrnCm2pFGS0OiwVeXl9bU= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; s= default; bh=ppSam97i5uGEsO/0vDFWWJA3heM=; b=BcpVMqQP/Hl2DJ1bkXwM npvGU7Jo4RABTV812Dd5tQRyYCF7Ke4qtyihNO3jyx35VUG8hP44mKzI6j9h8Wfi FhJMOgGdAY4/DXG8qBxltp+EBiC0O2j4txuHZpZB0qec3UtDXKue+tnyc+fjKf/A UnzqTwAGe9heP1irLR7uXXw= Received: (qmail 33772 invoked by alias); 6 Oct 2015 17:52:26 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 33750 invoked by uid 89); 6 Oct 2015 17:52:25 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: smtp21.services.sfr.fr Received: from smtp21.services.sfr.fr (HELO smtp21.services.sfr.fr) (93.17.128.1) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Tue, 06 Oct 2015 17:52:23 +0000 Received: from filter.sfr.fr (localhost [86.72.15.108]) by msfrf2102.sfr.fr (SMTP Server) with ESMTP id 5EDE370000B2; Tue, 6 Oct 2015 19:52:20 +0200 (CEST) Authentication-Results: sfrmc.priv.atos.fr; dkim=none (no signature); dkim-adsp=none (no policy) header.from=mikael.morin@sfr.fr Received: from [192.168.1.85] (108.15.72.86.rev.sfr.net [86.72.15.108]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) by msfrf2102.sfr.fr (SMTP Server) with ESMTP id EE6307000087; Tue, 6 Oct 2015 19:52:19 +0200 (CEST) X-SFR-UUID: 20151006175219976.EE6307000087@msfrf2102.sfr.fr From: Mikael Morin Subject: [Patch, fortran] COMMON block error recovery: PR 67758 (second pass) To: gcc-patches , gfortran Message-ID: <56140A50.7040905@sfr.fr> Date: Tue, 6 Oct 2015 19:52:16 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.2.0 MIME-Version: 1.0 X-IsSubscribed: yes 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 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 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) {