aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog21
-rw-r--r--gcc/fortran/gfortran.h10
-rw-r--r--gcc/fortran/parse.c16
-rw-r--r--gcc/fortran/resolve.c70
-rw-r--r--gcc/fortran/st.c3
-rw-r--r--gcc/fortran/trans.c5
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/do_4.f9
-rw-r--r--gcc/testsuite/gfortran.dg/goto_2.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/goto_4.f905
-rw-r--r--gcc/testsuite/gfortran.dg/goto_5.f9044
11 files changed, 145 insertions, 70 deletions
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 <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
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 <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
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
generated by cgit v1.1 at 2024-10-20 01:59:10 +0000