Patchwork [Fortran] PR40881 - Add two F95 obsolescence warnings

login
register
mail settings
Submitter Tobias Burnus
Date Aug. 14, 2012, 9:33 a.m.
Message ID <502A1B66.80302@net-b.de>
Download mbox | patch
Permalink /patch/177196/
State New
Headers show

Comments

Tobias Burnus - Aug. 14, 2012, 9:33 a.m.
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
Mikael Morin - Aug. 14, 2012, 9:57 a.m.
On 14/08/2012 11:33, Tobias Burnus wrote:
> 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?
> 
OK, apart for:

	* gfortran.dg/data_constraints_1.f90: Update dg-warning.

I don't see the need for the change, the ChangeLog doesn't match the
patch, and it is different from the initial version. A forgotten local edit?

Thanks,

Mikael
Tobias Burnus - Aug. 14, 2012, 10:17 a.m.
On 08/14/2012 11:57 AM, Mikael Morin wrote:
> On 14/08/2012 11:33, Tobias Burnus wrote:
>> 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?
>>
> OK, apart for:
> 	* gfortran.dg/data_constraints_1.f90: Update dg-warning.
> I don't see the need for the change, the ChangeLog doesn't match the
> patch, and it is different from the initial version. A forgotten local edit?

No, just the wrong (?) solution to a real issue. The -pedantic flag 
causes the obsolescent warning. To avoid it, one can either remove the 
"allocate" or one uses
   ! { dg-options "" }
I think the latter is cleaner.

I will commit the patch with the latter and a fixed ChangeLog.

Tobias

Patch

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