diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 3 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 11 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/block_name_1.f90 | 78 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/block_name_2.f90 | 60 |
6 files changed, 163 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 58b790b..e99ccd1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2007-04-12 Tobias Schlüter <tobi@gcc.gnu.org> + PR fortran/31471 + * decl.c (gfc_match_end): Also check for construct name in END + FORALL and END WERE statements. + * match.c (match_case_eos): Use uppercase for statement name in + error message. + (match_elsewhere): Construct name may appear iff construct has a + name. + * trans-types.c: Update copyright years. Reformat long comment explaining array descriptor format. Remove obsolete mention of TYPE_SET. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 67d05b8..43e0235 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -3340,7 +3340,8 @@ gfc_match_end (gfc_statement *st) if (gfc_match_eos () == MATCH_YES) { - if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT) + if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT + && *st != ST_END_FORALL && *st != ST_END_WHERE) return MATCH_YES; if (gfc_current_block () == NULL) diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index dc76911..2483ea3 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -3053,7 +3053,7 @@ match_case_eos (void) should have matched the EOS. */ if (!gfc_current_block ()) { - gfc_error ("Expected the name of the select case construct at %C"); + gfc_error ("Expected the name of the SELECT CASE construct at %C"); return MATCH_ERROR; } @@ -3299,7 +3299,14 @@ gfc_match_elsewhere (void) } if (gfc_match_eos () != MATCH_YES) - { /* Better be a name at this point */ + { + /* Only makes sense if we have a where-construct-name. */ + if (!gfc_current_block ()) + { + m = MATCH_ERROR; + goto cleanup; + } + /* Better be a name at this point */ m = gfc_match_name (name); if (m == MATCH_NO) goto syntax; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index aa7e3e2..8a40938 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-04-12 Tobias Schlüter <tobi@gcc.gnu.org> + + PR fortran/31471 + * gfortran.dg/block_name_1.f90: New. + * gfortran.dg/block_name_2.f90: New. + 2007-04-12 Douglas Gregor <doug.gregor@gmail.com> PR c++/31078 diff --git a/gcc/testsuite/gfortran.dg/block_name_1.f90 b/gcc/testsuite/gfortran.dg/block_name_1.f90 new file mode 100644 index 0000000..600885c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_name_1.f90 @@ -0,0 +1,78 @@ +! { dg-do compile } +! Verify that the compiler accepts the various legal combinations of +! using construct names. +! +! The correct behavior of EXIT and CYCLE is already established in +! the various DO related testcases, they're included here for +! completeness. + dimension a(5) + i = 0 + ! construct name is optional on else clauses + ia: if (i > 0) then + i = 1 + else + i = 2 + end if ia + ib: if (i < 0) then + i = 3 + else ib + i = 4 + end if ib + ic: if (i < 0) then + i = 5 + else if (i == 0) then ic + i = 6 + else if (i == 1) then + i =7 + else if (i == 2) then ic + i = 8 + end if ic + + fa: forall (i=1:5, a(i) > 0) + a(i) = 9 + end forall fa + + wa: where (a > 0) + a = -a + elsewhere + wb: where (a == 0) + a = a + 1. + elsewhere wb + a = 2*a + end where wb + end where wa + + j = 1 + sa: select case (i) + case (1) + i = 2 + case (2) sa + i = 3 + case default sa + sb: select case (j) + case (1) sb + i = j + case default + j = i + end select sb + end select sa + + da: do i=1,10 + cycle da + cycle + exit da + exit + db: do + cycle da + cycle db + cycle + exit da + exit db + exit + j = i+1 + end do db + dc: do while (j>0) + j = j-1 + end do dc + end do da +end diff --git a/gcc/testsuite/gfortran.dg/block_name_2.f90 b/gcc/testsuite/gfortran.dg/block_name_2.f90 new file mode 100644 index 0000000..590a015 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_name_2.f90 @@ -0,0 +1,60 @@ +! { dg-do compile } +! Test that various illegal combinations of block statements with +! block names yield the correct error messages. Motivated by PR31471. +program blocks + dimension a(5,2) + + a = 0 + + ! The END statement of a labelled block needs to carry the construct + ! name. + d1: do i=1,10 + end do ! { dg-error "Expected block name of .... in END DO statement" } + end do d1 + + i1: if (i > 0) then + end if ! { dg-error "Expected block name of .... in END IF statement" } + end if i1 + + s1: select case (i) + end select ! { dg-error "Expected block name of .... in END SELECT statement" } + end select s1 + + w1: where (a > 0) + end where ! { dg-error "Expected block name of .... in END WHERE statement" } + end where w1 + + f1: forall (i = 1:10) + end forall ! { dg-error "Expected block name of .... in END FORALL statement" } + end forall f1 + + ! A construct name may not appear in the END statement, if it + ! doesn't appear in the statement beginning the block. + ! Likewise it may not appear in ELSE IF, ELSE, ELSEWHERE or CASE + ! statements. + do i=1,10 + end do d2 ! { dg-error "Syntax error in END DO statement" } + end do + + if (i > 0) then + else if (i ==0) then i2 ! { dg-error "Unexpected junk after ELSE IF statement" } + else i2 ! { dg-error "Unexpected junk after ELSE statement" } + end if i2 ! { dg-error "Syntax error in END IF statement" } + end if + + select case (i) + case (1) s2 ! { dg-error "Expected the name of the SELECT CASE construct" } + case default s2 ! { dg-error "Expected the name of the SELECT CASE construct" } + end select s2 ! { dg-error "Syntax error in END SELECT statement" } + end select + + where (a > 0) + elsewhere w2 ! { dg-error "Unexpected junk after ELSE statement" } + end where w2 ! { dg-error "Syntax error in END WHERE statement" } + end where + + forall (i=1:10) + end forall f2 ! { dg-error "Syntax error in END FORALL statement" } + end forall + +end program blocks |