From patchwork Tue Aug 16 14:49:24 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 110190 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 9F530B6F77 for ; Wed, 17 Aug 2011 00:50:14 +1000 (EST) Received: (qmail 20586 invoked by alias); 16 Aug 2011 14:50:08 -0000 Received: (qmail 20567 invoked by uid 22791); 16 Aug 2011 14:50:06 -0000 X-SWARE-Spam-Status: No, hits=-1.4 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp24.services.sfr.fr (HELO smtp24.services.sfr.fr) (93.17.128.81) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 16 Aug 2011 14:49:48 +0000 Received: from filter.sfr.fr (localhost [127.0.0.1]) by msfrf2403.sfr.fr (SMTP Server) with ESMTP id 6C8C7700007C; Tue, 16 Aug 2011 16:49:43 +0200 (CEST) Received: from gimli.local (237.183.72.86.rev.sfr.net [86.72.183.237]) by msfrf2403.sfr.fr (SMTP Server) with ESMTP id 27ACE7000072; Tue, 16 Aug 2011 16:49:43 +0200 (CEST) X-SFR-UUID: 20110816144943162.27ACE7000072@msfrf2403.sfr.fr From: Mikael Morin To: fortran@gcc.gnu.org Subject: Re: [Patch, fortran] PR fortran/50071 Duplicate statement labels from different scoping units rejected. Date: Tue, 16 Aug 2011 16:49:24 +0200 User-Agent: KMail/1.13.5 (FreeBSD/8.2-PRERELEASE; KDE/4.5.5; amd64; ; ) Cc: Tobias Burnus , "gcc-patches" References: <201108131525.48949.mikael.morin@sfr.fr> <4E477ADC.6010506@net-b.de> In-Reply-To: <4E477ADC.6010506@net-b.de> MIME-Version: 1.0 Message-Id: <201108161649.25326.mikael.morin@sfr.fr> 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 On Sunday 14 August 2011 09:35:56 Tobias Burnus wrote: > I think the following is valid and it is still rejected (it is accepted > by NAG 5.1 and ifort): > > 1 type t > integer :: i > end type t > > goto 1 > 1 print *, 'Hello' > end > > Related but separate issue: BLOCK also starts a new scoping unit, but > the following is rejected: > > block > goto 1 > print *, 'Hello' > 1 continue > end block > 1 continue > end > > > Also the following is rejected: > > block > goto 1 > print *, 'Hello' > 1 end block > end > > variant, which is rejected (note: Associate does not start a new scoping > unit, just a new block): > > integer :: i > associate (j => i) > goto 1 > print *, 'Hello' > 1 end associate > end > Hem, OK; it is a can of Pandora. I can propose the following ad-hoc fix for the two latter cases. It uses the same hack as is used for IF, SELECT, and possibly others: make a dummy code that will get the label. The difference is that here, the dummy code is inserted in the nested scope (i.e. in the BLOCK or ASSOCIATE scope) instead of the parent one. For consistency, I renamed EXEC_END_BLOCK to EXEC_END_NESTED_BLOCK, and reused EXEC_END_BLOCK for the new code. The patch passes gfortran.dg/*goto* and gfortran.dg/*label*, and I'm doing a full regression test. Is that OK? About your two former cases, the first one looks especially tricky. For the second one, it may be valid, but a warning would be nice IMO as one of the labels is masked by the other. Both cases need more investigation anyway. Mikael. 2011-08-16 Mikael Morin PR fortran/50071 * gfortran.h (gfc_exec_op): New constant EXEC_END_NESTED_BLOCK. * parse.c (check_statement_label): Accept ST_END_BLOCK and ST_END_ASSOCIATE as valid branch target. (accept_statement): Change EXEC_END_BLOCK to EXEC_END_NESTED_BLOCK. Add EXEC_END_BLOCK code in the ST_END_BLOCK and ST_END_ASSOCIATE cases. * resolve.c (find_reachable_labels): Change EXEC_END_BLOCK to EXEC_END_NESTED_BLOCK. (resolve_branch): Ditto. (resolve_code): Add EXEC_END_NESTED_BLOCK case. * st.c (gfc_free_statement): Ditto. * trans.c (trans_code): Ditto. diff --git a/gfortran.h b/gfortran.h index 34afae4..bbccc08 100644 --- a/gfortran.h +++ b/gfortran.h @@ -2048,8 +2048,8 @@ gfc_association_list; /* Executable statements that fill gfc_code structures. */ typedef enum { - EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, - EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP, + EXEC_NOP = 1, EXEC_END_NESTED_BLOCK, EXEC_END_BLOCK, EXEC_ASSIGN, + EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP, EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN, EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN, EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK, diff --git a/parse.c b/parse.c index 2910ab5..b894ee8 100644 --- a/parse.c +++ b/parse.c @@ -1115,6 +1115,8 @@ check_statement_label (gfc_statement st) case ST_ENDIF: case ST_END_SELECT: case ST_END_CRITICAL: + case ST_END_BLOCK: + case ST_END_ASSOCIATE: case_executable: case_exec_markers: type = ST_LABEL_TARGET; @@ -1627,6 +1629,18 @@ accept_statement (gfc_statement st) case ST_END_CRITICAL: if (gfc_statement_label != NULL) { + new_st.op = EXEC_END_NESTED_BLOCK; + add_statement (); + } + break; + + /* In the case of BLOCK and ASSOCIATE blocks, there cannot be more than + one parallel block. Thus, we add the special code to the nested block + itself, instead of the parent one. */ + case ST_END_BLOCK: + case ST_END_ASSOCIATE: + if (gfc_statement_label != NULL) + { new_st.op = EXEC_END_BLOCK; add_statement (); } diff --git a/resolve.c b/resolve.c index b8a8ebb..fcb5083 100644 --- a/resolve.c +++ b/resolve.c @@ -8202,7 +8202,7 @@ find_reachable_labels (gfc_code *block) up through the code_stack. */ for (c = block; c; c = c->next) { - if (c->here && c->op != EXEC_END_BLOCK) + if (c->here && c->op != EXEC_END_NESTED_BLOCK) bitmap_set_bit (cs_base->reachable_labels, c->here->value); } @@ -8382,7 +8382,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) if (stack) { - gcc_assert (stack->current->next->op == EXEC_END_BLOCK); + gcc_assert (stack->current->next->op == EXEC_END_NESTED_BLOCK); return; } @@ -9118,6 +9118,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) { case EXEC_NOP: case EXEC_END_BLOCK: + case EXEC_END_NESTED_BLOCK: case EXEC_CYCLE: case EXEC_PAUSE: case EXEC_STOP: diff --git a/st.c b/st.c index c051d6a..572baaf 100644 --- a/st.c +++ b/st.c @@ -89,6 +89,7 @@ gfc_free_statement (gfc_code *p) { case EXEC_NOP: case EXEC_END_BLOCK: + case EXEC_END_NESTED_BLOCK: case EXEC_ASSIGN: case EXEC_INIT_ASSIGN: case EXEC_GOTO: diff --git a/trans.c b/trans.c index 4c97cfd..4a71c43 100644 --- a/trans.c +++ b/trans.c @@ -1188,6 +1188,7 @@ trans_code (gfc_code * code, tree cond) { case EXEC_NOP: case EXEC_END_BLOCK: + case EXEC_END_NESTED_BLOCK: case EXEC_END_PROCEDURE: res = NULL_TREE; break;