re PR fortran/85841 ([F2018] reject deleted features)
authorJanus Weil <janus@gcc.gnu.org>
Mon, 21 May 2018 06:45:55 +0000 (08:45 +0200)
committerJanus Weil <janus@gcc.gnu.org>
Mon, 21 May 2018 06:45:55 +0000 (08:45 +0200)
2018-05-21  Janus Weil  <janus@gcc.gnu.org>

PR fortran/85841
* libgfortran.h: New macros GFC_STD_OPT_*.
* error.c (notify_std_msg): New function.
(gfc_notify_std): Adjust such that it can handle combinations of
GFC_STD_* flags in the 'std' argument, not just a single one.
* match.c (match_arithmetic_if, gfc_match_if): Reject arithmetic if
in Fortran 2018.
(gfc_match_stopcode): Use GFC_STD_OPT_* macros.
* options.c (set_default_std_flags): Warn for F2018 deleted features
by default.
(gfc_handle_option): F2018 deleted features are allowed in earlier
standards.
* symbol.c (gfc_define_st_label, gfc_reference_st_label): Reject
nonblock do constructs in Fortran 2018.

2018-05-21  Janus Weil  <janus@gcc.gnu.org>

PR fortran/85841
* gfortran.dg/g77/19990826-3.f: Add option "-std=legacy".
* gfortran.dg/g77/20020307-1.f: Ditto.
* gfortran.dg/g77/980310-3.f: Ditto.
* gfortran.dg/goacc/loop-1-2.f95: Ditto.
* gfortran.dg/goacc/loop-1.f95: Ditto.
* gfortran.dg/gomp/appendix-a/a.6.1.f90: Ditto.
* gfortran.dg/gomp/appendix-a/a.6.2.f90: Ditto.
* gfortran.dg/gomp/do-1.f90: Ditto.
* gfortran.dg/gomp/omp_do1.f90: Ditto.
* gfortran.dg/pr17229.f: Ditto.
* gfortran.dg/pr37243.f: Ditto.
* gfortran.dg/pr49721-1.f: Ditto.
* gfortran.dg/pr58484.f: Ditto.
* gfortran.dg/pr81175.f: Ditto.
* gfortran.dg/pr81723.f: Ditto.
* gfortran.dg/predcom-2.f: Ditto.
* gfortran.dg/vect/Ofast-pr50414.f90: Ditto.
* gfortran.dg/vect/cost-model-pr34445a.f: Ditto.
* gfortran.dg/vect/fast-math-mgrid-resid.f: Ditto.
* gfortran.dg/vect/pr52580.f: Ditto.

From-SVN: r260433

27 files changed:
gcc/fortran/ChangeLog
gcc/fortran/error.c
gcc/fortran/libgfortran.h
gcc/fortran/match.c
gcc/fortran/options.c
gcc/fortran/symbol.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/g77/19990826-3.f
gcc/testsuite/gfortran.dg/g77/20020307-1.f
gcc/testsuite/gfortran.dg/g77/980310-3.f
gcc/testsuite/gfortran.dg/goacc/loop-1-2.f95
gcc/testsuite/gfortran.dg/goacc/loop-1.f95
gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.1.f90
gcc/testsuite/gfortran.dg/gomp/appendix-a/a.6.2.f90
gcc/testsuite/gfortran.dg/gomp/do-1.f90
gcc/testsuite/gfortran.dg/gomp/omp_do1.f90
gcc/testsuite/gfortran.dg/pr17229.f
gcc/testsuite/gfortran.dg/pr37243.f
gcc/testsuite/gfortran.dg/pr49721-1.f
gcc/testsuite/gfortran.dg/pr58484.f
gcc/testsuite/gfortran.dg/pr81175.f
gcc/testsuite/gfortran.dg/pr81723.f
gcc/testsuite/gfortran.dg/predcom-2.f
gcc/testsuite/gfortran.dg/vect/Ofast-pr50414.f90
gcc/testsuite/gfortran.dg/vect/cost-model-pr34445a.f
gcc/testsuite/gfortran.dg/vect/fast-math-mgrid-resid.f
gcc/testsuite/gfortran.dg/vect/pr52580.f

index c5e1aa823e51cd8d6f363e1f697cd8ab2489d002..190ce3e0d7d1265571b0c223cfac2a2d621b1d7f 100644 (file)
@@ -1,3 +1,20 @@
+2018-05-21  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/85841
+       * libgfortran.h: New macros GFC_STD_OPT_*.
+       * error.c (notify_std_msg): New function.
+       (gfc_notify_std): Adjust such that it can handle combinations of
+       GFC_STD_* flags in the 'std' argument, not just a single one.
+       * match.c (match_arithmetic_if, gfc_match_if): Reject arithmetic if
+       in Fortran 2018.
+       (gfc_match_stopcode): Use GFC_STD_OPT_* macros.
+       * options.c (set_default_std_flags): Warn for F2018 deleted features
+       by default.
+       (gfc_handle_option): F2018 deleted features are allowed in earlier
+       standards.
+       * symbol.c (gfc_define_st_label, gfc_reference_st_label): Reject
+       nonblock do constructs in Fortran 2018.
+
 2018-05-20  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/80657
index cf9e57bb3ef13f19f7da37c30cc56628f97ccd27..fc183e0bf7063683f42300f2a9cf49ea3f299992 100644 (file)
@@ -842,6 +842,40 @@ gfc_notification_std (int std)
 }
 
 
+/* Return a string describing the nature of a standard violation
+ * and/or the relevant version of the standard.  */
+
+char const*
+notify_std_msg(int std)
+{
+
+  if (std & GFC_STD_F2018_DEL)
+    return _("Fortran 2018 deleted feature:");
+  else if (std & GFC_STD_F2018_OBS)
+    return _("Fortran 2018 obsolescent feature:");
+  else if (std & GFC_STD_F2018)
+    return _("Fortran 2018:");
+  else if (std & GFC_STD_F2008_TS)
+    return "TS 29113/TS 18508:";
+  else if (std & GFC_STD_F2008_OBS)
+    return _("Fortran 2008 obsolescent feature:");
+  else if (std & GFC_STD_F2008)
+    return "Fortran 2008:";
+  else if (std & GFC_STD_F2003)
+    return "Fortran 2003:";
+  else if (std & GFC_STD_GNU)
+    return _("GNU Extension:");
+  else if (std & GFC_STD_LEGACY)
+    return _("Legacy Extension:");
+  else if (std & GFC_STD_F95_OBS)
+    return _("Obsolescent feature:");
+  else if (std & GFC_STD_F95_DEL)
+    return _("Deleted feature:");
+  else
+    gcc_unreachable ();
+}
+
+
 /* Possibly issue a warning/error about use of a nonstandard (or deleted)
    feature.  An error/warning will be issued if the currently selected
    standard does not contain the requested bits.  Return false if
@@ -851,55 +885,24 @@ bool
 gfc_notify_std (int std, const char *gmsgid, ...)
 {
   va_list argp;
-  bool warning;
   const char *msg, *msg2;
   char *buffer;
 
-  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
-  if ((gfc_option.allow_std & std) != 0 && !warning)
-    return true;
+  /* Determine whether an error or a warning is needed.  */
+  const int wstd = std & gfc_option.warn_std;    /* Standard to warn about.  */
+  const int estd = std & ~gfc_option.allow_std;  /* Standard to error about.  */
+  const bool warning = (wstd != 0) && !inhibit_warnings;
+  const bool error = (estd != 0);
 
+  if (!error && !warning)
+    return true;
   if (suppress_errors)
-    return warning ? true : false;
+    return !error;
 
-  switch (std)
-  {
-    case GFC_STD_F2018_DEL:
-      msg = _("Fortran 2018 deleted feature:");
-      break;
-    case GFC_STD_F2018_OBS:
-      msg = _("Fortran 2018 obsolescent feature:");
-      break;
-    case GFC_STD_F2018:
-      msg = _("Fortran 2018:");
-      break;
-    case GFC_STD_F2008_TS:
-      msg = "TS 29113/TS 18508:";
-      break;
-    case GFC_STD_F2008_OBS:
-      msg = _("Fortran 2008 obsolescent feature:");
-      break;
-    case GFC_STD_F2008:
-      msg = "Fortran 2008:";
-      break;
-    case GFC_STD_F2003:
-      msg = "Fortran 2003:";
-      break;
-    case GFC_STD_GNU:
-      msg = _("GNU Extension:");
-      break;
-    case GFC_STD_LEGACY:
-      msg = _("Legacy Extension:");
-      break;
-    case GFC_STD_F95_OBS:
-      msg = _("Obsolescent feature:");
-      break;
-    case GFC_STD_F95_DEL:
-      msg = _("Deleted feature:");
-      break;
-    default:
-      gcc_unreachable ();
-  }
+  if (error)
+    msg = notify_std_msg (estd);
+  else
+    msg = notify_std_msg (wstd);
 
   msg2 = _(gmsgid);
   buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
@@ -908,13 +911,16 @@ gfc_notify_std (int std, const char *gmsgid, ...)
   strcat (buffer, msg2);
 
   va_start (argp, gmsgid);
-  if (warning)
-    gfc_warning (0, buffer, argp);
-  else
+  if (error)
     gfc_error_opt (0, buffer, argp);
+  else
+    gfc_warning (0, buffer, argp);
   va_end (argp);
 
-  return (warning && !warnings_are_errors) ? true : false;
+  if (error)
+    return false;
+  else
+    return (warning && !warnings_are_errors);
 }
 
 
index b7954a9dcd966bf9065805bb3eb8b7c857ef4c0f..278ee41655e509fdff919a5dc0a8df78c4b11a56 100644 (file)
@@ -37,6 +37,16 @@ along with GCC; see the file COPYING3.  If not see
 #define GFC_STD_F77            (1<<0)  /* Included in F77, but not deleted or
                                           obsolescent in later standards.  */
 
+/* Combinations of the above flags that specify which classes of features
+ * are allowed with a certain -std option.  */
+#define GFC_STD_OPT_F95                (GFC_STD_F77 | GFC_STD_F95 | GFC_STD_F95_OBS  \
+                               | GFC_STD_F2008_OBS | GFC_STD_F2018_OBS \
+                               | GFC_STD_F2018_DEL)
+#define GFC_STD_OPT_F03                (GFC_STD_OPT_F95 | GFC_STD_F2003)
+#define GFC_STD_OPT_F08                (GFC_STD_OPT_F03 | GFC_STD_F2008)
+#define GFC_STD_OPT_F08TS      (GFC_STD_OPT_F08 | GFC_STD_F2008_TS)
+#define GFC_STD_OPT_F18                ((GFC_STD_OPT_F08TS | GFC_STD_F2018) \
+                               & (~GFC_STD_F2018_DEL))
 
 /* Bitmasks for the various FPE that can be enabled.  These need to be straight integers
    e.g., 8 instead of (1<<3), because they will be included in Fortran source.  */
index 0931edd84aaf9cffabe798cb49502a3dc7c56de2..6d53d03e91d28173cfe93515634193013777e4dc 100644 (file)
@@ -1442,7 +1442,8 @@ match_arithmetic_if (void)
       return MATCH_ERROR;
     }
 
-  if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C"))
+  if (!gfc_notify_std (GFC_STD_F95_OBS | GFC_STD_F2018_DEL,
+                      "Arithmetic IF statement at %C"))
     return MATCH_ERROR;
 
   new_st.op = EXEC_ARITHMETIC_IF;
@@ -1522,7 +1523,8 @@ gfc_match_if (gfc_statement *if_type)
          return MATCH_ERROR;
        }
 
-      if (!gfc_notify_std (GFC_STD_F95_OBS, "Arithmetic IF statement at %C"))
+      if (!gfc_notify_std (GFC_STD_F95_OBS | GFC_STD_F2018_DEL,
+                          "Arithmetic IF statement at %C"))
        return MATCH_ERROR;
 
       new_st.op = EXEC_ARITHMETIC_IF;
@@ -2938,12 +2940,10 @@ gfc_match_stopcode (gfc_statement st)
   bool f95, f03;
 
   /* Set f95 for -std=f95.  */
-  f95 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
-                                | GFC_STD_F2008_OBS);
+  f95 = (gfc_option.allow_std == GFC_STD_OPT_F95);
 
   /* Set f03 for -std=f2003.  */
-  f03 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
-                                | GFC_STD_F2008_OBS | GFC_STD_F2003);
+  f03 = (gfc_option.allow_std == GFC_STD_OPT_F03);
 
   /* Look for a blank between STOP and the stop-code for F2008 or later.  */
   if (gfc_current_form != FORM_FIXED && !(f95 || f03))
index 3c17a583f6231f2593b136ead0788201a3263478..6f45a8e284d31292a3a2da59e98f55563ad588a2 100644 (file)
@@ -44,7 +44,7 @@ set_default_std_flags (void)
     | GFC_STD_F2003 | GFC_STD_F2008 | GFC_STD_F95 | GFC_STD_F77
     | GFC_STD_F2008_OBS | GFC_STD_F2008_TS | GFC_STD_GNU | GFC_STD_LEGACY
     | GFC_STD_F2018 | GFC_STD_F2018_DEL | GFC_STD_F2018_OBS;
-  gfc_option.warn_std = GFC_STD_F95_DEL | GFC_STD_LEGACY;
+  gfc_option.warn_std = GFC_STD_F2018_DEL | GFC_STD_F95_DEL | GFC_STD_LEGACY;
 }
 
 
@@ -705,8 +705,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       break;
 
     case OPT_std_f95:
-      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
-                            | GFC_STD_F2008_OBS;
+      gfc_option.allow_std = GFC_STD_OPT_F95;
       gfc_option.warn_std = GFC_STD_F95_OBS;
       gfc_option.max_continue_fixed = 19;
       gfc_option.max_continue_free = 39;
@@ -716,8 +715,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       break;
 
     case OPT_std_f2003:
-      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
-       | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
+      gfc_option.allow_std = GFC_STD_OPT_F03;
       gfc_option.warn_std = GFC_STD_F95_OBS;
       gfc_option.max_identifier_length = 63;
       warn_ampersand = 1;
@@ -725,8 +723,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       break;
 
     case OPT_std_f2008:
-      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
-       | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
+      gfc_option.allow_std = GFC_STD_OPT_F08;
       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
       gfc_option.max_identifier_length = 63;
       warn_ampersand = 1;
@@ -734,9 +731,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       break;
 
     case OPT_std_f2008ts:
-      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77 
-       | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS
-       | GFC_STD_F2008_TS;
+      gfc_option.allow_std = GFC_STD_OPT_F08TS;
       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
       gfc_option.max_identifier_length = 63;
       warn_ampersand = 1;
@@ -744,9 +739,7 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       break;
 
     case OPT_std_f2018:
-      gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
-       | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS
-       | GFC_STD_F2008_TS | GFC_STD_F2018 | GFC_STD_F2018_OBS;
+      gfc_option.allow_std = GFC_STD_OPT_F18;
       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS
        | GFC_STD_F2018_OBS;
       gfc_option.max_identifier_length = 63;
index d5597ba905b2f31c744fd1a8745a8ff4c3c4cd06..5538763732a59a3e03fba14eb2548fdf1b02993f 100644 (file)
@@ -2721,9 +2721,9 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
            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))
+             && !gfc_notify_std (GFC_STD_F95_OBS | GFC_STD_F2018_DEL,
+                                 "DO termination statement which is not END DO"
+                                 " or CONTINUE with label %d at %C", labelno))
            return;
          break;
 
@@ -2778,8 +2778,8 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type 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))
+      && !gfc_notify_std (GFC_STD_F95_OBS | GFC_STD_F2018_DEL,
+                         "Shared DO termination label %d at %C", labelno))
     return false;
 
   if (lp->referenced != ST_LABEL_DO_TARGET)
index 7866b3524e07a3f164be57df33a57b45a9fcf075..250f7a247edc8ec23f7d2dae9bf043351386aecf 100644 (file)
@@ -1,3 +1,27 @@
+2018-05-21  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/85841
+       * gfortran.dg/g77/19990826-3.f: Add option "-std=legacy".
+       * gfortran.dg/g77/20020307-1.f: Ditto.
+       * gfortran.dg/g77/980310-3.f: Ditto.
+       * gfortran.dg/goacc/loop-1-2.f95: Ditto.
+       * gfortran.dg/goacc/loop-1.f95: Ditto.
+       * gfortran.dg/gomp/appendix-a/a.6.1.f90: Ditto.
+       * gfortran.dg/gomp/appendix-a/a.6.2.f90: Ditto.
+       * gfortran.dg/gomp/do-1.f90: Ditto.
+       * gfortran.dg/gomp/omp_do1.f90: Ditto.
+       * gfortran.dg/pr17229.f: Ditto.
+       * gfortran.dg/pr37243.f: Ditto.
+       * gfortran.dg/pr49721-1.f: Ditto.
+       * gfortran.dg/pr58484.f: Ditto.
+       * gfortran.dg/pr81175.f: Ditto.
+       * gfortran.dg/pr81723.f: Ditto.
+       * gfortran.dg/predcom-2.f: Ditto.
+       * gfortran.dg/vect/Ofast-pr50414.f90: Ditto.
+       * gfortran.dg/vect/cost-model-pr34445a.f: Ditto.
+       * gfortran.dg/vect/fast-math-mgrid-resid.f: Ditto.
+       * gfortran.dg/vect/pr52580.f: Ditto.
+
 2018-05-20  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/80657
index 374c5538e105fa96449b112a8fb7a851f02da2a5..6e5f9924f9b9733cc4548bc37faa17a79819dc5b 100644 (file)
@@ -1,4 +1,5 @@
 c { dg-do compile }
+c { dg-options "-std=legacy" }
 * Date: Thu, 19 Aug 1999 10:02:32 +0200
 * From: Frederic Devernay <devernay@istar.fr>
 * Organization: ISTAR
@@ -64,7 +65,7 @@ C
       IF(M2.LT.64)INDE=5
       IF(M2.LT.32)INDE=4
       DO 3 NUN =3,INUN
-      DO 3 NDE=3,INDE ! { dg-warning "Obsolescent feature: Shared DO termination" }
+      DO 3 NDE=3,INDE
       N10=2**NUN
       N20=2**NDE
       NDIF=(N10-N20)
index 73585434cf7730bf18c97f683739d0038008494e..0ef4e6863bf44acdad7023f9c127b0d436c4efef 100644 (file)
@@ -1,4 +1,5 @@
 c { dg-do compile }
+c { dg-options "-std=legacy" }
       SUBROUTINE SWEEP
       PARAMETER(MAXDIM=4,MAXVEC=4**3*8,MAXT=20)
       REAL(KIND=8) B,W1,W2,BNORM,BINV,WT,W0,C1,C2,R1,R2
@@ -6,7 +7,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  ! { dg-warning "Obsolescent feature: Shared DO termination" }
+      DO 200 I1=1,IDIM
       DO 220 I2=1,IDIM
       CALL INTACT(ILAT,I1,I1,W1)
 220   CONTINUE
index 098e22c680a4409d0116472165b06b48754f7593..39bd86c8036595d0b55b7d62cdf1a711fe0259f0 100644 (file)
@@ -1,4 +1,5 @@
 c { dg-do compile }
+c { dg-options "-std=legacy" }
 c
 c This demonstrates a problem with g77 and pic on x86 where 
 c egcs 1.0.1 and earlier will generate bogus assembler output.
@@ -128,7 +129,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 ! { dg-warning "Obsolescent feature: Shared DO termination" }
+         do 240 j = low,igh
             tb = b(i,j)
             ta = a(i,j)
             if (ta .eq. 0.0d0) go to 220
@@ -242,7 +243,7 @@ c
          ir = wk(i,1)
          fi = 2.0d0**ir
          if (i .lt. low) fi = 1.0d0
-         do 400 j =low,n ! { dg-warning "Obsolescent feature: Shared DO termination" }
+         do 400 j =low,n
             jc = cscale(j)
             fj = 2.0d0**jc
             if (j .le. igh) go to 390
index 79665b948c3bf572d88a136d26e7498aab068934..f89687aab43be5657c439a3441f480308d2cec99 100644 (file)
@@ -1,4 +1,5 @@
 ! See also loop-1.f95.
+! { dg-additional-options "-std=legacy" }
 
 program test
   call test1
@@ -32,14 +33,12 @@ subroutine test1
   do 300 d = 1, 30, 6
       i = d
   300 a(i) = 1
-  ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 32 }
-  ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 32 }
+  ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 33 }
   !$acc loop
   do d = 1, 30, 5
        i = d
       a(i) = 2
   end do
-  ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 38 }
   ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 38 }
   !$acc loop
   do i = 1, 30
@@ -150,8 +149,7 @@ subroutine test1
     do i = 1, 3
         do r = 4, 6
         end do
-        ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 151 }
-        ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 151 }
+        ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 150 }
     end do
 
     ! Both seq and independent are not allowed
index 5f81b7a1d19c0d6bdbe6960b9a6521aa38a6e1e0..e51c9a40f9237ce739aba8244602a08e6fc36e66 100644 (file)
@@ -1,4 +1,5 @@
 ! See also loop-1-2.f95.
+! { dg-additional-options "-std=legacy" }
 
 module test
   implicit none
@@ -32,14 +33,12 @@ subroutine test1
   do 300 d = 1, 30, 6
       i = d
   300 a(i) = 1
-  ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 32 }
-  ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 32 }
+  ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 33 }
   !$acc loop
   do d = 1, 30, 5
        i = d
       a(i) = 2
   end do
-  ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 38 }
   ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 38 }
   !$acc loop
   do i = 1, 30
@@ -150,8 +149,7 @@ subroutine test1
     do i = 1, 3
         do r = 4, 6
         end do
-        ! { dg-warning "Deleted feature: Loop variable at .1. must be integer" "" { target *-*-* } 151 }
-        ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 151 }
+        ! { dg-error "ACC LOOP iteration variable must be of type integer" "" { target *-*-* } 150 }
     end do
 
     ! Both seq and independent are not allowed
index f1c6c659617f87c853edbbd24f5a03fe27527a83..189dff95ae447eb3b6f8c915c1dad7406c84238f 100644 (file)
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-std=legacy" }
 
       SUBROUTINE WORK(I, J)
       INTEGER I,J
index e1388089962cc03faaf82558ff5070e0ff2bdc76..677880fe13e62f1b727b16a92486fa6e5f3056e0 100644 (file)
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-additional-options "-std=legacy" }
 
         SUBROUTINE WORK(I, J)
         INTEGER I,J
index 19549988792c78cb37702d0cd6b387eea9127e8b..94978eabad481d06a431e962a076e3363d62fa9f 100644 (file)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-O -fopenmp -fdump-tree-omplower" }
+! { dg-options "-O -fopenmp -fdump-tree-omplower -std=legacy" }
 
 subroutine foo (i, j, k, s, a)
   integer :: i, j, k, s, a(100), l
index c97af1ddb8a249aed706332e13b1be4eeb54e239..3f33e27d9a706f0bfbcd708804a651dabc17ae43 100644 (file)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-fopenmp -std=gnu" }
+! { dg-options "-fopenmp -std=legacy" }
 subroutine foo
   integer :: i, j
   integer, dimension (30) :: a
@@ -24,11 +24,11 @@ subroutine foo
     i = i + 1
   end do
 !$omp do
-  do 300 d = 1, 30, 6 ! { dg-warning "Deleted feature: Loop variable" }
+  do 300 d = 1, 30, 6
     i = d
 300 a(i) = 1
 !$omp do
-  do d = 1, 30, 5 ! { dg-warning "Deleted feature: Loop variable" }
+  do d = 1, 30, 5
     i = d
     a(i) = 2
   end do
index 172f106b746e26bdf385268c66781b50e2fc0f41..cce4388ddce9aa4c386e0b41177364a439f87821 100644 (file)
@@ -1,23 +1,24 @@
 ! PR fortran/17229
 ! { dg-do run }
+! { dg-options "-std=legacy" }
 
       integer i
       logical l
 
       l = .false.
       i = -1
-      if (l) if (i) 999,999,999 ! { dg-warning "Obsolescent feature" }
+      if (l) if (i) 999,999,999
 
       l = .true.
-      if (l) if (i) 10,999,999 ! { dg-warning "Obsolescent feature" }
+      if (l) if (i) 10,999,999
       go to 999
 
    10 i = 0
-      if (l) if (i) 999,20,999 ! { dg-warning "Obsolescent feature" }
+      if (l) if (i) 999,20,999
       go to 999
 
    20 i = 1
-      if (l) if (i) 999,999,30 ! { dg-warning "Obsolescent feature" }
+      if (l) if (i) 999,999,30
       go to 999
 
   999 STOP 1
index f5dda43e71fcec6e434cfe328b66818ecc8581b9..f2a10a080555d0a818e1d515d09d88d7b7c72d39 100644 (file)
@@ -1,5 +1,6 @@
 ! PR rtl-optimization/37243
 ! { dg-do run }
+! { dg-options "-std=legacy" }
 ! { dg-add-options ieee }
 ! Check if register allocator handles IR flattening correctly.
       SUBROUTINE SCHMD(V,M,N,LDV)
       DO 160 I = 1,M
       DUMI = ZERO
       DO 100 K = 1,N
-  100 DUMI = DUMI+V(K,I)*V(K,I) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
+  100 DUMI = DUMI+V(K,I)*V(K,I)
       DUMI = ONE/ SQRT(DUMI)
       DO 120 K = 1,N
-  120 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
+  120 V(K,I) = V(K,I)*DUMI
       IF (I .EQ. M) GO TO 160
       I1 = I+1
       DO 140 J = I1,M
   220 J = J+1
       IF (J .GT. N) GO TO 320
       DO 240 K = 1,N
-  240 V(K,I) = ZERO ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
+  240 V(K,I) = ZERO
       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) ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
+  280 DUMI = DUMI+V(K,I)*V(K,I)
       IF ( ABS(DUMI) .LT. TOL) GO TO 220
       DO 300 K = 1,N
-  300 V(K,I) = V(K,I)*DUMI ! { dg-warning "Obsolescent feature: DO termination statement which is not END DO or CONTINUE" }
+  300 V(K,I) = V(K,I)*DUMI
       GO TO 200
   320 END
       program main
index 39e2ed74ef728efb646aa6f56f807c161f97b006..ab72ba4c1eb3224a1380e6739c1147ea66afa6d9 100644 (file)
@@ -1,6 +1,6 @@
 ! PR middle-end/49721
 ! { dg-do compile }
-! { dg-options "-O3 -funroll-loops" }
+! { dg-options "-O3 -funroll-loops -std=legacy" }
 
       subroutine midbloc6(c,a2,a2i,q)
       parameter (ndim2=6)
index 2fd791347e9b9b389e5d3db0cfb9634d3d9281c3..e71fd1a1981cc057d11b2a4499c1f70e3570d26a 100644 (file)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-O2" }
+! { dg-options "-O2 -std=legacy" }
       SUBROUTINE UMPSE(AIBJ,NOC,NDIM,NOCA,NVIRA,NOCCA,E2)
       DIMENSION AIBJ(NOC,NDIM,*)
       DO 20 MA=1,NVIRA
index 130ba9c1632308e1cea1fb8c273c68b2c57887a0..a260d39d3c37e2b652d17ee5469c632e9e07e245 100644 (file)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-Ofast -fwrapv" }
+! { dg-options "-Ofast -fwrapv -std=legacy" }
 ! { dg-additional-options "-march=broadwell" { target x86_64-*-* i?86-*-* } }
       SUBROUTINE ECPDRA(IC4C,FP,FQ,G)
       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
index 977c1b69bbfce3ee7fd49699120999372041c779..271ce858d75eeb65736577f7c8af8c9968bb3840 100644 (file)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
-! { dg-options "-O3 -fno-automatic" }
+! { dg-options "-O3 -fno-automatic -std=legacy" }
 
       FUNCTION WWERF(Z)
 
index 7e43cb07ae5d9985b8733813cdd10acbb955ee2d..81469c36f45186192350867c5f57e34cbf8ae066 100644 (file)
@@ -1,7 +1,7 @@
 ! PR 32220, ICE when the loop is not unrolled enough to eliminate all 
 !   register copies
 ! { dg-do compile }
-! { dg-options "-O3" }
+! { dg-options "-O3 -std=legacy" }
 
       subroutine derv (b,cosxy,thick)
 c
index 9369c53c6812d6743701e216bd38c1bacd2772cb..6ec369950ec81afd59f28467d056172866d43e78 100644 (file)
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-std=legacy" }
 
       SUBROUTINE  SUB  (A,L,YMAX)
       DIMENSION A(L)
index a39156c9567eb625d4e0092e4f341c793c1a056c..125b01feadcd28b49487a7cbba0e1720ea40fc8f 100644 (file)
@@ -1,4 +1,5 @@
 c { dg-do compile }
+c { dg-options "-std=legacy" }
       subroutine derv (xx,b,bv,det,r,s,t,ndopt,cosxy,thick,edis,
      1                  vni,vnt)
       implicit real*8 (a-h,o-z)
index 2e0840d256b84a0192eebe44ef1b59928028e49b..08965cc5e2029cc2d9b3208f68cb7bbd0a7dde55 100644 (file)
@@ -1,6 +1,6 @@
 ! { dg-do compile }
 ! { dg-require-effective-target vect_double }
-! { dg-options "-O3 --param vect-max-peeling-for-alignment=0 -fpredictive-commoning -fdump-tree-pcom-details" }
+! { dg-options "-O3 --param vect-max-peeling-for-alignment=0 -fpredictive-commoning -fdump-tree-pcom-details -std=legacy" }
 ! { dg-additional-options "-mprefer-avx128" { target { i?86-*-* x86_64-*-* } } }
 ! { dg-additional-options "-mzarch" { target { s390*-*-* } } }
 
index 82520764a6fb73a5e0fa592c2a7599c7d8005c6b..6f6df1ae48b299bc6b0939e08a08d4f0ec793630 100644 (file)
@@ -1,4 +1,5 @@
 ! { dg-do compile }
+! { dg-options "-std=legacy" }
 ! { dg-require-effective-target vect_double }
       SUBROUTINE CALC2
       IMPLICIT REAL*8  (A-H, O-Z)