From d80c695ff0da09ebbb0d7b4370396e36d4e58180 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Tobias=20Schl=C3=BCter?= Date: Sun, 29 Mar 2009 19:15:48 +0200 Subject: [PATCH] re PR fortran/38507 (Bogus Warning: Deleted feature: GOTO jumps to END of construct) fortran/ PR fortran/38507 * gfortran.h (gfc_st_label): Fix comment. (gfc_exec_op): Add statement code EXEC_END_BLOCK for end of block. * parse.c (accept_statement): Use EXEC_END_BLOCK for END IF and END SELECT with labels. (check_do_closure): Fix formatting. (parse_do_block): Fix typo in error message. * resolve.c (code_stack): Remove tail member. Update comment to new use of reachable_labels. (reachable_labels): Rename to ... (find_reachable_labels): ... this. Overhaul. Update preceding comment. (resolve_branch): Fix comment preceding function. Rewrite. (resolve_code): Update call to find_reachable_labels. Add code to deal with EXEC_END_BLOCK. * st.c (gfc_free_statement): Add code to deal with EXEC_END_BLOCK. * trans.c (gfc_trans_code): Likewise. testsuite/ * do_4.f: New. * goto_2.f90: Correct expected warnings. * goto_4.f90: Likewise. * goto_5.f90: New. From-SVN: r145245 --- gcc/fortran/ChangeLog | 21 +++++++++++ gcc/fortran/gfortran.h | 10 +++--- gcc/fortran/parse.c | 16 ++++++--- gcc/fortran/resolve.c | 70 ++++++++++++++---------------------- gcc/fortran/st.c | 3 +- gcc/fortran/trans.c | 5 +-- gcc/testsuite/ChangeLog | 8 +++++ gcc/testsuite/gfortran.dg/do_4.f | 9 +++++ gcc/testsuite/gfortran.dg/goto_2.f90 | 24 ++++++------- gcc/testsuite/gfortran.dg/goto_4.f90 | 5 +-- gcc/testsuite/gfortran.dg/goto_5.f90 | 44 +++++++++++++++++++++++ 11 files changed, 145 insertions(+), 70 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/do_4.f create mode 100644 gcc/testsuite/gfortran.dg/goto_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d063295..373ffb8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,24 @@ +2008-03-29 Tobias Schlüter + + PR fortran/38507 + * gfortran.h (gfc_st_label): Fix comment. + (gfc_exec_op): Add statement code EXEC_END_BLOCK for end of block. + * parse.c (accept_statement): Use EXEC_END_BLOCK for END IF and + END SELECT with labels. + (check_do_closure): Fix formatting. + (parse_do_block): Fix typo in error message. + * resolve.c (code_stack): Remove tail member. Update comment to + new use of reachable_labels. + (reachable_labels): Rename to ... + (find_reachable_labels): ... this. Overhaul. Update preceding + comment. + (resolve_branch): Fix comment preceding function. Rewrite. + (resolve_code): Update call to find_reachable_labels. Add code to + deal with EXEC_END_BLOCK. + * st.c (gfc_free_statement): Add code to deal with EXEC_END_BLOCK. + Add 2009 to copyright years. + * trans.c (gfc_trans_code): Likewise on both counts. + 2009-03-28 Tobias Burnus PR fortran/34656 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 25e8e06..22c5776 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -954,10 +954,9 @@ gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) -/* The gfc_st_label structure is a doubly linked list attached to a - namespace that records the usage of statement labels within that - space. */ -/* TODO: Make format/statement specifics a union. */ +/* The gfc_st_label structure is a BBT attached to a namespace that + records the usage of statement labels within that space. */ + typedef struct gfc_st_label { BBT_HEADER(gfc_st_label); @@ -1861,7 +1860,8 @@ gfc_forall_iterator; /* Executable statements that fill gfc_code structures. */ typedef enum { - EXEC_NOP = 1, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, EXEC_POINTER_ASSIGN, + EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN, + EXEC_POINTER_ASSIGN, 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, diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 1bf13e2..0800fc1 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1465,16 +1465,23 @@ accept_statement (gfc_statement st) /* If the statement is the end of a block, lay down a special code that allows a branch to the end of the block from within the - construct. */ + construct. IF and SELECT are treated differently from DO + (where EXEC_NOP is added inside the loop) for two + reasons: + 1. END DO has a meaning in the sense that after a GOTO to + it, the loop counter must be increased. + 2. IF blocks and SELECT blocks can consist of multiple + parallel blocks (IF ... ELSE IF ... ELSE ... END IF). + Putting the label before the END IF would make the jump + from, say, the ELSE IF block to the END IF illegal. */ case ST_ENDIF: case ST_END_SELECT: if (gfc_statement_label != NULL) { - new_st.op = EXEC_NOP; + new_st.op = EXEC_END_BLOCK; add_statement (); } - break; /* The end-of-program unit statements do not get the special @@ -2817,7 +2824,6 @@ check_do_closure (void) if (p->ext.end_do_label == gfc_statement_label) { - if (p == gfc_state_stack) return 1; @@ -2895,7 +2901,7 @@ loop: name, but in that case we must have seen ST_ENDDO first). We only complain about this in pedantic mode. */ if (gfc_current_block () != NULL) - gfc_error_now ("named block DO at %L requires matching ENDDO name", + gfc_error_now ("Named block DO at %L requires matching ENDDO name", &gfc_current_block()->declared_at); break; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 1d6ee85..7f7a806 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -43,11 +43,12 @@ seq_type; typedef struct code_stack { - struct gfc_code *head, *current, *tail; + struct gfc_code *head, *current; struct code_stack *prev; /* This bitmap keeps track of the targets valid for a branch from - inside this block. */ + inside this block except for END {IF|SELECT}s of enclosing + blocks. */ bitmap reachable_labels; } code_stack; @@ -5978,11 +5979,10 @@ resolve_transfer (gfc_code *code) /*********** Toplevel code resolution subroutines ***********/ /* Find the set of labels that are reachable from this block. We also - record the last statement in each block so that we don't have to do - a linear search to find the END DO statements of the blocks. */ + record the last statement in each block. */ static void -reachable_labels (gfc_code *block) +find_reachable_labels (gfc_code *block) { gfc_code *c; @@ -5991,14 +5991,13 @@ reachable_labels (gfc_code *block) cs_base->reachable_labels = bitmap_obstack_alloc (&labels_obstack); - /* Collect labels in this block. */ + /* Collect labels in this block. We don't keep those corresponding + to END {IF|SELECT}, these are checked in resolve_branch by going + up through the code_stack. */ for (c = block; c; c = c->next) { - if (c->here) + if (c->here && c->op != EXEC_END_BLOCK) bitmap_set_bit (cs_base->reachable_labels, c->here->value); - - if (!c->next && cs_base->prev) - cs_base->prev->tail = c; } /* Merge with labels from parent block. */ @@ -6010,7 +6009,7 @@ reachable_labels (gfc_code *block) } } -/* Given a branch to a label and a namespace, if the branch is conforming. +/* Given a branch to a label, see if the branch is conforming. The code node describes where the branch is located. */ static void @@ -6049,46 +6048,30 @@ resolve_branch (gfc_st_label *label, gfc_code *code) branching statement. The hard work has been done by setting up the bitmap reachable_labels. */ - if (!bitmap_bit_p (cs_base->reachable_labels, label->value)) - { - /* The label is not in an enclosing block, so illegal. This was - allowed in Fortran 66, so we allow it as extension. No - further checks are necessary in this case. */ - gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block " - "as the GOTO statement at %L", &label->where, - &code->loc); - return; - } + if (bitmap_bit_p (cs_base->reachable_labels, label->value)) + return; - /* Step four: Make sure that the branching target is legal if - the statement is an END {SELECT,IF}. */ + /* Step four: If we haven't found the label in the bitmap, it may + still be the label of the END of the enclosing block, in which + case we find it by going up the code_stack. */ for (stack = cs_base; stack; stack = stack->prev) if (stack->current->next && stack->current->next->here == label) break; - if (stack && stack->current->next->op == EXEC_NOP) + if (stack) { - gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps to " - "END of construct at %L", &code->loc, - &stack->current->next->loc); - return; /* We know this is not an END DO. */ + gcc_assert (stack->current->next->op == EXEC_END_BLOCK); + return; } - /* Step five: Make sure that we're not jumping to the end of a DO - loop from within the loop. */ - - for (stack = cs_base; stack; stack = stack->prev) - if ((stack->current->op == EXEC_DO - || stack->current->op == EXEC_DO_WHILE) - && stack->tail->here == label && stack->tail->op == EXEC_NOP) - { - gfc_notify_std (GFC_STD_F95_DEL, "Deleted feature: GOTO at %L jumps " - "to END of construct at %L", &code->loc, - &stack->tail->loc); - return; - - } + /* The label is not in an enclosing block, so illegal. This was + allowed in Fortran 66, so we allow it as extension. No + further checks are necessary in this case. */ + gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block " + "as the GOTO statement at %L", &label->where, + &code->loc); + return; } @@ -6669,7 +6652,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) frame.head = code; cs_base = &frame; - reachable_labels (code); + find_reachable_labels (code); for (; code; code = code->next) { @@ -6727,6 +6710,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns) switch (code->op) { case EXEC_NOP: + case EXEC_END_BLOCK: case EXEC_CYCLE: case EXEC_PAUSE: case EXEC_STOP: diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 18f1b6d..4f82050 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -1,5 +1,5 @@ /* Build executable statement trees. - Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008 + Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught @@ -88,6 +88,7 @@ gfc_free_statement (gfc_code *p) switch (p->op) { case EXEC_NOP: + case EXEC_END_BLOCK: case EXEC_ASSIGN: case EXEC_INIT_ASSIGN: case EXEC_GOTO: diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 3dc2d8f..827f54e 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1,6 +1,6 @@ /* Code translation -- generate GCC trees from gfc_code. - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software - Foundation, Inc. + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free + Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -1055,6 +1055,7 @@ gfc_trans_code (gfc_code * code) switch (code->op) { case EXEC_NOP: + case EXEC_END_BLOCK: res = NULL_TREE; break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7546a2d..d33a95e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2008-03-29 Tobias Schlüter + + PR fortran/38507 + * gfortran.dg/do_4.f: New. + * gfortran.dg/goto_2.f90: Correct expected warnings. + * gfortran.dg/goto_4.f90: Likewise. + * gfortran.dg/goto_5.f90: New. + 2009-03-29 H.J. Lu PR target/39545 diff --git a/gcc/testsuite/gfortran.dg/do_4.f b/gcc/testsuite/gfortran.dg/do_4.f new file mode 100644 index 0000000..6d688a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_4.f @@ -0,0 +1,9 @@ +! { dg-do compile } +! Verify that the loop not terminated on an action-stmt is correctly rejected + do10i=1,20 + if(i.eq.5)then + goto 10 + 10 endif ! { dg-error "is within another block" } + end +! { dg-excess-errors "" } + diff --git a/gcc/testsuite/gfortran.dg/goto_2.f90 b/gcc/testsuite/gfortran.dg/goto_2.f90 index acff590..fc5e8d8 100644 --- a/gcc/testsuite/gfortran.dg/goto_2.f90 +++ b/gcc/testsuite/gfortran.dg/goto_2.f90 @@ -2,51 +2,51 @@ ! Checks for corrects warnings if branching to then end of a ! construct at various nesting levels subroutine check_if(i) - goto 10 + goto 10 ! { dg-warning "Label at ... is not in the same block" } if (i > 0) goto 40 if (i < 0) then goto 40 -10 end if +10 end if ! { dg-warning "Label at ... is not in the same block" } if (i == 0) then i = i+1 - goto 20 ! { dg-warning "jumps to END of construct" } + goto 20 goto 40 -20 end if ! { dg-warning "jumps to END of construct" } +20 end if if (i == 1) then i = i+1 if (i == 2) then - goto 30 ! { dg-warning "jumps to END of construct" } + goto 30 end if goto 40 -30 end if ! { dg-warning "jumps to END of construct" } +30 end if return 40 i = -1 end subroutine check_if subroutine check_select(i) - goto 10 + goto 10 ! { dg-warning "Label at ... is not in the same block" } select case (i) case default goto 999 -10 end select +10 end select ! { dg-warning "Label at ... is not in the same block" } select case (i) case (2) i = 1 - goto 20 ! { dg-warning "jumps to END of construct" } + goto 20 goto 999 case default goto 999 -20 end select ! { dg-warning "jumps to END of construct" } +20 end select j = i select case (j) case default select case (i) case (1) i = 2 - goto 30 ! { dg-warning "jumps to END of construct" } + goto 30 end select goto 999 -30 end select ! { dg-warning "jumps to END of construct" } +30 end select return 999 i = -1 end subroutine check_select diff --git a/gcc/testsuite/gfortran.dg/goto_4.f90 b/gcc/testsuite/gfortran.dg/goto_4.f90 index d48af72..7340814 100644 --- a/gcc/testsuite/gfortran.dg/goto_4.f90 +++ b/gcc/testsuite/gfortran.dg/goto_4.f90 @@ -1,10 +1,11 @@ ! { dg-do run } ! PR 17708: Jumping to END DO statements didn't do the right thing +! PR 38507: The warning we used to give was wrong program test j = 0 do 10 i=1,3 - if(i == 2) goto 10 ! { dg-warning "jumps to END" } + if(i == 2) goto 10 j = j+1 -10 enddo ! { dg-warning "jumps to END" } +10 enddo if (j/=2) call abort end diff --git a/gcc/testsuite/gfortran.dg/goto_5.f90 b/gcc/testsuite/gfortran.dg/goto_5.f90 new file mode 100644 index 0000000..44ba697 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goto_5.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! PR 38507 +! Verify that we correctly flag invalid gotos, while not flagging valid gotos. +integer i,j + +do i=1,10 + goto 20 +20 end do ! { dg-warning "is not in the same block" } + +goto 20 ! { dg-warning "is not in the same block" } +goto 25 ! { dg-warning "is not in the same block" } +goto 40 ! { dg-warning "is not in the same block" } +goto 50 ! { dg-warning "is not in the same block" } + +goto 222 +goto 333 +goto 444 + +222 if (i < 0) then +25 end if ! { dg-warning "is not in the same block" } + +333 if (i > 0) then + do j = 1,20 + goto 30 + end do +else if (i == 0) then + goto 30 +else + goto 30 +30 end if + +444 select case(i) +case(0) + goto 50 + goto 60 ! { dg-warning "is not in the same block" } +case(1) + goto 40 + goto 50 + 40 continue ! { dg-warning "is not in the same block" } + 60 continue ! { dg-warning "is not in the same block" } +50 end select ! { dg-warning "is not in the same block" } +continue + +end -- 2.7.4