OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gfc_match_end): Also check for construct name in END FORALL and END WERE statements. 

fortran/31471
fortran/
* 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.
testsuite/
* gfortran.dg/block_name_1.f90: New.
* gfortran.dg/block_name_2.f90: New.

From-SVN: r123758
This commit is contained in:
Tobias Schlüter 2007-04-12 20:07:09 +02:00
parent 8cb6400cda
commit 690af37922
6 changed files with 163 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -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.

3
gcc/fortran/decl.c
View File

@ -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)

11
gcc/fortran/match.c
View File

@ -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;

6
gcc/testsuite/ChangeLog
View File

@ -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

78
gcc/testsuite/gfortran.dg/block_name_1.f90 Normal file
View File

@ -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

60
gcc/testsuite/gfortran.dg/block_name_2.f90 Normal file
View File

@ -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