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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3a62890fde501446f8a2ef6c55e8f6c2585cccc9..039c1c3f3b6b5f2c9aea39741d1ae2bac9aa8caa 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 7e968dbb9963e82415e1cb074f2cb3b7fe589143..dde6a0fb52743202bd573ed6e9f04392b0d0396c 100644 (file)
--- 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 b6e29758cf1dcddf76d226efad545b2ab171ff2b..0e2130fc1943ad67c5c1ff7315a939a0d50c72aa 100644 (file)
--- 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 737d6a31676c026e10a3d2b93c096a2648a9f902..5ab07e5fcb87a3937d29bf5606a3c9b4f2dd4031 100644 (file)
--- 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 ecda163e6576aea7c6ec30e85cf7074e38c5249c..44b190092e1c83f8cf526b6de00020dbe70d5e17 100644 (file)
--- 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 c5810b27172d833d01c58242c9d7163b52bd41ca..9b8033d1ff2b26cf5c503c7ad55be49ad18a56fb 100644 (file)
--- 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 455e6c98951164b938f592cbb649b8968fbffec8..5a1e5adb85c7cd1c66ac0ad71f8d84fa75edcdf8 100644 (file)
--- 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 323fca382c3fe0950aff8fddba73878c23c4347d..7ece49246ba384a50946dfb8c7de3b0b0789902c 100644 (file)
--- 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/ChangeLog b/gcc/testsuite/ChangeLog
index 1ec4e0de34ca500a917da5976c170117456be2a5..55fa36a8ad547ca7027197ae1307b7b0abd8f058 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/data_constraints_1.f90 b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
index 5f11ffdbaea5b762cd536607b7e3d89e5c07f337..188eb7c6b8fbe778b0c0679715352dff6d7deeb3 100644 (file)
--- a/gcc/testsuite/gfortran.dg/data_constraints_1.f90
+++ b/gcc/testsuite/gfortran.dg/data_constraints_1.f90
@@ -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>

diff --git a/gcc/testsuite/gfortran.dg/data_constraints_3.f90 b/gcc/testsuite/gfortran.dg/data_constraints_3.f90
new file mode 100644 (file)
index 0000000..44aadb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/data_constraints_3.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/g77/19990826-3.f b/gcc/testsuite/gfortran.dg/g77/19990826-3.f
index dba24becb4cb32a8ce9ae360372418f5bbc344e9..374c5538e105fa96449b112a8fb7a851f02da2a5 100644 (file)
--- 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 730c14d32865a99d37d6a537646de7780a669c2d..73585434cf7730bf18c97f683739d0038008494e 100644 (file)
--- 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 565602378593e13b1e43068b8675576ff30e913c..098e22c680a4409d0116472165b06b48754f7593 100644 (file)
--- 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 0a606ad77071727a37de254ea5eb2757624ef7ff..f5dda43e71fcec6e434cfe328b66818ecc8581b9 100644 (file)
--- 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