From patchwork Mon Aug 2 13:32:12 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 60534 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]) by ozlabs.org (Postfix) with SMTP id 71E841007D2 for ; Mon, 2 Aug 2010 23:32:48 +1000 (EST) Received: (qmail 18104 invoked by alias); 2 Aug 2010 13:32:44 -0000 Received: (qmail 18079 invoked by uid 22791); 2 Aug 2010 13:32:41 -0000 X-SWARE-Spam-Status: No, hits=1.0 required=5.0 tests=AWL, BAYES_50, RCVD_IN_DNSWL_NONE, SPF_NEUTRAL, TW_FP, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp22.services.sfr.fr (HELO smtp22.services.sfr.fr) (93.17.128.11) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 02 Aug 2010 13:32:36 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2207.sfr.fr (SMTP Server) with ESMTP id 9EE147000091; Mon, 2 Aug 2010 15:32:32 +0200 (CEST) Received: from gimli.local (73.123.193-77.rev.gaoland.net [77.193.123.73]) by msfrf2207.sfr.fr (SMTP Server) with ESMTP id BA1647000084; Mon, 2 Aug 2010 15:32:31 +0200 (CEST) X-SFR-UUID: 20100802133231762.BA1647000084@msfrf2207.sfr.fr Message-ID: <4C56C8DC.8010103@sfr.fr> Date: Mon, 02 Aug 2010 15:32:12 +0200 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; U; FreeBSD amd64; fr-FR; rv:1.9.1.11) Gecko/20100725 Thunderbird/3.0.6 MIME-Version: 1.0 To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] PR fortran/45151 : NULL changed_syms assert regressions. X-IsSubscribed: yes 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 Hello, as promised, here is the patch for the regressions introduced by my change at revision 162776. Nothing special, modified symbols have to be committed in non-parsing mode. And one needs to call gfc_undo_symbols (maybe through reject_statement) in case one emits an error. Thanks to Janus for taking part to the regression hunt. Regression testing in progress on x86_64-unknown-freebsd8.0, and patch was reported regression-free by Dominique in the PR. OK for trunk/4.5 (I plan to backport the other PR42051 fixes too) ? Mikael 2010-08-02 Mikael Morin Janus Weil PR fortran/42051 PR fortran/44064 PR fortran/45151 * intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol. * symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param, gfc_copy_formal_args, gfc_copy_formal_args_intr, gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto. * parse.c (parse_derived_contains, parse_spec, parse_progunit): Call reject_statement in case of error. (match_deferred_characteritics): Call gfc_undo_symbols in case match fails. Index: intrinsic.c =================================================================== --- intrinsic.c (revision 162798) +++ intrinsic.c (working copy) @@ -112,6 +112,8 @@ gfc_get_intrinsic_sub_symbol (const char *name) sym->attr.flavor = FL_PROCEDURE; sym->attr.proc = PROC_INTRINSIC; + gfc_commit_symbol (sym); + return sym; } Index: symbol.c =================================================================== --- symbol.c (revision 162798) +++ symbol.c (working copy) @@ -3880,6 +3880,9 @@ gen_cptr_param (gfc_formal_arglist **head, formal_arg = gfc_get_formal_arglist (); /* Add arg to list of formal args (the CPTR arg). */ add_formal_arg (head, tail, formal_arg, param_sym); + + /* Validate changes. */ + gfc_commit_symbol (param_sym); } @@ -3925,6 +3928,9 @@ gen_fptr_param (gfc_formal_arglist **head, formal_arg = gfc_get_formal_arglist (); /* Add arg to list of formal args. */ add_formal_arg (head, tail, formal_arg, param_sym); + + /* Validate changes. */ + gfc_commit_symbol (param_sym); } @@ -3997,6 +4003,9 @@ gen_shape_param (gfc_formal_arglist **head, formal_arg = gfc_get_formal_arglist (); /* Add arg to list of formal args. */ add_formal_arg (head, tail, formal_arg, param_sym); + + /* Validate changes. */ + gfc_commit_symbol (param_sym); } @@ -4059,6 +4068,9 @@ gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol /* Add arg to list of formal args. */ add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); + + /* Validate changes. */ + gfc_commit_symbol (formal_arg->sym); } /* Add the interface to the symbol. */ @@ -4116,6 +4128,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_i /* Add arg to list of formal args. */ add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); + + /* Validate changes. */ + gfc_commit_symbol (formal_arg->sym); } /* Add the interface to the symbol. */ @@ -4169,6 +4184,9 @@ gfc_copy_formal_args_ppc (gfc_component *dest, gfc /* Add arg to list of formal args. */ add_formal_arg (&head, &tail, formal_arg, formal_arg->sym); + + /* Validate changes. */ + gfc_commit_symbol (formal_arg->sym); } /* Add the interface to the symbol. */ @@ -4548,6 +4566,7 @@ generate_isocbinding_symbol (const char *mod_name, default: gcc_unreachable (); } + gfc_commit_symbol (tmp_sym); } Index: parse.c =================================================================== --- parse.c (revision 162798) +++ parse.c (working copy) @@ -1892,13 +1892,12 @@ parse_derived_contains (void) case ST_DATA_DECL: gfc_error ("Components in TYPE at %C must precede CONTAINS"); - error_flag = true; - break; + goto error; case ST_PROCEDURE: if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Type-bound" " procedure at %C") == FAILURE) - error_flag = true; + goto error; accept_statement (ST_PROCEDURE); seen_comps = true; @@ -1907,7 +1906,7 @@ parse_derived_contains (void) case ST_GENERIC: if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: GENERIC binding" " at %C") == FAILURE) - error_flag = true; + goto error; accept_statement (ST_GENERIC); seen_comps = true; @@ -1917,7 +1916,7 @@ parse_derived_contains (void) if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FINAL procedure declaration" " at %C") == FAILURE) - error_flag = true; + goto error; accept_statement (ST_FINAL); seen_comps = true; @@ -1930,7 +1929,7 @@ parse_derived_contains (void) && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type " "definition at %C with empty CONTAINS " "section") == FAILURE)) - error_flag = true; + goto error; /* ST_END_TYPE is accepted by parse_derived after return. */ break; @@ -1940,22 +1939,20 @@ parse_derived_contains (void) { gfc_error ("PRIVATE statement in TYPE at %C must be inside " "a MODULE"); - error_flag = true; - break; + goto error; } if (seen_comps) { gfc_error ("PRIVATE statement at %C must precede procedure" " bindings"); - error_flag = true; - break; + goto error; } if (seen_private) { gfc_error ("Duplicate PRIVATE statement at %C"); - error_flag = true; + goto error; } accept_statement (ST_PRIVATE); @@ -1965,18 +1962,22 @@ parse_derived_contains (void) case ST_SEQUENCE: gfc_error ("SEQUENCE statement at %C must precede CONTAINS"); - error_flag = true; - break; + goto error; case ST_CONTAINS: gfc_error ("Already inside a CONTAINS block at %C"); - error_flag = true; - break; + goto error; default: unexpected_statement (st); break; } + + continue; + +error: + error_flag = true; + reject_statement (); } pop_state (); @@ -2395,7 +2396,10 @@ match_deferred_characteristics (gfc_typespec * ts) gfc_commit_symbols (); } else - gfc_error_check (); + { + gfc_error_check (); + gfc_undo_symbols (); + } gfc_current_locus =loc; return m; @@ -2467,6 +2471,7 @@ loop: case ST_STATEMENT_FUNCTION: gfc_error ("%s statement is not allowed inside of BLOCK at %C", gfc_ascii_statement (st)); + reject_statement (); break; default: @@ -2553,6 +2558,7 @@ declSt: { gfc_error ("%s statement must appear in a MODULE", gfc_ascii_statement (st)); + reject_statement (); break; } @@ -2560,6 +2566,7 @@ declSt: { gfc_error ("%s statement at %C follows another accessibility " "specification", gfc_ascii_statement (st)); + reject_statement (); break; } @@ -4004,6 +4011,7 @@ contains: { gfc_error ("CONTAINS statement at %C is already in a contained " "program unit"); + reject_statement (); st = next_statement (); goto loop; }