This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [Patch, Fortran] PR40881 - Add two F95 obsolescence warnings
- From: Tobias Burnus <burnus at net-b dot de>
- To: Mikael Morin <mikael dot morin at sfr dot fr>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Tue, 14 Aug 2012 11:33:26 +0200
- Subject: Re: [Patch, Fortran] PR40881 - Add two F95 obsolescence warnings
- References: <50229E06.6050705@net-b.de> <5023A976.8060003@sfr.fr>
On 08/09/2012 02:13 PM, Mikael Morin wrote:
On 08/08/2012 19:12, Tobias Burnus wrote:
With this patch, I think the only unimplemented obsolescence warning is for
"(8) Fixed form source -- see B.2.7."
For the latter, I would like to see a possibility to silence that
warning, given that there is substantial code around, which is in fixed
form but otherwise a completely valid and obsolescent-free code.
We could silence it with explicit -ffixed-form.
That won't work. The driver ("gfortran") automatically adds the flag
when compiling ".f" files. Thus, from within the compile ("f951") those
are indistinguishable. Besides, many Makefiles have the same compiler
flags for fixed and free form as (most) compilers automatically choose
the right source form based on the file extension.
Regarding the general design, I'm not sure it makes sense to distinguish between ST_LABEL_DO_TARGET and ST_LABEL_ENDDO_TARGET.
I concur. I changed it and also added a comment to gfortran.h.
@@ -3825,8 +3828,11 @@ 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);
This diagnostic is more appropriate in verify_st_order (which needs to
be called then).
I disagree. Initially, I thought that verify_st_order is the right place
- and discovered then that it doesn't get called after the first
executable statement. Thus, I added it to parse_executable.
Given that DATA is the only statement, which can also occur in the
execution section and that its validity depends on the compile flags, it
also would need a special handling in verify_st_order.
Calling verify_st_order from parse_executable only for ST_DATA is kind
of pointless while calling it always, leads to quite some overhead,
requires that one keeps track of the previous state (which is required
by verify_st_order but otherwise not needed in the execution section).
Thus, I really prefer the current solution.
case ST_LABEL_TARGET:
+ case ST_LABEL_ENDDO_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;
I think it should be `lp->defined = type;' here.
I think the current code is okay due to the required ordering, e.g. the
termination label for a DO block has to come after the DO block. But I
concur that using "= type" is cleaner.
Thus, I removed ST_LABEL_ENDDO_TARGET, use "=type" and added a comment,
but I didn't do the verify_st_order change.
Build and regested on x86-64-linux.
OK for the trunk?
Tobias
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: Update dg-warning.
* 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.
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 7e968db..dde6a0f 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b6e2975..0e2130f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 737d6a3..5ab07e5 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -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;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ecda163..44b1900 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c5810b2..9b8033d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 455e6c9..5a1e5ad 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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:
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 323fca3..7ece492 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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;
diff --git a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
index 5f11ffd..bfedcd4 100644
--- a/gcc/testsuite/gfortran.dg/data_constraints_1.f90
+++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
@@ -16,7 +16,7 @@ contains
function foo (m) result (bar)
integer p (m), bar
integer, allocatable :: l(:)
- allocate (l(1))
+! allocate (l(1))
data l /42/ ! { dg-error "conflicts with ALLOCATABLE" }
data p(1) /1/ ! { dg-error "non-constant array in DATA" }
data q /1/ ! { dg-error "Host associated variable" }
diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-3.f b/gcc/testsuite/gfortran.dg/g77/19990826-3.f
index dba24be..374c553 100644
--- a/gcc/testsuite/gfortran.dg/g77/19990826-3.f
+++ b/gcc/testsuite/gfortran.dg/g77/19990826-3.f
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/g77/20020307-1.f b/gcc/testsuite/gfortran.dg/g77/20020307-1.f
index 730c14d..7358543 100644
--- a/gcc/testsuite/gfortran.dg/g77/20020307-1.f
+++ b/gcc/testsuite/gfortran.dg/g77/20020307-1.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/g77/980310-3.f b/gcc/testsuite/gfortran.dg/g77/980310-3.f
index 5656023..098e22c 100644
--- a/gcc/testsuite/gfortran.dg/g77/980310-3.f
+++ b/gcc/testsuite/gfortran.dg/g77/980310-3.f
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/pr37243.f b/gcc/testsuite/gfortran.dg/pr37243.f
index 0a606ad..f5dda43 100644
--- a/gcc/testsuite/gfortran.dg/pr37243.f
+++ b/gcc/testsuite/gfortran.dg/pr37243.f
@@ -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