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

gcc/fortran/ChangeLog

 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
 	* check.c (gfc_check_cmplx): Add -Wconversion warning
 	when converting higher-precision REAL to default-precision

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;

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;

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;

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

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

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:

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;

gcc/testsuite/ChangeLog

 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
 	* gfortran.dg/warn_conversion_4.f90: New.
 

gcc/testsuite/gfortran.dg/data_constraints_1.f90

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

gcc/testsuite/gfortran.dg/data_constraints_3.f90

+! { 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

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)

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

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

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