From patchwork Fri Jul 23 08:39:22 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Daniel Kraft X-Patchwork-Id: 59741 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 CA92A1007D1 for ; Fri, 23 Jul 2010 18:34:39 +1000 (EST) Received: (qmail 5532 invoked by alias); 23 Jul 2010 08:34:34 -0000 Received: (qmail 5512 invoked by uid 22791); 23 Jul 2010 08:34:32 -0000 X-SWARE-Spam-Status: No, hits=-2.5 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_LOW, SPF_HELO_PASS X-Spam-Check-By: sourceware.org Received: from tatiana.utanet.at (HELO tatiana.utanet.at) (213.90.36.46) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 23 Jul 2010 08:34:23 +0000 Received: from paris.xoc.tele2net.at ([213.90.36.7]) by tatiana.utanet.at with esmtp (Exim 4.71) (envelope-from ) id 1OcDi0-0003sP-UF; Fri, 23 Jul 2010 10:34:20 +0200 Received: from d86-33-93-123.cust.tele2.at ([86.33.93.123] helo=[10.0.0.18]) by paris.xoc.tele2net.at with esmtpa (Exim 4.71) (envelope-from ) id 1OcDi0-0005HX-NQ; Fri, 23 Jul 2010 10:34:20 +0200 Message-ID: <4C49553A.4030806@domob.eu> Date: Fri, 23 Jul 2010 10:39:22 +0200 From: Daniel Kraft User-Agent: Thunderbird 2.0.0.0 (X11/20070425) MIME-Version: 1.0 To: Fortran List CC: gcc-patches Subject: [Patch, Fortran] PR fortran/44709: EXIT/CYCLE a named loop from within a BLOCK 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 Hi all, the attached patch fixes a small problem (the still missing one of PR 44709) that rejected EXIT/CYCLE statements with loop-name when there was a BLOCK inbetween the statement and the loop. The problem is simply that EXIT/CYCLE matching looked for the label just within the current namespace, but as BLOCK introduces a new one, needs to search also in the parent namespaces -- however, of course only within the current procedure. Thus I added a new function gfc_find_symtree_in_proc that does exactly this (look through namespaces including parents as long as those are for constructs and not seperate procedures) and use it in the matcher. Regression testing at the moment at GNU/Linux-x86-32. Ok for trunk if no failure? Still missing for this area of features is EXIT for any constructs, just as a side-note. Yours, Daniel Index: gcc/fortran/symbol.c =================================================================== --- gcc/fortran/symbol.c (revision 162408) +++ gcc/fortran/symbol.c (working copy) @@ -2565,6 +2565,27 @@ select_type_insert_tmp (gfc_symtree **st } +/* Look for a symtree in the current procedure -- that is, go up to + parent namespaces but only if inside a BLOCK. Returns NULL if not found. */ + +gfc_symtree* +gfc_find_symtree_in_proc (const char* name, gfc_namespace* ns) +{ + while (ns) + { + gfc_symtree* st = gfc_find_symtree (ns->sym_root, name); + if (st) + return st; + + if (!ns->construct_entities) + break; + ns = ns->parent; + } + + return NULL; +} + + /* Search for a symtree starting in the current namespace, resorting to any parent namespaces if requested by a nonzero parent_flag. Returns nonzero if the name is ambiguous. */ Index: gcc/fortran/gfortran.h =================================================================== --- gcc/fortran/gfortran.h (revision 162408) +++ gcc/fortran/gfortran.h (working copy) @@ -2512,6 +2512,7 @@ gfc_user_op *gfc_get_uop (const char *); gfc_user_op *gfc_find_uop (const char *, gfc_namespace *); void gfc_free_symbol (gfc_symbol *); gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *); +gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *); int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **); int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **); Index: gcc/fortran/match.c =================================================================== --- gcc/fortran/match.c (revision 162408) +++ gcc/fortran/match.c (working copy) @@ -2006,7 +2006,10 @@ match_exit_cycle (gfc_statement st, gfc_ sym = NULL; else { - m = gfc_match ("% %s%t", &sym); + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symtree* stree; + + m = gfc_match ("% %n%t", name); if (m == MATCH_ERROR) return MATCH_ERROR; if (m == MATCH_NO) @@ -2015,10 +2018,22 @@ match_exit_cycle (gfc_statement st, gfc_ return MATCH_ERROR; } + /* Find the corresponding symbol. If there's a BLOCK statement + between here and the label, it is not in gfc_current_ns but a parent + namespace! */ + stree = gfc_find_symtree_in_proc (name, gfc_current_ns); + if (!stree) + { + gfc_error ("Name '%s' in %s statement at %C is unknown", + name, gfc_ascii_statement (st)); + return MATCH_ERROR; + } + + sym = stree->n.sym; if (sym->attr.flavor != FL_LABEL) { gfc_error ("Name '%s' in %s statement at %C is not a loop name", - sym->name, gfc_ascii_statement (st)); + name, gfc_ascii_statement (st)); return MATCH_ERROR; } } Index: gcc/testsuite/gfortran.dg/exit_2.f08 =================================================================== --- gcc/testsuite/gfortran.dg/exit_2.f08 (revision 0) +++ gcc/testsuite/gfortran.dg/exit_2.f08 (revision 0) @@ -0,0 +1,31 @@ +! { dg-do compile } +! { dg-options "-std=f2008" } + +! PR fortran/44709 +! Check that the resolving of loop names in parent namespaces introduced to +! handle intermediate BLOCK's does not go too far and other sanity checks. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + + EXIT ! { dg-error "is not within a loop" } + EXIT foobar ! { dg-error "is unknown" } + EXIT main ! { dg-error "is not a loop name" } + + mainLoop: DO + CALL test () + END DO mainLoop + + otherLoop: DO + EXIT mainLoop ! { dg-error "is not within loop 'mainloop'" } + END DO otherLoop + +CONTAINS + + SUBROUTINE test () + EXIT mainLoop ! { dg-error "is unknown" } + END SUBROUTINE test + +END PROGRAM main Index: gcc/testsuite/gfortran.dg/exit_1.f08 =================================================================== --- gcc/testsuite/gfortran.dg/exit_1.f08 (revision 0) +++ gcc/testsuite/gfortran.dg/exit_1.f08 (revision 0) @@ -0,0 +1,50 @@ +! { dg-do run } +! { dg-options "-std=f2008 -fall-intrinsics" } + +! PR fortran/44709 +! Check that exit and cycle from within a BLOCK works for loops as expected. + +! Contributed by Daniel Kraft, d@domob.eu. + +PROGRAM main + IMPLICIT NONE + INTEGER :: i + + ! Simple exit without loop name. + DO + BLOCK + EXIT + END BLOCK + CALL abort () + END DO + + ! Cycle without loop name. + DO i = 1, 1 + BLOCK + CYCLE + END BLOCK + CALL abort () + END DO + + ! Exit loop by name from within a BLOCK. + loop1: DO + DO + BLOCK + EXIT loop1 + END BLOCK + CALL abort () + END DO + CALL abort () + END DO loop1 + + ! Cycle loop by name from within a BLOCK. + loop2: DO i = 1, 1 + loop3: DO + BLOCK + CYCLE loop2 + END BLOCK + CALL abort () + END DO loop3 + CALL abort () + END DO loop2 +END PROGRAM main