Patchwork [Fortran] PR40881 - Add two F95 obsolescence warnings

login
register
mail settings
Submitter Tobias Burnus
Date Aug. 8, 2012, 5:12 p.m.
Message ID <50229E06.6050705@net-b.de>
Download mbox | patch
Permalink /patch/175945/
State New
Headers show

Comments

Tobias Burnus - Aug. 8, 2012, 5:12 p.m.
This patch implements a warning for the following Fortran 95 (and later) 
obsolescent features (cf. F2008, "B.2 Obsolescent features"):

"(2) Shared DO termination and termination on a statement other than END 
DO or CONTINUE -- use
an END DO or a CONTINUE statement for each DO statement."
"(6) DATA statements amongst executable statements -- see B.2.5."

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.

The motivation for implementing this patch was that I did a small 
obsolescent cleanup of our fixed-form code (which uses some Fortran 2003 
features) and I realized that ifort had the "shared DO termination" 
warning and gfortran didn't.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Mikael Morin - Aug. 9, 2012, 12:13 p.m.
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.

> 
> The motivation for implementing this patch was that I did a small
> obsolescent cleanup of our fixed-form code (which uses some Fortran 2003
> features) and I realized that ifort had the "shared DO termination"
> warning and gfortran didn't.
> 
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?

More comments below. Regarding the general design, I'm not sure it makes
sense to distinguish between ST_LABEL_DO_TARGET and
ST_LABEL_ENDDO_TARGET. There are no ST_LABEL_GOTO_TARGET or
ST_LABEL_WRITE_TARGET after all.



> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index b6e2975..9670022 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -146,8 +146,8 @@ ar_type;
>  
>  /* Statement label types.  */
>  typedef enum
> -{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
> -  ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
> +{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET,
> +  ST_LABEL_ENDDO_TARGET, ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
>  }
>  gfc_sl_type;

Please add a comment explaining the different types; something like:
The labels referenced in DO statements and defined in END DO statements
 get types respectively ST_LABEL_DO_TARGET and ST_LABEL_ENDDO_TARGET
instead of the generic ST_LABEL_TARGET so that they can be distinguished
to issue DO-specific diagnostics.
The DO label is a label reference, so ST_LABEL_DO_TARGET is to be used
in gfc_st_label::referenced only.  The ST_LABEL_ENDDO_TARGET is the
corresponding label definition, and is to be used in
gfc_st_label::defined only.



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


> diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
> index 455e6c9..135c1e5 100644
> --- a/gcc/fortran/symbol.c
> +++ b/gcc/fortran/symbol.c
> @@ -2213,12 +2214,19 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
>  	  break;
>  
>  	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.


> @@ -2254,14 +2262,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);

label_type is initialized using either lp->referenced or lp->defined.
Thus both ST_LABEL_DO_TARGET and ST_LABEL_ENDDO_TARGET should be checked
here. Unless they are merged as suggested above.


Mikael

Patch

2012-08-08  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 and
	ST_LABEL_ENDDO_TARGET.
	* match.c (gfc_match_do): Use ST_LABEL_DO_TARGET.
	* parse.c (check_statement_label): Use ST_LABEL_ENDDO_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-08  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..9670022 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -146,8 +146,8 @@  ar_type;
 
 /* Statement label types.  */
 typedef enum
-{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET,
-  ST_LABEL_BAD_TARGET, ST_LABEL_FORMAT
+{ ST_LABEL_UNKNOWN = 1, ST_LABEL_TARGET, ST_LABEL_DO_TARGET,
+  ST_LABEL_ENDDO_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..d7e4b78 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_ENDDO_TARGET;
+      else
+	type = ST_LABEL_TARGET;
       break;
 
     case ST_FORMAT:
@@ -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);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c5810b2..3db34c5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8767,7 +8767,8 @@  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_ENDDO_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..135c1e5 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,19 @@  gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
 	  break;
 
 	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;
 
+	  if (lp->referenced == ST_LABEL_DO_TARGET
+	      && type != ST_LABEL_ENDDO_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 +2262,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 +2279,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..150f307 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_ENDDO_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..5a2432e 100644
--- a/gcc/testsuite/gfortran.dg/data_constraints_1.f90
+++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
@@ -14,9 +14,10 @@ 
   n = foo (n)
 contains
   function foo (m) result (bar)
-  integer p (m), bar
+  integer p (m), bar, i
   integer, allocatable :: l(:)
   allocate (l(1))
+  data i /55/           ! { dg-warning "Obsolescent feature: DATA statement at .1. after the first executable statement" }
   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/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
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
--- /dev/null	2012-08-08 07:41:43.631684108 +0200
+++ gcc/gcc/testsuite/gfortran.dg/data_constraints_3.f90	2012-08-08 18:59:24.000000000 +0200
@@ -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