From: Daniel Kraft Date: Fri, 23 Jul 2010 09:53:45 +0000 (+0200) Subject: re PR fortran/44709 (BLOCK and GOTO/EXIT/CYCLE) X-Git-Tag: releases/gcc-4.6.0~5483 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=61b644c2ae3055e797ba6c4de28888565b667b35;p=thirdparty%2Fgcc.git re PR fortran/44709 (BLOCK and GOTO/EXIT/CYCLE) 2010-07-23 Daniel Kraft PR fortran/44709 * gfortran.h (gfc_find_symtree_in_proc): New method. * symbol.c (gfc_find_symtree_in_proc): New method. * match.c (match_exit_cycle): Look for loop name also in parent namespaces within current procedure. 2010-07-23 Daniel Kraft PR fortran/44709 * gfortran.dg/exit_1.f08: New test. * gfortran.dg/exit_2.f08: New test. From-SVN: r162450 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index de6e55f6377a..80b48764948c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2010-07-23 Daniel Kraft + + PR fortran/44709 + * gfortran.h (gfc_find_symtree_in_proc): New method. + * symbol.c (gfc_find_symtree_in_proc): New method. + * match.c (match_exit_cycle): Look for loop name also in parent + namespaces within current procedure. + 2010-07-22 Tobias Burnus PR fortran/45019 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 11ff594f59ba..401e501c41dd 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 **); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 56e9d1d515dd..92580e359dbd 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2006,7 +2006,10 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op) 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_exec_op op) 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; } } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index c12ea23a05e9..18f7b253a288 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index dfcd727337db..550b4b1bba78 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-07-23 Daniel Kraft + + PR fortran/44709 + * gfortran.dg/exit_1.f08: New test. + * gfortran.dg/exit_2.f08: New test. + 2010-07-22 Sandra Loosemore PR tree-optimization/39839 diff --git a/gcc/testsuite/gfortran.dg/exit_1.f08 b/gcc/testsuite/gfortran.dg/exit_1.f08 new file mode 100644 index 000000000000..9ebc2eccb507 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/exit_1.f08 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/exit_2.f08 b/gcc/testsuite/gfortran.dg/exit_2.f08 new file mode 100644 index 000000000000..23e7009cbf82 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/exit_2.f08 @@ -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