re PR fortran/85841 ([F2018] reject deleted features)

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

6 files changed, 97 insertions, 71 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c5e1aa8..190ce3e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index cf9e57b..fc183e0 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -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);
 }
 
 
diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index b7954a9..278ee41 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -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.  */
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 0931edd..6d53d03 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -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))
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 3c17a58..6f45a8e 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -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;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index d5597ba..5538763 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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)