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

re PR fortran/40881 ([F03] warn for obsolescent features) 

2012-08-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40881
        * error.c (gfc_notify_std): Reset cur_error_buffer->flag flag
        when the error/warning has been printed.
        * gfortran.h (gfc_sl_type): Add ST_LABEL_DO_TARGET.
        * match.c (gfc_match_do): Use ST_LABEL_DO_TARGET.
        * parse.c (check_statement_label): Use ST_LABEL_DO_TARGET.
        (parse_executable): Add obsolescence check for DATA.
        * resolve.c (resolve_branch): Handle ST_LABEL_DO_TARGET.
        * symbol.c (gfc_define_st_label, gfc_reference_st_label):
        Add obsolescence diagnostics.
        * trans-stmt.c (gfc_trans_label_assign): Handle
        * ST_LABEL_DO_TARGET.

2012-08-14  Tobias Burnus  <burnus@net-b.de>

        PR fortran/40881
        * gfortran.dg/data_constraints_3.f90: New.
        * gfortran.dg/data_constraints_1.f90: Add dg-options ""
        to disable -pedantic compilation.
        * gfortran.dg/pr37243.f: Ditto.
        * gfortran.dg/g77/19990826-3.f: Ditto.
        * gfortran.dg/g77/20020307-1.f : Ditto.
        * gfortran.dg/g77/980310-3.f: Ditto.

From-SVN: r190379
This commit is contained in:
Tobias Burnus 2012-08-14 12:26:11 +02:00 committed by Tobias Burnus
parent 2e60cfaa2b
commit f3e7b9d618
15 changed files with 82 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2012-08-14 Tobias Burnus <burnus@net-b.de>
PR fortran/40881
* error.c (gfc_notify_std): Reset cur_error_buffer->flag flag
when the error/warning has been printed.
* gfortran.h (gfc_sl_type): Add ST_LABEL_DO_TARGET.
* match.c (gfc_match_do): Use ST_LABEL_DO_TARGET.
* parse.c (check_statement_label): Use ST_LABEL_DO_TARGET.
(parse_executable): Add obsolescence check for DATA.
* resolve.c (resolve_branch): Handle ST_LABEL_DO_TARGET.
* symbol.c (gfc_define_st_label, gfc_reference_st_label):
Add obsolescence diagnostics.
* trans-stmt.c (gfc_trans_label_assign): Handle ST_LABEL_DO_TARGET.
2012-08-14 Tobias Burnus <burnus@net-b.de>
PR fortran/54234

1
gcc/fortran/error.c
View File

@ -875,6 +875,7 @@ gfc_notify_std (int std, const char *gmsgid, ...)
warnings++;
else
gfc_increment_error_count();
cur_error_buffer->flag = 0;
}
return (warning && !warnings_are_errors) ? SUCCESS : FAILURE;

6
gcc/fortran/gfortran.h
View File

@ -144,9 +144,11 @@ typedef enum
{ AR_FULL = 1, AR_ELEMENT, AR_SECTION, AR_UNKNOWN }
ar_type;
/* Statement label types. */
/* Statement label types. ST_LABEL_DO_TARGET is used for obsolescent warnings
related to shared DO terminations and DO targets which are neither END DO
nor CONTINUE; otherwise it is identical to ST_LABEL_TARGET. */
typedef enum
{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET,
ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
}
gfc_sl_type;

4
gcc/fortran/match.c
View File

@ -2400,7 +2400,7 @@ gfc_match_do (void)
goto concurr_cleanup;
if (label != NULL
&& gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
&& gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE)
goto concurr_cleanup;
new_st.label1 = label;
@ -2454,7 +2454,7 @@ concurr_cleanup:
done:
if (label != NULL
&& gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
&& gfc_reference_st_label (label, ST_LABEL_DO_TARGET) == FAILURE)
goto cleanup;
new_st.label1 = label;

11
gcc/fortran/parse.c
View File

@ -1168,7 +1168,10 @@ check_statement_label (gfc_statement st)
case ST_END_ASSOCIATE:
case_executable:
case_exec_markers:
type = ST_LABEL_TARGET;
if (st == ST_ENDDO || st == ST_CONTINUE)
type = ST_LABEL_DO_TARGET;
else
type = ST_LABEL_TARGET;
break;
case ST_FORMAT:
@ -3825,8 +3828,12 @@ parse_executable (gfc_statement st)
case ST_NONE:
unexpected_eof ();
case ST_FORMAT:
case ST_DATA:
gfc_notify_std (GFC_STD_F95_OBS, "DATA statement at %C after the "
"first executable statement");
/* Fall through. */
case ST_FORMAT:
case ST_ENTRY:
case_executable:
accept_statement (st);

2
gcc/fortran/resolve.c
View File

@ -8767,7 +8767,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
return;
}
if (label->defined != ST_LABEL_TARGET)
if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET)
{
gfc_error ("Statement at %L is not a valid branch target statement "
"for the branch statement at %L", &label->where, &code->loc);

25
gcc/fortran/symbol.c
View File

@ -2204,7 +2204,8 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
switch (type)
{
case ST_LABEL_FORMAT:
if (lp->referenced == ST_LABEL_TARGET)
if (lp->referenced == ST_LABEL_TARGET
|| lp->referenced == ST_LABEL_DO_TARGET)
gfc_error ("Label %d at %C already referenced as branch target",
labelno);
else
@ -2213,12 +2214,18 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
break;
case ST_LABEL_TARGET:
case ST_LABEL_DO_TARGET:
if (lp->referenced == ST_LABEL_FORMAT)
gfc_error ("Label %d at %C already referenced as a format label",
labelno);
else
lp->defined = ST_LABEL_TARGET;
lp->defined = type;
if (lp->referenced == ST_LABEL_DO_TARGET && type != ST_LABEL_DO_TARGET
&& gfc_notify_std (GFC_STD_F95_OBS, "DO termination statement "
"which is not END DO or CONTINUE with label "
"%d at %C", labelno) == FAILURE)
return;
break;
default:
@ -2254,14 +2261,16 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type)
lp->where = gfc_current_locus;
}
if (label_type == ST_LABEL_FORMAT && type == ST_LABEL_TARGET)
if (label_type == ST_LABEL_FORMAT
&& (type == ST_LABEL_TARGET || type == ST_LABEL_DO_TARGET))
{
gfc_error ("Label %d at %C previously used as a FORMAT label", labelno);
rc = FAILURE;
goto done;
}
if ((label_type == ST_LABEL_TARGET || label_type == ST_LABEL_BAD_TARGET)
if ((label_type == ST_LABEL_TARGET || label_type == ST_LABEL_DO_TARGET
|| label_type == ST_LABEL_BAD_TARGET)
&& type == ST_LABEL_FORMAT)
{
gfc_error ("Label %d at %C previously used as branch target", labelno);
@ -2269,7 +2278,13 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type)
goto done;
}
lp->referenced = type;
if (lp->referenced == ST_LABEL_DO_TARGET && type == ST_LABEL_DO_TARGET
&& gfc_notify_std (GFC_STD_F95_OBS, "Shared DO termination label %d "
"at %C", labelno) == FAILURE)
return FAILURE;
if (lp->referenced != ST_LABEL_DO_TARGET)
lp->referenced = type;
rc = SUCCESS;
done:

3
gcc/fortran/trans-stmt.c
View File

@ -109,7 +109,8 @@ gfc_trans_label_assign (gfc_code * code)
label_tree = gfc_get_label_decl (code->label1);
if (code->label1->defined == ST_LABEL_TARGET)
if (code->label1->defined == ST_LABEL_TARGET
|| code->label1->defined == ST_LABEL_DO_TARGET)
{
label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
len_tree = integer_minus_one_node;

11
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,14 @@
2012-08-14 Tobias Burnus <burnus@net-b.de>
PR fortran/40881
* gfortran.dg/data_constraints_3.f90: New.
* gfortran.dg/data_constraints_1.f90: Add dg-options ""
to disable -pedantic compilation.
* gfortran.dg/pr37243.f: Ditto.
* gfortran.dg/g77/19990826-3.f: Ditto.
* gfortran.dg/g77/20020307-1.f : Ditto.
* gfortran.dg/g77/980310-3.f: Ditto.
2012-08-14 Tobias Burnus <burnus@net-b.de>
PR fortran/54234

1
gcc/testsuite/gfortran.dg/data_constraints_1.f90
View File

@ -1,4 +1,5 @@
! { dg-do compile }
! { dg-options "" }
! Tests standard indepedendent constraints for variables in a data statement
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>

8
gcc/testsuite/gfortran.dg/data_constraints_3.f90 Normal file
View File

@ -0,0 +1,8 @@
! { dg-do compile }
!
! PR fortran/40881
!
integer :: a(3)
print *, 'Hello'
data a/3*5/ ! { dg-warning "Obsolescent feature: DATA statement at .1. after the first executable statement" }
end

2
gcc/testsuite/gfortran.dg/g77/19990826-3.f
View File

@ -64,7 +64,7 @@ C
IF(M2.LT.64)INDE=5
IF(M2.LT.32)INDE=4
DO 3 NUN =3,INUN
DO 3 NDE=3,INDE
DO 3 NDE=3,INDE ! { dg-warning "Obsolescent feature: Shared DO termination" }
N10=2**NUN
N20=2**NDE
NDIF=(N10-N20)

2
gcc/testsuite/gfortran.dg/g77/20020307-1.f
View File

@ -6,7 +6,7 @@ c { dg-do compile }
DIMENSION BNORM(MAXVEC),BINV(MAXVEC),WT(MAXVEC),W0(MAXVEC)
DIMENSION C1(MAXVEC),C2(MAXVEC),R1(MAXVEC),R2(MAXVEC)
DO 200 ILAT=1,2**IDIM
DO 200 I1=1,IDIM
DO 200 I1=1,IDIM ! { dg-warning "Obsolescent feature: Shared DO termination" }
DO 220 I2=1,IDIM
CALL INTACT(ILAT,I1,I1,W1)
220 CONTINUE

4
gcc/testsuite/gfortran.dg/g77/980310-3.f
View File

@ -128,7 +128,7 @@ c compute right side vector in resulting linear equations
c
basl = dlog10(2.0d0)
do 240 i = low,igh
do 240 j = low,igh
do 240 j = low,igh ! { dg-warning "Obsolescent feature: Shared DO termination" }
tb = b(i,j)
ta = a(i,j)
if (ta .eq. 0.0d0) go to 220
@ -242,7 +242,7 @@ c
ir = wk(i,1)
fi = 2.0d0**ir
if (i .lt. low) fi = 1.0d0
do 400 j =low,n
do 400 j =low,n ! { dg-warning "Obsolescent feature: Shared DO termination" }
jc = cscale(j)
fj = 2.0d0**jc
if (j .le. igh) go to 390

10
gcc/testsuite/gfortran.dg/pr37243.f
View File

@ -13,10 +13,10 @@
DO 160 I = 1,M
DUMI = ZERO
DO 100 K = 1,N
100 DUMI = DUMI+V(K,I)*V(K,I)
100 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
DUMI = ONE/ SQRT(DUMI)
DO 120 K = 1,N
120 V(K,I) = V(K,I)*DUMI
120 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
IF (I .EQ. M) GO TO 160
I1 = I+1
DO 140 J = I1,M
@ -34,15 +34,15 @@
220 J = J+1
IF (J .GT. N) GO TO 320
DO 240 K = 1,N
240 V(K,I) = ZERO
240 V(K,I) = ZERO ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
CALL DAXPY(N,DUM,V(1,I),1,V(1,I),1)
260 CONTINUE
DUMI = ZERO
DO 280 K = 1,N
280 DUMI = DUMI+V(K,I)*V(K,I)
280 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
IF ( ABS(DUMI) .LT. TOL) GO TO 220
DO 300 K = 1,N
300 V(K,I) = V(K,I)*DUMI
300 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
GO TO 200
320 END
program main