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
This commit is contained in:
Tobias Schlüter
parent
eeae74a1a9
commit
d80c695ff0
|
|
@ -1,3 +1,24 @@
|
|||
2008-03-29 Tobias Schlüter <tobi@gcc.gnu.org>
|
||||
|
||||
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 <burnus@net-b.de>
|
||||
|
||||
PR fortran/34656
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2008-03-29 Tobias Schlüter <tobi@gcc.gnu.org>
|
||||
|
||||
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 <hongjiu.lu@intel.com>
|
||||
|
||||
PR target/39545
|
||||
|
|
|
|||
|
|
@ -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 "" }
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue