PR fortran/87923 -- fix ICE when resolving I/O tags and simplify io.c

2020-04-06  Fritz Reese  <foreese@gcc.gnu.org>

This patch reorganizes I/O checking code. Checks which were done in the
matching phase which do not affect the match result are moved to the
resolution phase. Checks which were duplicated in both the matching phase
and resolution phase have been reduced to one check in the resolution phase.

Another section of code which used a global async_io_dt flag to check for
and assign the asynchronous attribute to variables used in asynchronous I/O
has been simplified.

Furthermore, this patch improves error reporting and expands test coverage
of I/O tags:

 - "TAG must be an initialization expression" reported by io.c
   (check_io_constraints) is replaced with an error from expr.c
   (gfc_reduce_init_expr) indicating _why_ the expression is not a valid
   initialization expression.

 - Several distinct error messages regarding the check for scalar
   + character + default kind have been unified to one message reported by
   resolve_tag or check_*_constraints.

gcc/fortran/ChangeLog:

2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>

	PR fortran/87923
	* gfortran.h (gfc_resolve_open, gfc_resolve_close): Add
	locus parameter.
	(gfc_resolve_dt): Add code parameter.
	* io.c (async_io_dt, check_char_variable, is_char_type): Removed.
	(resolve_tag_format): Add locus to error message regarding
	zero-sized array in FORMAT tag.
	(check_open_constraints, check_close_constraints): New functions
	called at resolution time.
	(gfc_match_open, gfc_match_close, match_io): Move checks which don't
	affect the match result to new functions check_open_constraints,
	check_close_constraints, check_io_constraints.
	(gfc_resolve_open, gfc_resolve_close): Call new functions
	check_open_constraints, check_close_constraints after all tags have
	been independently resolved.  Remove duplicate constraints which are
	already verified by resolve_tag. Explicitly pass locus to all error
	reports.
	(compare_to_allowed_values): Add locus parameter and provide
	explicit locus all error reports.
	(match_open_element, match_close_element, match_file_element,
	match_dt_element, match_inquire_element): Remove redundant special
	cases for ASYNCHRONOUS and IOMSG tags.
	(gfc_resolve_dt): Remove redundant special case for format
	expression.  Call check_io_constraints, forwarding an I/O list as
	the io_code parameter if present.
	(check_io_constraints): Change return type to bool. Pass explicit
	locus to error reports. Move generic checks after tag-specific
	checks, since errors are no longer buffered.  Move simplification of
	format string to match_io.  Remove redundant checks which are
	verified by resolve_tag.  Remove usage of async_io_dt flag and
	explicitly mark symbols used in asynchronous I/O with the
	asynchronous attribute.
	* resolve.c (resolve_transfer, resolve_fl_namelist): Remove checks
	for async_io_dt flag. This is now done in io.c
	(check_io_constraints).
	(gfc_resolve_code): Pass code locus to gfc_resolve_open,
	gfc_resolve_close, gfc_resolve_dt.

gcc/testsuite/ChangeLog:

2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>

	PR fortran/87923
	* gfortran.dg/f2003_io_8.f03: Fix expected error messages.
	* gfortran.dg/io_constraints_8.f90: Likewise.
	* gfortran.dg/iomsg_2.f90: Likewise.
	* gfortran.dg/pr66725.f90: Likewise.
	* gfortran.dg/pr88205.f90: Likewise.
	* gfortran.dg/write_check4.f90: Likewise.
	* gfortran.dg/asynchronous_5.f03: New test.
	* gfortran.dg/io_constraints_15.f90: Likewise.
	* gfortran.dg/io_constraints_16.f90: Likewise.
	* gfortran.dg/io_constraints_17.f90: Likewise.
	* gfortran.dg/io_constraints_18.f90: Likewise.
	* gfortran.dg/io_tags_1.f90: Likewise.
	* gfortran.dg/io_tags_10.f90: Likewise.
	* gfortran.dg/io_tags_2.f90: Likewise.
	* gfortran.dg/io_tags_3.f90: Likewise.
	* gfortran.dg/io_tags_4.f90: Likewise.
	* gfortran.dg/io_tags_5.f90: Likewise.
	* gfortran.dg/io_tags_6.f90: Likewise.
	* gfortran.dg/io_tags_7.f90: Likewise.
	* gfortran.dg/io_tags_8.f90: Likewise.
	* gfortran.dg/io_tags_9.f90: Likewise.
	* gfortran.dg/write_check5.f90: Likewise.

27 files changed, 1124 insertions, 539 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fdbb8da..e2ebb96 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,43 @@
+2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>
+
+	PR fortran/87923
+	* gfortran.h (gfc_resolve_open, gfc_resolve_close): Add
+	locus parameter.
+	(gfc_resolve_dt): Add code parameter.
+	* io.c (async_io_dt, check_char_variable, is_char_type): Removed.
+	(resolve_tag_format): Add locus to error message regarding
+	zero-sized array in FORMAT tag.
+	(check_open_constraints, check_close_constraints): New functions
+	called at resolution time.
+	(gfc_match_open, gfc_match_close, match_io): Move checks which don't
+	affect the match result to new functions check_open_constraints,
+	check_close_constraints, check_io_constraints.
+	(gfc_resolve_open, gfc_resolve_close): Call new functions
+	check_open_constraints, check_close_constraints after all tags have
+	been independently resolved.  Remove duplicate constraints which are
+	already verified by resolve_tag.  Explicitly pass locus to all error
+	reports.
+	(compare_to_allowed_values): Add locus parameter and provide
+	explicit locus all error reports.
+	(match_open_element, match_close_element, match_file_element,
+	match_dt_element, match_inquire_element): Remove redundant special
+	cases for ASYNCHRONOUS and IOMSG tags.
+	(gfc_resolve_dt): Remove redundant special case for format
+	expression.  Call check_io_constraints, forwarding an I/O list as
+	the io_code parameter if present.
+	(check_io_constraints): Change return type to bool.  Pass explicit
+	locus to error reports.  Move generic checks after tag-specific
+	checks, since errors are no longer buffered.  Move simplification of
+	format string to match_io.  Remove redundant checks which are
+	verified by resolve_tag.  Remove usage of async_io_dt flag and
+	explicitly mark symbols used in asynchronous I/O with the
+	asynchronous attribute.
+	* resolve.c (resolve_transfer, resolve_fl_namelist): Remove checks
+	for async_io_dt flag.  This is now done in io.c.
+	(check_io_constraints).
+	(gfc_resolve_code): Pass code locus to gfc_resolve_open,
+	gfc_resolve_close, gfc_resolve_dt.
+
 2020-04-07  Fritz Reese  <foreese@gcc.gnu.org>
 	    Steven G. Kargl  <kargl@gcc.gnu.org>
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 70a6405..0d77386 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3476,18 +3476,17 @@ bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *,
 extern gfc_st_label format_asterisk;
 
 void gfc_free_open (gfc_open *);
-bool gfc_resolve_open (gfc_open *);
+bool gfc_resolve_open (gfc_open *, locus *);
 void gfc_free_close (gfc_close *);
-bool gfc_resolve_close (gfc_close *);
+bool gfc_resolve_close (gfc_close *, locus *);
 void gfc_free_filepos (gfc_filepos *);
 bool gfc_resolve_filepos (gfc_filepos *, locus *);
 void gfc_free_inquire (gfc_inquire *);
 bool gfc_resolve_inquire (gfc_inquire *);
 void gfc_free_dt (gfc_dt *);
-bool gfc_resolve_dt (gfc_dt *, locus *);
+bool gfc_resolve_dt (gfc_code *, gfc_dt *, locus *);
 void gfc_free_wait (gfc_wait *);
 bool gfc_resolve_wait (gfc_wait *);
-extern bool async_io_dt;
 
 /* module.c */
 void gfc_module_init_2 (void);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 59cd9ce..e066666 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -112,10 +112,6 @@ static gfc_dt *current_dt;
 
 #define RESOLVE_TAG(x, y) if (!resolve_tag (x, y)) return false;
 
-/* Are we currently processing an asynchronous I/O statement? */
-
-bool async_io_dt;
-
 /**************** Fortran 95 FORMAT parser  *****************/
 
 /* FORMAT tokens returned by format_lex().  */
@@ -1427,36 +1423,6 @@ gfc_match_format (void)
 }
 
 
-/* Check for a CHARACTER variable.  The check for scalar is done in
-   resolve_tag.  */
-
-static bool
-check_char_variable (gfc_expr *e)
-{
-  if (e->expr_type != EXPR_VARIABLE || e->ts.type != BT_CHARACTER)
-    {
-      gfc_error("IOMSG must be a scalar-default-char-variable at %L", &e->where);
-      return false;
-    }
-  return true;
-}
-
-
-static bool
-is_char_type (const char *name, gfc_expr *e)
-{
-  gfc_resolve_expr (e);
-
-  if (e->ts.type != BT_CHARACTER)
-    {
-      gfc_error ("%s requires a scalar-default-char-expr at %L",
-		   name, &e->where);
-      return false;
-    }
-  return true;
-}
-
-
 /* Match an expression I/O tag of some sort.  */
 
 static match
@@ -1725,7 +1691,8 @@ resolve_tag_format (gfc_expr *e)
 
 	  if (e->value.constructor == NULL)
 	   {
-	     gfc_error ("FORMAT tag at %C cannot be a zero-sized array");
+	     gfc_error ("FORMAT tag at %L cannot be a zero-sized array",
+			&e->where);
 	     return false;
 	   }
 
@@ -1919,16 +1886,12 @@ match_open_element (gfc_open *open)
   match m;
 
   m = match_etag (&tag_e_async, &open->asynchronous);
-  if (m == MATCH_YES && !is_char_type ("ASYNCHRONOUS", open->asynchronous))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_unit, &open->unit);
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_iomsg, &open->iomsg);
-  if (m == MATCH_YES && !check_char_variable (open->iomsg))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
   m = match_out_tag (&tag_iostat, &open->iostat);
@@ -2041,12 +2004,22 @@ gfc_free_open (gfc_open *open)
 }
 
 
+static int
+compare_to_allowed_values (const char *specifier, const char *allowed[],
+			   const char *allowed_f2003[],
+			   const char *allowed_gnu[], gfc_char_t *value,
+			   const char *statement, bool warn, locus *where,
+			   int *num = NULL);
+
+
+static bool
+check_open_constraints (gfc_open *open, locus *where);
+
 /* Resolve everything in a gfc_open structure.  */
 
 bool
-gfc_resolve_open (gfc_open *open)
+gfc_resolve_open (gfc_open *open, locus *where)
 {
-
   RESOLVE_TAG (&tag_unit, open->unit);
   RESOLVE_TAG (&tag_iomsg, open->iomsg);
   RESOLVE_TAG (&tag_iostat, open->iostat);
@@ -2073,7 +2046,7 @@ gfc_resolve_open (gfc_open *open)
   if (!gfc_reference_st_label (open->err, ST_LABEL_TARGET))
     return false;
 
-  return true;
+  return check_open_constraints (open, where);
 }
 
 
@@ -2081,19 +2054,13 @@ gfc_resolve_open (gfc_open *open)
    allowed in F95 or F2003, issuing an error message and returning a zero
    value if it is not allowed.  */
 
-static int
-compare_to_allowed_values (const char *specifier, const char *allowed[],
-			   const char *allowed_f2003[], 
-			   const char *allowed_gnu[], gfc_char_t *value,
-			   const char *statement, bool warn,
-			   int *num = NULL);
-
 
 static int
 compare_to_allowed_values (const char *specifier, const char *allowed[],
-			   const char *allowed_f2003[], 
+			   const char *allowed_f2003[],
 			   const char *allowed_gnu[], gfc_char_t *value,
-			   const char *statement, bool warn, int *num)
+			   const char *statement, bool warn, locus *where,
+			   int *num)
 {
   int i;
   unsigned int len;
@@ -2116,6 +2083,9 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
       return 1;
       }
 
+  if (!where)
+    where = &gfc_current_locus;
+
   for (i = 0; allowed_f2003 && allowed_f2003[i]; i++)
     if (len == strlen (allowed_f2003[i])
 	&& gfc_wide_strncasecmp (value, allowed_f2003[i],
@@ -2125,8 +2095,8 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 
 	if (n == WARNING || (warn && n == ERROR))
 	  {
-	    gfc_warning (0, "Fortran 2003: %s specifier in %s statement at %C "
-			 "has value %qs", specifier, statement,
+	    gfc_warning (0, "Fortran 2003: %s specifier in %s statement at %L "
+			 "has value %qs", specifier, statement, where,
 			 allowed_f2003[i]);
 	    return 1;
 	  }
@@ -2134,8 +2104,8 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 	  if (n == ERROR)
 	    {
 	      gfc_notify_std (GFC_STD_F2003, "%s specifier in "
-			      "%s statement at %C has value %qs", specifier,
-			      statement, allowed_f2003[i]);
+			      "%s statement at %L has value %qs", specifier,
+			      statement, where, allowed_f2003[i]);
 	      return 0;
 	    }
 
@@ -2152,8 +2122,8 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 
 	if (n == WARNING || (warn && n == ERROR))
 	  {
-	    gfc_warning (0, "Extension: %s specifier in %s statement at %C "
-			 "has value %qs", specifier, statement,
+	    gfc_warning (0, "Extension: %s specifier in %s statement at %L "
+			 "has value %qs", specifier, statement, where,
 			 allowed_gnu[i]);
 	    return 1;
 	  }
@@ -2161,8 +2131,8 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 	  if (n == ERROR)
 	    {
 	      gfc_notify_std (GFC_STD_GNU, "%s specifier in "
-			      "%s statement at %C has value %qs", specifier,
-			      statement, allowed_gnu[i]);
+			      "%s statement at %L has value %qs", specifier,
+			      statement, where, allowed_gnu[i]);
 	      return 0;
 	    }
 
@@ -2174,74 +2144,42 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
     {
       char *s = gfc_widechar_to_char (value, -1);
       gfc_warning (0,
-		   "%s specifier in %s statement at %C has invalid value %qs",
-		   specifier, statement, s);
+		   "%s specifier in %s statement at %L has invalid value %qs",
+		   specifier, statement, where, s);
       free (s);
       return 1;
     }
   else
     {
       char *s = gfc_widechar_to_char (value, -1);
-      gfc_error ("%s specifier in %s statement at %C has invalid value %qs",
-		 specifier, statement, s);
+      gfc_error ("%s specifier in %s statement at %L has invalid value %qs",
+		 specifier, statement, where, s);
       free (s);
       return 0;
     }
 }
 
 
-/* Match an OPEN statement.  */
+/* Check constraints on the OPEN statement.
+   Similar to check_io_constraints for data transfer statements.
+   At this point all tags have already been resolved via resolve_tag, which,
+   among other things, verifies that BT_CHARACTER tags are of default kind.  */
 
-match
-gfc_match_open (void)
+static bool
+check_open_constraints (gfc_open *open, locus *where)
 {
-  gfc_open *open;
-  match m;
-  bool warn;
-
-  m = gfc_match_char ('(');
-  if (m == MATCH_NO)
-    return m;
-
-  open = XCNEW (gfc_open);
-
-  m = match_open_element (open);
-
-  if (m == MATCH_ERROR)
-    goto cleanup;
-  if (m == MATCH_NO)
-    {
-      m = gfc_match_expr (&open->unit);
-      if (m == MATCH_ERROR)
-	goto cleanup;
-    }
-
-  for (;;)
-    {
-      if (gfc_match_char (')') == MATCH_YES)
-	break;
-      if (gfc_match_char (',') != MATCH_YES)
-	goto syntax;
-
-      m = match_open_element (open);
-      if (m == MATCH_ERROR)
-	goto cleanup;
-      if (m == MATCH_NO)
-	goto syntax;
-    }
-
-  if (gfc_match_eos () == MATCH_NO)
-    goto syntax;
-
-  if (gfc_pure (NULL))
-    {
-      gfc_error ("OPEN statement not allowed in PURE procedure at %C");
-      goto cleanup;
-    }
-
-  gfc_unset_implicit_pure (NULL);
+#define warn_or_error(...) \
+{ \
+  if (warn) \
+    gfc_warning (0, __VA_ARGS__); \
+  else \
+    { \
+      gfc_error (__VA_ARGS__); \
+      return false; \
+    } \
+}
 
-  warn = (open->err || open->iostat) ? true : false;
+  bool warn = (open->err || open->iostat) ? true : false;
 
   /* Checks on the ACCESS specifier.  */
   if (open->access && open->access->expr_type == EXPR_CONSTANT)
@@ -2250,14 +2188,11 @@ gfc_match_open (void)
       static const char *access_f2003[] = { "STREAM", NULL };
       static const char *access_gnu[] = { "APPEND", NULL };
 
-      if (!is_char_type ("ACCESS", open->access))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("ACCESS", access_f95, access_f2003,
 				      access_gnu,
 				      open->access->value.character.string,
-				      "OPEN", warn))
-	goto cleanup;
+				      "OPEN", warn, &open->access->where))
+	return false;
     }
 
   /* Checks on the ACTION specifier.  */
@@ -2266,21 +2201,20 @@ gfc_match_open (void)
       gfc_char_t *str = open->action->value.character.string;
       static const char *action[] = { "READ", "WRITE", "READWRITE", NULL };
 
-      if (!is_char_type ("ACTION", open->action))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("ACTION", action, NULL, NULL,
-				      str, "OPEN", warn))
-	goto cleanup;
+				      str, "OPEN", warn, &open->action->where))
+	return false;
 
       /* With READONLY, only allow ACTION='READ'.  */
       if (open->readonly && (gfc_wide_strlen (str) != 4
 			     || gfc_wide_strncasecmp (str, "READ", 4) != 0))
 	{
-	  gfc_error ("ACTION type conflicts with READONLY specifier at %C");
-	  goto cleanup;
+	  gfc_error ("ACTION type conflicts with READONLY specifier at %L",
+		     &open->action->where);
+	  return false;
 	}
     }
+
   /* If we see READONLY and no ACTION, set ACTION='READ'.  */
   else if (open->readonly && open->action == NULL)
     {
@@ -2291,27 +2225,10 @@ gfc_match_open (void)
   /* Checks on the ASYNCHRONOUS specifier.  */
   if (open->asynchronous)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %C "
-			   "not allowed in Fortran 95"))
-	goto cleanup;
-
-      if (!is_char_type ("ASYNCHRONOUS", open->asynchronous))
-	goto cleanup;
-
-      if (open->asynchronous->ts.kind != 1)
-	{
-	  gfc_error ("ASYNCHRONOUS= specifier at %L must be of default "
-		     "CHARACTER kind", &open->asynchronous->where);
-	  return MATCH_ERROR;
-	}
-
-      if (open->asynchronous->expr_type == EXPR_ARRAY
-	  || open->asynchronous->expr_type == EXPR_STRUCTURE)
-	{
-	  gfc_error ("ASYNCHRONOUS= specifier at %L must be scalar",
-		     &open->asynchronous->where);
-	  return MATCH_ERROR;
-	}
+      if (!gfc_notify_std (GFC_STD_F2003, "ASYNCHRONOUS= at %L "
+			   "not allowed in Fortran 95",
+			   &open->asynchronous->where))
+	return false;
 
       if (open->asynchronous->expr_type == EXPR_CONSTANT)
 	{
@@ -2319,20 +2236,17 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous,
 			NULL, NULL, open->asynchronous->value.character.string,
-			"OPEN", warn))
-	    goto cleanup;
+			"OPEN", warn, &open->asynchronous->where))
+	    return false;
 	}
     }
 
   /* Checks on the BLANK specifier.  */
   if (open->blank)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
-			   "not allowed in Fortran 95"))
-	goto cleanup;
-
-      if (!is_char_type ("BLANK", open->blank))
-	goto cleanup;
+      if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %L "
+			   "not allowed in Fortran 95", &open->blank->where))
+	return false;
 
       if (open->blank->expr_type == EXPR_CONSTANT)
 	{
@@ -2340,36 +2254,27 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
 					  open->blank->value.character.string,
-					  "OPEN", warn))
-	    goto cleanup;
+					  "OPEN", warn, &open->blank->where))
+	    return false;
 	}
     }
 
   /* Checks on the CARRIAGECONTROL specifier.  */
-  if (open->cc)
+  if (open->cc && open->cc->expr_type == EXPR_CONSTANT)
     {
-      if (!is_char_type ("CARRIAGECONTROL", open->cc))
-	goto cleanup;
-
-      if (open->cc->expr_type == EXPR_CONSTANT)
-	{
-	  static const char *cc[] = { "LIST", "FORTRAN", "NONE", NULL };
-	  if (!compare_to_allowed_values ("CARRIAGECONTROL", cc, NULL, NULL,
-					  open->cc->value.character.string,
-					  "OPEN", warn))
-	    goto cleanup;
-	}
+      static const char *cc[] = { "LIST", "FORTRAN", "NONE", NULL };
+      if (!compare_to_allowed_values ("CARRIAGECONTROL", cc, NULL, NULL,
+				      open->cc->value.character.string,
+				      "OPEN", warn, &open->cc->where))
+	return false;
     }
 
   /* Checks on the DECIMAL specifier.  */
   if (open->decimal)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
-			   "not allowed in Fortran 95"))
-	goto cleanup;
-
-      if (!is_char_type ("DECIMAL", open->decimal))
-	goto cleanup;
+      if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %L "
+			   "not allowed in Fortran 95", &open->decimal->where))
+	return false;
 
       if (open->decimal->expr_type == EXPR_CONSTANT)
 	{
@@ -2377,8 +2282,8 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
 					  open->decimal->value.character.string,
-					  "OPEN", warn))
-	    goto cleanup;
+					  "OPEN", warn, &open->decimal->where))
+	    return false;
 	}
     }
 
@@ -2389,25 +2294,19 @@ gfc_match_open (void)
 	{
 	  static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
 
-	  if (!is_char_type ("DELIM", open->delim))
-	    goto cleanup;
-
 	  if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
 					  open->delim->value.character.string,
-					  "OPEN", warn))
-	  goto cleanup;
+					  "OPEN", warn, &open->delim->where))
+	    return false;
 	}
     }
 
   /* Checks on the ENCODING specifier.  */
   if (open->encoding)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "ENCODING= at %C "
-			   "not allowed in Fortran 95"))
-	goto cleanup;
-
-      if (!is_char_type ("ENCODING", open->encoding))
-	goto cleanup;
+      if (!gfc_notify_std (GFC_STD_F2003, "ENCODING= at %L "
+			   "not allowed in Fortran 95", &open->encoding->where))
+	return false;
 
       if (open->encoding->expr_type == EXPR_CONSTANT)
 	{
@@ -2415,8 +2314,8 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("ENCODING", encoding, NULL, NULL,
 					  open->encoding->value.character.string,
-					  "OPEN", warn))
-	  goto cleanup;
+					  "OPEN", warn, &open->encoding->where))
+	    return false;
 	}
     }
 
@@ -2425,13 +2324,10 @@ gfc_match_open (void)
     {
       static const char *form[] = { "FORMATTED", "UNFORMATTED", NULL };
 
-      if (!is_char_type ("FORM", open->form))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("FORM", form, NULL, NULL,
 				      open->form->value.character.string,
-				      "OPEN", warn))
-	goto cleanup;
+				      "OPEN", warn, &open->form->where))
+	return false;
     }
 
   /* Checks on the PAD specifier.  */
@@ -2439,13 +2335,10 @@ gfc_match_open (void)
     {
       static const char *pad[] = { "YES", "NO", NULL };
 
-      if (!is_char_type ("PAD", open->pad))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
 				      open->pad->value.character.string,
-				      "OPEN", warn))
-	goto cleanup;
+				      "OPEN", warn, &open->pad->where))
+	return false;
     }
 
   /* Checks on the POSITION specifier.  */
@@ -2453,24 +2346,18 @@ gfc_match_open (void)
     {
       static const char *position[] = { "ASIS", "REWIND", "APPEND", NULL };
 
-      if (!is_char_type ("POSITION", open->position))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("POSITION", position, NULL, NULL,
 				      open->position->value.character.string,
-				      "OPEN", warn))
-	goto cleanup;
+				      "OPEN", warn, &open->position->where))
+	return false;
     }
 
   /* Checks on the ROUND specifier.  */
   if (open->round)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
-			   "not allowed in Fortran 95"))
-      goto cleanup;
-
-      if (!is_char_type ("ROUND", open->round))
-	goto cleanup;
+      if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %L "
+			   "not allowed in Fortran 95", &open->round->where))
+	return false;
 
       if (open->round->expr_type == EXPR_CONSTANT)
 	{
@@ -2480,36 +2367,27 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("ROUND", round, NULL, NULL,
 					  open->round->value.character.string,
-					  "OPEN", warn))
-	  goto cleanup;
+					  "OPEN", warn, &open->round->where))
+	    return false;
 	}
     }
 
   /* Checks on the SHARE specifier.  */
-  if (open->share)
+  if (open->share && open->share->expr_type == EXPR_CONSTANT)
     {
-      if (!is_char_type ("SHARE", open->share))
-	goto cleanup;
-
-      if (open->share->expr_type == EXPR_CONSTANT)
-	{
-	  static const char *share[] = { "DENYNONE", "DENYRW", NULL };
-	  if (!compare_to_allowed_values ("SHARE", share, NULL, NULL,
-					  open->share->value.character.string,
-					  "OPEN", warn))
-	    goto cleanup;
-	}
+      static const char *share[] = { "DENYNONE", "DENYRW", NULL };
+      if (!compare_to_allowed_values ("SHARE", share, NULL, NULL,
+				      open->share->value.character.string,
+				      "OPEN", warn, &open->share->where))
+	return false;
     }
 
   /* Checks on the SIGN specifier.  */
-  if (open->sign) 
+  if (open->sign)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
-			   "not allowed in Fortran 95"))
-	goto cleanup;
-
-      if (!is_char_type ("SIGN", open->sign))
-	goto cleanup;
+      if (!gfc_notify_std (GFC_STD_F2003, "SIGN= at %L "
+			   "not allowed in Fortran 95", &open->sign->where))
+	return false;
 
       if (open->sign->expr_type == EXPR_CONSTANT)
 	{
@@ -2518,28 +2396,18 @@ gfc_match_open (void)
 
 	  if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL,
 					  open->sign->value.character.string,
-					  "OPEN", warn))
-	  goto cleanup;
+					  "OPEN", warn, &open->sign->where))
+	    return false;
 	}
     }
 
-#define warn_or_error(...) \
-{ \
-  if (warn) \
-    gfc_warning (0, __VA_ARGS__); \
-  else \
-    { \
-      gfc_error (__VA_ARGS__); \
-      goto cleanup; \
-    } \
-}
-
   /* Checks on the RECL specifier.  */
   if (open->recl && open->recl->expr_type == EXPR_CONSTANT
       && open->recl->ts.type == BT_INTEGER
       && mpz_sgn (open->recl->value.integer) != 1)
     {
-      warn_or_error ("RECL in OPEN statement at %C must be positive");
+      warn_or_error ("RECL in OPEN statement at %L must be positive",
+		     &open->recl->where);
     }
 
   /* Checks on the STATUS specifier.  */
@@ -2548,13 +2416,10 @@ gfc_match_open (void)
       static const char *status[] = { "OLD", "NEW", "SCRATCH",
 	"REPLACE", "UNKNOWN", NULL };
 
-      if (!is_char_type ("STATUS", open->status))
-	goto cleanup;
-
       if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
 				      open->status->value.character.string,
-				      "OPEN", warn))
-	goto cleanup;
+				      "OPEN", warn, &open->status->where))
+	return false;
 
       /* F2003, 9.4.5: If the STATUS= specifier has the value NEW or REPLACE,
 	 the FILE= specifier shall appear.  */
@@ -2566,8 +2431,9 @@ gfc_match_open (void)
 	{
 	  char *s = gfc_widechar_to_char (open->status->value.character.string,
 					  -1);
-	  warn_or_error ("The STATUS specified in OPEN statement at %C is "
-			 "%qs and no FILE specifier is present", s);
+	  warn_or_error ("The STATUS specified in OPEN statement at %L is "
+			 "%qs and no FILE specifier is present",
+			 &open->status->where, s);
 	  free (s);
 	}
 
@@ -2576,9 +2442,9 @@ gfc_match_open (void)
       if (gfc_wide_strncasecmp (open->status->value.character.string,
 				"scratch", 7) == 0 && open->file)
 	{
-	  warn_or_error ("The STATUS specified in OPEN statement at %C "
+	  warn_or_error ("The STATUS specified in OPEN statement at %L "
 			 "cannot have the value SCRATCH if a FILE specifier "
-			 "is present");
+			 "is present", &open->status->where);
 	}
     }
 
@@ -2587,8 +2453,9 @@ gfc_match_open (void)
     {
       if (open->unit)
 	{
-	  gfc_error ("UNIT specifier not allowed with NEWUNIT at %C");
-	  goto cleanup;
+	  gfc_error ("UNIT specifier not allowed with NEWUNIT at %L",
+		     &open->newunit->where);
+	  return false;
 	}
 
       if (!open->file &&
@@ -2598,14 +2465,15 @@ gfc_match_open (void)
 				      "scratch", 7) != 0)))
 	{
 	     gfc_error ("NEWUNIT specifier must have FILE= "
-			"or STATUS='scratch' at %C");
-	     goto cleanup;
+			"or STATUS='scratch' at %L", &open->newunit->where);
+	     return false;
 	}
     }
   else if (!open->unit)
     {
-      gfc_error ("OPEN statement at %C must have UNIT or NEWUNIT specified");
-      goto cleanup;
+      gfc_error ("OPEN statement at %L must have UNIT or NEWUNIT specified",
+		 where);
+      return false;
     }
 
   /* Things that are not allowed for unformatted I/O.  */
@@ -2615,20 +2483,39 @@ gfc_match_open (void)
       && gfc_wide_strncasecmp (open->form->value.character.string,
 			       "unformatted", 11) == 0)
     {
-      const char *spec = (open->delim ? "DELIM "
-				      : (open->pad ? "PAD " : open->blank
-							    ? "BLANK " : ""));
+      locus *loc;
+      const char *spec;
+      if (open->delim)
+	{
+	  loc = &open->delim->where;
+	  spec = "DELIM ";
+	}
+      else if (open->pad)
+	{
+	  loc = &open->pad->where;
+	  spec = "PAD ";
+	}
+      else if (open->blank)
+	{
+	  loc = &open->blank->where;
+	  spec = "BLANK ";
+	}
+      else
+	{
+	  loc = where;
+	  spec = "";
+	}
 
-      warn_or_error ("%s specifier at %C not allowed in OPEN statement for "
-		     "unformatted I/O", spec);
+      warn_or_error ("%s specifier at %L not allowed in OPEN statement for "
+		     "unformatted I/O", spec, loc);
     }
 
   if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT
       && gfc_wide_strncasecmp (open->access->value.character.string,
 			       "stream", 6) == 0)
     {
-      warn_or_error ("RECL specifier not allowed in OPEN statement at %C for "
-		     "stream I/O");
+      warn_or_error ("RECL specifier not allowed in OPEN statement at %L for "
+		     "stream I/O", &open->recl->where);
     }
 
   if (open->position
@@ -2640,11 +2527,64 @@ gfc_match_open (void)
 	   || gfc_wide_strncasecmp (open->access->value.character.string,
 				    "append", 6) == 0))
     {
-      warn_or_error ("POSITION specifier in OPEN statement at %C only allowed "
-		     "for stream or sequential ACCESS");
+      warn_or_error ("POSITION specifier in OPEN statement at %L only allowed "
+		     "for stream or sequential ACCESS", &open->position->where);
     }
 
+  return true;
 #undef warn_or_error
+}
+
+
+/* Match an OPEN statement.  */
+
+match
+gfc_match_open (void)
+{
+  gfc_open *open;
+  match m;
+
+  m = gfc_match_char ('(');
+  if (m == MATCH_NO)
+    return m;
+
+  open = XCNEW (gfc_open);
+
+  m = match_open_element (open);
+
+  if (m == MATCH_ERROR)
+    goto cleanup;
+  if (m == MATCH_NO)
+    {
+      m = gfc_match_expr (&open->unit);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+    }
+
+  for (;;)
+    {
+      if (gfc_match_char (')') == MATCH_YES)
+	break;
+      if (gfc_match_char (',') != MATCH_YES)
+	goto syntax;
+
+      m = match_open_element (open);
+      if (m == MATCH_ERROR)
+	goto cleanup;
+      if (m == MATCH_NO)
+	goto syntax;
+    }
+
+  if (gfc_match_eos () == MATCH_NO)
+    goto syntax;
+
+  if (gfc_pure (NULL))
+    {
+      gfc_error ("OPEN statement not allowed in PURE procedure at %C");
+      goto cleanup;
+    }
+
+  gfc_unset_implicit_pure (NULL);
 
   new_st.op = EXEC_OPEN;
   new_st.ext.open = open;
@@ -2689,8 +2629,6 @@ match_close_element (gfc_close *close)
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_iomsg, &close->iomsg);
-  if (m == MATCH_YES && !check_char_variable (close->iomsg))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
   m = match_out_tag (&tag_iostat, &close->iostat);
@@ -2711,7 +2649,6 @@ gfc_match_close (void)
 {
   gfc_close *close;
   match m;
-  bool warn;
 
   m = gfc_match_char ('(');
   if (m == MATCH_NO)
@@ -2757,22 +2694,6 @@ gfc_match_close (void)
 
   gfc_unset_implicit_pure (NULL);
 
-  warn = (close->iostat || close->err) ? true : false;
-
-  /* Checks on the STATUS specifier.  */
-  if (close->status && close->status->expr_type == EXPR_CONSTANT)
-    {
-      static const char *status[] = { "KEEP", "DELETE", NULL };
-
-      if (!is_char_type ("STATUS", close->status))
-	goto cleanup;
-
-      if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
-				      close->status->value.character.string,
-				      "CLOSE", warn))
-	goto cleanup;
-    }
-
   new_st.op = EXEC_CLOSE;
   new_st.ext.close = close;
   return MATCH_YES;
@@ -2786,34 +2707,14 @@ cleanup:
 }
 
 
-/* Resolve everything in a gfc_close structure.  */
-
-bool
-gfc_resolve_close (gfc_close *close)
+static bool
+check_close_constraints (gfc_close *close, locus *where)
 {
-  RESOLVE_TAG (&tag_unit, close->unit);
-  RESOLVE_TAG (&tag_iomsg, close->iomsg);
-  RESOLVE_TAG (&tag_iostat, close->iostat);
-  RESOLVE_TAG (&tag_status, close->status);
-
-  if (!gfc_reference_st_label (close->err, ST_LABEL_TARGET))
-    return false;
+  bool warn = (close->iostat || close->err) ? true : false;
 
   if (close->unit == NULL)
     {
-      /* Find a locus from one of the arguments to close, when UNIT is
-	 not specified.  */
-      locus loc = gfc_current_locus;
-      if (close->status)
-	loc = close->status->where;
-      else if (close->iostat)
-	loc = close->iostat->where;
-      else if (close->iomsg)
-	loc = close->iomsg->where;
-      else if (close->err)
-	loc = close->err->where;
-
-      gfc_error ("CLOSE statement at %L requires a UNIT number", &loc);
+      gfc_error ("CLOSE statement at %L requires a UNIT number", where);
       return false;
     }
 
@@ -2825,9 +2726,36 @@ gfc_resolve_close (gfc_close *close)
 		 &close->unit->where);
     }
 
+  /* Checks on the STATUS specifier.  */
+  if (close->status && close->status->expr_type == EXPR_CONSTANT)
+    {
+      static const char *status[] = { "KEEP", "DELETE", NULL };
+
+      if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
+				      close->status->value.character.string,
+				      "CLOSE", warn, &close->status->where))
+	return false;
+    }
+
   return true;
 }
 
+/* Resolve everything in a gfc_close structure.  */
+
+bool
+gfc_resolve_close (gfc_close *close, locus *where)
+{
+  RESOLVE_TAG (&tag_unit, close->unit);
+  RESOLVE_TAG (&tag_iomsg, close->iomsg);
+  RESOLVE_TAG (&tag_iostat, close->iostat);
+  RESOLVE_TAG (&tag_status, close->status);
+
+  if (!gfc_reference_st_label (close->err, ST_LABEL_TARGET))
+    return false;
+
+  return check_close_constraints (close, where);
+}
+
 
 /* Free a gfc_filepos structure.  */
 
@@ -2852,8 +2780,6 @@ match_file_element (gfc_filepos *fp)
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_iomsg, &fp->iomsg);
-  if (m == MATCH_YES && !check_char_variable (fp->iomsg))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
   m = match_out_tag (&tag_iostat, &fp->iostat);
@@ -3227,8 +3153,6 @@ match_dt_element (io_kind k, gfc_dt *dt)
     }
 
   m = match_etag (&tag_e_async, &dt->asynchronous);
-  if (m == MATCH_YES && !is_char_type ("ASYNCHRONOUS", dt->asynchronous))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_e_blank, &dt->blank);
@@ -3259,8 +3183,6 @@ match_dt_element (io_kind k, gfc_dt *dt)
   if (m != MATCH_NO)
     return m;
   m = match_etag (&tag_iomsg, &dt->iomsg);
-  if (m == MATCH_YES && !check_char_variable (dt->iomsg))
-    return MATCH_ERROR;
   if (m != MATCH_NO)
     return m;
 
@@ -3330,28 +3252,26 @@ gfc_free_dt (gfc_dt *dt)
 }
 
 
+static const char *
+io_kind_name (io_kind k);
+
+static bool
+check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code,
+		      locus *spec_end);
+
 /* Resolve everything in a gfc_dt structure.  */
 
 bool
-gfc_resolve_dt (gfc_dt *dt, locus *loc)
+gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
 {
   gfc_expr *e;
   io_kind k;
-  locus tmp;
 
   /* This is set in any case.  */
   gcc_assert (dt->dt_io_kind);
   k = dt->dt_io_kind->value.iokind;
 
-  tmp = gfc_current_locus;
-  gfc_current_locus = *loc;
-  if (!resolve_tag (&tag_format, dt->format_expr))
-    {
-      gfc_current_locus = tmp;
-      return false;
-    }
-  gfc_current_locus = tmp;
-
+  RESOLVE_TAG (&tag_format, dt->format_expr);
   RESOLVE_TAG (&tag_rec, dt->rec);
   RESOLVE_TAG (&tag_spos, dt->pos);
   RESOLVE_TAG (&tag_advance, dt->advance);
@@ -3367,6 +3287,18 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
   RESOLVE_TAG (&tag_e_decimal, dt->decimal);
   RESOLVE_TAG (&tag_e_async, dt->asynchronous);
 
+  /* Check I/O constraints.
+     To validate NAMELIST we need to check if we were also given an I/O list,
+     which is stored in code->block->next with op EXEC_TRANSFER.
+     Note that the I/O list was already resolved from resolve_transfer.  */
+  gfc_code *io_code = NULL;
+  if (dt_code && dt_code->block && dt_code->block->next
+      && dt_code->block->next->op == EXEC_TRANSFER)
+    io_code = dt_code->block->next;
+
+  if (!check_io_constraints (k, dt, io_code, loc))
+    return false;
+
   e = dt->io_unit;
   if (e == NULL)
     {
@@ -3821,11 +3753,13 @@ terminate_io (gfc_code *io_code)
 
 
 /* Check the constraints for a data transfer statement.  The majority of the
-   constraints appearing in 9.4 of the standard appear here.  Some are handled
-   in resolve_tag and others in gfc_resolve_dt.  Also set the async_io_dt flag
-   and, if necessary, the asynchronous flag on the SIZE argument.  */
+   constraints appearing in 9.4 of the standard appear here.
 
-static match
+   Tag expressions are already resolved by resolve_tag, which includes
+   verifying the type, that they are scalar, and verifying that BT_CHARACTER
+   tags are of default kind.  */
+
+static bool
 check_io_constraints (io_kind k, gfc_dt *dt, gfc_code *io_code,
 		      locus *spec_end)
 {
@@ -3835,11 +3769,10 @@ if (condition) \
     if ((arg)->lb != NULL)\
       gfc_error ((msg), (arg));\
     else\
-      gfc_error ((msg), &gfc_current_locus);\
-    m = MATCH_ERROR;\
+      gfc_error ((msg), spec_end);\
+    return false;\
   }
 
-  match m;
   gfc_expr *expr;
   gfc_symbol *sym = NULL;
   bool warn, unformatted;
@@ -3848,8 +3781,6 @@ if (condition) \
   unformatted = dt->format_expr == NULL && dt->format_label == NULL
 		&& dt->namelist == NULL;
 
-  m = MATCH_YES;
-
   expr = dt->io_unit;
   if (expr && expr->expr_type == EXPR_VARIABLE
       && expr->ts.type == BT_CHARACTER)
@@ -3867,7 +3798,7 @@ if (condition) \
       io_constraint (dt->rec != NULL,
 		     "REC tag at %L is incompatible with internal file",
 		     &dt->rec->where);
-    
+
       io_constraint (dt->pos != NULL,
 		     "POS tag at %L is incompatible with internal file",
 		     &dt->pos->where);
@@ -3884,7 +3815,7 @@ if (condition) \
 	{
 	  if (!gfc_notify_std (GFC_STD_F2003, "Internal file at %L with "
 			       "namelist", &expr->where))
-	    m = MATCH_ERROR;
+	    return false;
 	}
 
       io_constraint (dt->advance != NULL,
@@ -3897,87 +3828,57 @@ if (condition) \
 
       if (gfc_pure (NULL) && (k == M_READ || k == M_WRITE))
 	{
-	  gfc_error ("IO UNIT in %s statement at %C must be "
+	  gfc_error ("IO UNIT in %s statement at %L must be "
 		     "an internal file in a PURE procedure",
-		     io_kind_name (k));
-	  return MATCH_ERROR;
+		     io_kind_name (k), &expr->where);
+	  return false;
 	}
-	  
+
       if (k == M_READ || k == M_WRITE)
 	gfc_unset_implicit_pure (NULL);
     }
 
-  if (k != M_READ)
-    {
-      io_constraint (dt->end, "END tag not allowed with output at %L",
-		     &dt->end_where);
-
-      io_constraint (dt->eor, "EOR tag not allowed with output at %L",
-		     &dt->eor_where);
-
-      io_constraint (dt->blank, "BLANK= specifier not allowed with output at %L",
-		     &dt->blank->where);
-
-      io_constraint (dt->pad, "PAD= specifier not allowed with output at %L",
-		     &dt->pad->where);
-
-      io_constraint (dt->size, "SIZE= specifier not allowed with output at %L",
-		     &dt->size->where);
-    }
-  else
-    {
-      io_constraint (dt->size && dt->advance == NULL,
-		     "SIZE tag at %L requires an ADVANCE tag",
-		     &dt->size->where);
-
-      io_constraint (dt->eor && dt->advance == NULL,
-		     "EOR tag at %L requires an ADVANCE tag",
-		     &dt->eor_where);
-    }
-
-  if (dt->asynchronous) 
+  if (dt->asynchronous)
     {
       int num;
       static const char * asynchronous[] = { "YES", "NO", NULL };
 
+      /* Note: gfc_reduce_init_expr reports an error if not init-expr.  */
       if (!gfc_reduce_init_expr (dt->asynchronous))
-	{
-	  gfc_error ("ASYNCHRONOUS= specifier at %L must be an initialization "
-		     "expression", &dt->asynchronous->where);
-	  return MATCH_ERROR;
-	}
-
-      if (!is_char_type ("ASYNCHRONOUS", dt->asynchronous))
-	return MATCH_ERROR;
-
-      if (dt->asynchronous->ts.kind != 1)
-	{
-	  gfc_error ("ASYNCHRONOUS= specifier at %L must be of default "
-		     "CHARACTER kind", &dt->asynchronous->where);
-	  return MATCH_ERROR;
-	}
-
-      if (dt->asynchronous->expr_type == EXPR_ARRAY
-	  || dt->asynchronous->expr_type == EXPR_STRUCTURE)
-	{
-	  gfc_error ("ASYNCHRONOUS= specifier at %L must be scalar",
-		     &dt->asynchronous->where);
-	  return MATCH_ERROR;
-	}
+	return false;
 
       if (!compare_to_allowed_values
 		("ASYNCHRONOUS", asynchronous, NULL, NULL,
 		 dt->asynchronous->value.character.string,
-		 io_kind_name (k), warn, &num))
-	return MATCH_ERROR;
+		 io_kind_name (k), warn, &dt->asynchronous->where, &num))
+	return false;
 
-      /* Best to put this here because the yes/no info is still around.  */
-      async_io_dt = num == 0;
-      if (async_io_dt && dt->size)
-	dt->size->symtree->n.sym->attr.asynchronous = 1;
+      /* For "YES", mark related symbols as asynchronous.  */
+      if (num == 0)
+	{
+	  /* SIZE variable.  */
+	  if (dt->size)
+	    dt->size->symtree->n.sym->attr.asynchronous = 1;
+
+	  /* Variables in a NAMELIST.  */
+	  if (dt->namelist)
+	    for (gfc_namelist *nl = dt->namelist->namelist; nl; nl = nl->next)
+	      nl->sym->attr.asynchronous = 1;
+
+	  /* Variables in an I/O list.  */
+	  for (gfc_code *xfer = io_code; xfer && xfer->op == EXEC_TRANSFER;
+	       xfer = xfer->next)
+	    {
+	      gfc_expr *expr = xfer->expr1;
+	      while (expr != NULL && expr->expr_type == EXPR_OP
+		     && expr->value.op.op == INTRINSIC_PARENTHESES)
+		expr = expr->value.op.op1;
+
+	      if (expr && expr->expr_type == EXPR_VARIABLE)
+		expr->symtree->n.sym->attr.asynchronous = 1;
+	    }
+	}
     }
-  else
-    async_io_dt = false;
 
   if (dt->id)
     {
@@ -3993,36 +3894,31 @@ if (condition) \
 
   if (dt->decimal)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %C "
-			   "not allowed in Fortran 95"))
-	return MATCH_ERROR;
+      if (!gfc_notify_std (GFC_STD_F2003, "DECIMAL= at %L "
+			   "not allowed in Fortran 95", &dt->decimal->where))
+	return false;
 
       if (dt->decimal->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * decimal[] = { "COMMA", "POINT", NULL };
 
-      if (!is_char_type ("DECIMAL", dt->decimal))
-	return MATCH_ERROR;
-
 	  if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
 					  dt->decimal->value.character.string,
-					  io_kind_name (k), warn))
-	    return MATCH_ERROR;
+					  io_kind_name (k), warn,
+					  &dt->decimal->where))
+	    return false;
 
 	  io_constraint (unformatted,
 			 "the DECIMAL= specifier at %L must be with an "
 			 "explicit format expression", &dt->decimal->where);
 	}
     }
-  
+
   if (dt->blank)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %C "
-			   "not allowed in Fortran 95"))
-	return MATCH_ERROR;
-
-      if (!is_char_type ("BLANK", dt->blank))
-	return MATCH_ERROR;
+      if (!gfc_notify_std (GFC_STD_F2003, "BLANK= at %L "
+			   "not allowed in Fortran 95", &dt->blank->where))
+	return false;
 
       if (dt->blank->expr_type == EXPR_CONSTANT)
 	{
@@ -4031,8 +3927,9 @@ if (condition) \
 
 	  if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
 					  dt->blank->value.character.string,
-					  io_kind_name (k), warn))
-	    return MATCH_ERROR;
+					  io_kind_name (k), warn,
+					  &dt->blank->where))
+	    return false;
 
 	  io_constraint (unformatted,
 			 "the BLANK= specifier at %L must be with an "
@@ -4042,12 +3939,9 @@ if (condition) \
 
   if (dt->pad)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "PAD= at %C "
-			   "not allowed in Fortran 95"))
-	return MATCH_ERROR;
-
-      if (!is_char_type ("PAD", dt->pad))
-	return MATCH_ERROR;
+      if (!gfc_notify_std (GFC_STD_F2003, "PAD= at %L "
+			   "not allowed in Fortran 95", &dt->pad->where))
+	return false;
 
       if (dt->pad->expr_type == EXPR_CONSTANT)
 	{
@@ -4055,8 +3949,9 @@ if (condition) \
 
 	  if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
 					  dt->pad->value.character.string,
-					  io_kind_name (k), warn))
-	    return MATCH_ERROR;
+					  io_kind_name (k), warn,
+					  &dt->pad->where))
+	    return false;
 
 	  io_constraint (unformatted,
 			 "the PAD= specifier at %L must be with an "
@@ -4066,12 +3961,9 @@ if (condition) \
 
   if (dt->round)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %C "
-			   "not allowed in Fortran 95"))
-	return MATCH_ERROR;
-
-      if (!is_char_type ("ROUND", dt->round))
-	return MATCH_ERROR;
+      if (!gfc_notify_std (GFC_STD_F2003, "ROUND= at %L "
+			   "not allowed in Fortran 95", &dt->round->where))
+	return false;
 
       if (dt->round->expr_type == EXPR_CONSTANT)
 	{
@@ -4081,20 +3973,18 @@ if (condition) \
 
 	  if (!compare_to_allowed_values ("ROUND", round, NULL, NULL,
 					  dt->round->value.character.string,
-					  io_kind_name (k), warn))
-	    return MATCH_ERROR;
+					  io_kind_name (k), warn,
+					  &dt->round->where))
+	    return false;
 	}
     }
-  
+
   if (dt->sign)
     {
       /* When implemented, change the following to use gfc_notify_std F2003.
-      if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
-	  "not allowed in Fortran 95") == false)
-	return MATCH_ERROR;  */
-
-      if (!is_char_type ("SIGN", dt->sign))
-	return MATCH_ERROR;
+      if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %L "
+	  "not allowed in Fortran 95", &dt->sign->where) == false)
+	return false;  */
 
       if (dt->sign->expr_type == EXPR_CONSTANT)
 	{
@@ -4103,8 +3993,8 @@ if (condition) \
 
 	  if (!compare_to_allowed_values ("SIGN", sign, NULL, NULL,
 				      dt->sign->value.character.string,
-				      io_kind_name (k), warn))
-	    return MATCH_ERROR;
+				      io_kind_name (k), warn, &dt->sign->where))
+	    return false;
 
 	  io_constraint (unformatted,
 			 "SIGN= specifier at %L must be with an "
@@ -4118,12 +4008,9 @@ if (condition) \
 
   if (dt->delim)
     {
-      if (!gfc_notify_std (GFC_STD_F2003, "DELIM= at %C "
-			   "not allowed in Fortran 95"))
-	return MATCH_ERROR;
-
-      if (!is_char_type ("DELIM", dt->delim))
-	return MATCH_ERROR;
+      if (!gfc_notify_std (GFC_STD_F2003, "DELIM= at %L "
+			   "not allowed in Fortran 95", &dt->delim->where))
+	return false;
 
       if (dt->delim->expr_type == EXPR_CONSTANT)
 	{
@@ -4131,13 +4018,14 @@ if (condition) \
 
 	  if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
 					  dt->delim->value.character.string,
-					  io_kind_name (k), warn))
-	    return MATCH_ERROR;
+					  io_kind_name (k), warn,
+					  &dt->delim->where))
+	    return false;
 
 	  io_constraint (k == M_READ,
 			 "DELIM= specifier at %L not allowed in a "
 			 "READ statement", &dt->delim->where);
-      
+
 	  io_constraint (dt->format_label != &format_asterisk
 			 && dt->namelist == NULL,
 			 "DELIM= specifier at %L must have FMT=*",
@@ -4148,7 +4036,7 @@ if (condition) \
 			 "NML= specifier", &dt->delim->where);
 	}
     }
-  
+
   if (dt->namelist)
     {
       io_constraint (io_code && dt->namelist,
@@ -4225,17 +4113,41 @@ if (condition) \
 
       io_constraint (dt->eor && not_no && k == M_READ,
 		     "EOR tag at %L requires an ADVANCE = %<NO%>",
-		     &dt->eor_where);      
+		     &dt->eor_where);
     }
 
-  expr = dt->format_expr;
-  if (!gfc_simplify_expr (expr, 0)
-      || !check_format_string (expr, k == M_READ))
-    return MATCH_ERROR;
+  if (k != M_READ)
+    {
+      io_constraint (dt->end, "END tag not allowed with output at %L",
+		     &dt->end_where);
 
-  return m;
-}
+      io_constraint (dt->eor, "EOR tag not allowed with output at %L",
+		     &dt->eor_where);
+
+      io_constraint (dt->blank,
+		     "BLANK= specifier not allowed with output at %L",
+		     &dt->blank->where);
+
+      io_constraint (dt->pad, "PAD= specifier not allowed with output at %L",
+		     &dt->pad->where);
+
+      io_constraint (dt->size, "SIZE= specifier not allowed with output at %L",
+		     &dt->size->where);
+    }
+  else
+    {
+      io_constraint (dt->size && dt->advance == NULL,
+		     "SIZE tag at %L requires an ADVANCE tag",
+		     &dt->size->where);
+
+      io_constraint (dt->eor && dt->advance == NULL,
+		     "EOR tag at %L requires an ADVANCE tag",
+		     &dt->eor_where);
+    }
+
+  return true;
 #undef io_constraint
+}
 
 
 /* Match a READ, WRITE or PRINT statement.  */
@@ -4248,7 +4160,7 @@ match_io (io_kind k)
   gfc_symbol *sym;
   int comma_flag;
   locus where;
-  locus spec_end, control;
+  locus control;
   gfc_dt *dt;
   match m;
 
@@ -4451,9 +4363,6 @@ loop:
 
 get_io_list:
 
-  /* Used in check_io_constraints, where no locus is available.  */
-  spec_end = gfc_current_locus;
-
   /* Save the IO kind for later use.  */
   dt->dt_io_kind = gfc_get_iokind_expr (&gfc_current_locus, k);
 
@@ -4485,12 +4394,11 @@ get_io_list:
   if (flag_dec_format_defaults)
     dt->dec_ext = 1;
 
-  /* A full IO statement has been matched.  Check the constraints.  spec_end is
-     supplied for cases where no locus is supplied.  */
-  m = check_io_constraints (k, dt, io_code, &spec_end);
-
-  if (m == MATCH_ERROR)
-    goto cleanup;
+  /* Check the format string now.  */
+  if (dt->format_expr
+      && (!gfc_simplify_expr (dt->format_expr, 0)
+	  || !check_format_string (dt->format_expr, k == M_READ)))
+    return MATCH_ERROR;
 
   new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
   new_st.ext.dt = dt;
@@ -4610,8 +4518,6 @@ match_inquire_element (gfc_inquire *inquire)
   RETM m = match_etag (&tag_file, &inquire->file);
   RETM m = match_ltag (&tag_err, &inquire->err);
   RETM m = match_etag (&tag_iomsg, &inquire->iomsg);
-  if (m == MATCH_YES && !check_char_variable (inquire->iomsg))
-    return MATCH_ERROR;
   RETM m = match_out_tag (&tag_iostat, &inquire->iostat);
   RETM m = match_vtag (&tag_exist, &inquire->exist);
   RETM m = match_vtag (&tag_opened, &inquire->opened);
@@ -4633,8 +4539,6 @@ match_inquire_element (gfc_inquire *inquire)
   RETM m = match_vtag (&tag_write, &inquire->write);
   RETM m = match_vtag (&tag_readwrite, &inquire->readwrite);
   RETM m = match_vtag (&tag_s_async, &inquire->asynchronous);
-  if (m == MATCH_YES && !is_char_type ("ASYNCHRONOUS", inquire->asynchronous))
-    return MATCH_ERROR;
   RETM m = match_vtag (&tag_s_delim, &inquire->delim);
   RETM m = match_vtag (&tag_s_decimal, &inquire->decimal);
   RETM m = match_out_tag (&tag_size, &inquire->size);
@@ -4914,8 +4818,6 @@ match_wait_element (gfc_wait *wait)
   RETM m = match_ltag (&tag_end, &wait->end);
   RETM m = match_ltag (&tag_eor, &wait->eor);
   RETM m = match_etag (&tag_iomsg, &wait->iomsg);
-  if (m == MATCH_YES && !check_char_variable (wait->iomsg))
-    return MATCH_ERROR;
   RETM m = match_out_tag (&tag_iostat, &wait->iostat);
   RETM m = match_etag (&tag_id, &wait->id);
   RETM return MATCH_NO;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 97de6dd..ccd2a5e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9941,9 +9941,6 @@ resolve_transfer (gfc_code *code)
 		 "an assumed-size array", &code->loc);
       return;
     }
-
-  if (async_io_dt && exp->expr_type == EXPR_VARIABLE)
-    exp->symtree->n.sym->attr.asynchronous = 1;
 }
 
 
@@ -12003,14 +12000,14 @@ start:
 	  break;
 
 	case EXEC_OPEN:
-	  if (!gfc_resolve_open (code->ext.open))
+	  if (!gfc_resolve_open (code->ext.open, &code->loc))
 	    break;
 
 	  resolve_branch (code->ext.open->err, code);
 	  break;
 
 	case EXEC_CLOSE:
-	  if (!gfc_resolve_close (code->ext.close))
+	  if (!gfc_resolve_close (code->ext.close, &code->loc))
 	    break;
 
 	  resolve_branch (code->ext.close->err, code);
@@ -12052,7 +12049,7 @@ start:
 
 	case EXEC_READ:
 	case EXEC_WRITE:
-	  if (!gfc_resolve_dt (code->ext.dt, &code->loc))
+	  if (!gfc_resolve_dt (code, code->ext.dt, &code->loc))
 	    break;
 
 	  resolve_branch (code->ext.dt->err, code);
@@ -15009,11 +15006,6 @@ resolve_fl_namelist (gfc_symbol *sym)
 	}
     }
 
-  if (async_io_dt)
-    {
-      for (nl = sym->namelist; nl; nl = nl->next)
-	nl->sym->attr.asynchronous = 1;
-    }
   return true;
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8c44253..d8fa35a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,29 @@
+2020-04-09  Fritz Reese  <foreese@gcc.gnu.org>
+
+	PR fortran/87923
+	* gfortran.dg/f2003_io_8.f03: Fix expected error messages.
+	* gfortran.dg/io_constraints_8.f90: Likewise.
+	* gfortran.dg/iomsg_2.f90: Likewise.
+	* gfortran.dg/pr66725.f90: Likewise.
+	* gfortran.dg/pr88205.f90: Likewise.
+	* gfortran.dg/write_check4.f90: Likewise.
+	* gfortran.dg/asynchronous_5.f03: New test.
+	* gfortran.dg/io_constraints_15.f90: Likewise.
+	* gfortran.dg/io_constraints_16.f90: Likewise.
+	* gfortran.dg/io_constraints_17.f90: Likewise.
+	* gfortran.dg/io_constraints_18.f90: Likewise.
+	* gfortran.dg/io_tags_1.f90: Likewise.
+	* gfortran.dg/io_tags_10.f90: Likewise.
+	* gfortran.dg/io_tags_2.f90: Likewise.
+	* gfortran.dg/io_tags_3.f90: Likewise.
+	* gfortran.dg/io_tags_4.f90: Likewise.
+	* gfortran.dg/io_tags_5.f90: Likewise.
+	* gfortran.dg/io_tags_6.f90: Likewise.
+	* gfortran.dg/io_tags_7.f90: Likewise.
+	* gfortran.dg/io_tags_8.f90: Likewise.
+	* gfortran.dg/io_tags_9.f90: Likewise.
+	* gfortran.dg/write_check5.f90: Likewise.
+
 2020-04-09  Richard Sandiford  <richard.sandiford@arm.com>
 
 	* gcc.target/aarch64/sve/acle/general/attributes_1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/asynchronous_5.f03 b/gcc/testsuite/gfortran.dg/asynchronous_5.f03
new file mode 100644
index 0000000..fcd281d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asynchronous_5.f03
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Covers code introduced by the fix to PR fortran/87923.
+! The idea is that the variables in a namelist or I/O list used for
+! asynchronous I/O will be marked with the asynchronous attribute.
+!
+! At this time, "asynchronous" is treated as "volatile" (see trans-decl.c).
+! Thus, every variable referenced in an "asynchronous=yes" I/O list
+! should obtain the "volatile" specifier in its declaration.
+!
+
+type t
+  character(4) :: comp_async
+end type
+
+character(2) :: ccvar_async
+type(t) :: dvar_async
+integer :: ivar_async
+real :: rvar_async
+logical :: lvar_async
+type(t), dimension(2) :: darrvar_async
+integer :: ivar_noasync
+
+namelist /names/ ivar_async, rvar_async, lvar_async
+
+open(1, asynchronous="yes")
+write(1, asynchronous="yes") dvar_async, ccvar_async
+write(1, asynchronous="yes") dvar_async%comp_async, darrvar_async
+read(1, asynchronous="yes", nml=names)
+
+open(2, asynchronous="no")
+read(2, asynchronous="no") ivar_noasync
+
+end
+
+! { dg-final { scan-tree-dump-times "volatile.*?ccvar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "volatile.*?dvar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "volatile.*?ivar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "volatile.*?rvar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "volatile.*?lvar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-times "volatile.*?darrvar_async" 1 "original" } }
+! { dg-final { scan-tree-dump-not "volatile.*?ivar_noasync" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/f2003_io_8.f03 b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
index 4d2f002..5604e04 100644
--- a/gcc/testsuite/gfortran.dg/f2003_io_8.f03
+++ b/gcc/testsuite/gfortran.dg/f2003_io_8.f03
@@ -9,5 +9,5 @@ character(25) :: msg
 open(10, file='mydata_f2003_io_8', asynchronous="yes", blank="null")
 write(10,'(10f8.3)', asynchronous='no', decimal="comma", id=j) a ! { dg-error "must be with ASYNCHRONOUS=" }
 read(10,'(10f8.3)', id=j, decimal="comma", blank="zero") b ! { dg-error "must be with ASYNCHRONOUS=" }
-read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "must be an initialization expression" }
+read(10,'(10f8.3)', asynchronous=msg, decimal="comma", blank="zero") b ! { dg-error "does not reduce to a constant expression" }
 end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_15.f90 b/gcc/testsuite/gfortran.dg/io_constraints_15.f90
new file mode 100644
index 0000000..47a5bf6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_15.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/87923
+!
+program p
+   open (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   open (2, decimal=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   open (3, encoding=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   open (4, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   open (5, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_16.f90 b/gcc/testsuite/gfortran.dg/io_constraints_16.f90
new file mode 100644
index 0000000..dcbbbae
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_16.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/87923
+!
+program p
+   read (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   read (1, delim=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   read (1, pad=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   read (1, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   read (1, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_17.f90 b/gcc/testsuite/gfortran.dg/io_constraints_17.f90
new file mode 100644
index 0000000..5864351
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_17.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/87923
+!
+program p
+   write (1, blank=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   write (1, delim=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   write (1, pad=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   write (1, round=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   write (1, sign=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_18.f90 b/gcc/testsuite/gfortran.dg/io_constraints_18.f90
new file mode 100644
index 0000000..1694871
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_constraints_18.f90
@@ -0,0 +1,9 @@
+! { dg-options "-fdec" }
+! { dg-do compile }
+!
+! PR fortran/87923
+!
+program p
+   open (1, carriagecontrol=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+   open (2, share=char(1000,4)) ! { dg-error "must be a character string of default kind" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_8.f90 b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
index 216a41b..e3272e4 100644
--- a/gcc/testsuite/gfortran.dg/io_constraints_8.f90
+++ b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
@@ -14,7 +14,7 @@ integer :: i
 
 OPEN(99, access=4_'direct')     ! { dg-error "must be a character string of default kind" }
 OPEN(99, action=4_'read')       ! { dg-error "must be a character string of default kind" }
-OPEN(99, asynchronous=4_'no')   ! { dg-error "must be of default CHARACTER kind" }
+OPEN(99, asynchronous=4_'no')   ! { dg-error "must be a character string of default kind" }
 OPEN(99, blank=4_'null')        ! { dg-error "must be a character string of default kind" }
 OPEN(99, decimal=4_'comma')     ! { dg-error "must be a character string of default kind" }
 OPEN(99, delim=4_'quote')       ! { dg-error "must be a character string of default kind" }
diff --git a/gcc/testsuite/gfortran.dg/io_tags_1.f90 b/gcc/testsuite/gfortran.dg/io_tags_1.f90
new file mode 100644
index 0000000..2ada161
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_1.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+
+backspace (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg='') ! { dg-error "Non-variable expression" }
+backspace (1, iomsg='no') ! { dg-error "Non-variable expression" }
+backspace (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+backspace (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+backspace (1, iomsg=['no']) ! { dg-error "IOMSG tag at ... must be scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_10.f90 b/gcc/testsuite/gfortran.dg/io_tags_10.f90
new file mode 100644
index 0000000..377ac61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_10.f90
@@ -0,0 +1,103 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+write (1, blank='') ! { dg-error "BLANK specifier in WRITE statement at ... has invalid value" }
+
+write (1, asynchronous=1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=1e1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=1d1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=.false.) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous='') ! { dg-error "ASYNCHRONOUS specifier in WRITE statement at ... has invalid value" }
+write (1, asynchronous='no')
+write (1, asynchronous=null()) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=(1)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=(1., 0.)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=[1]) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+write (1, asynchronous=['']) ! { dg-error "ASYNCHRONOUS tag at ... must be scalar" }
+
+write (1, blank=1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=1e1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=1d1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=.false.) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank='no') ! { dg-error "BLANK specifier in WRITE statement at ... has invalid value" }
+write (1, blank=null()) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=(1)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=(1., 0.)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=[1]) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+write (1, blank=['']) ! { dg-error "BLANK tag at ... must be scalar" }
+
+write (1, delim=1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=1e1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=1d1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=.false.) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim='') ! { dg-error "DELIM specifier in WRITE statement at ... has invalid value" }
+write (1, delim='no') ! { dg-error "DELIM specifier in WRITE statement at ... has invalid value" }
+write (1, delim=null()) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=(1)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=(1., 0.)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=[1]) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+write (1, delim=['']) ! { dg-error "DELIM tag at ... must be scalar" }
+
+write (1, decimal=1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=1e1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=1d1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=.false.) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal='') ! { dg-error "DECIMAL specifier in WRITE statement at ... has invalid value" }
+write (1, decimal='no') ! { dg-error "DECIMAL specifier in WRITE statement at ... has invalid value" }
+write (1, decimal=null()) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=(1)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=(1., 0.)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=[1]) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+write (1, decimal=['']) ! { dg-error "DECIMAL tag at ... must be scalar" }
+
+write (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg='') ! { dg-error "Non-variable expression" }
+write (1, iomsg='no') ! { dg-error "Non-variable expression" }
+write (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+write (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+write (1, pad=1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=1e1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=1d1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=.false.) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad='') ! { dg-error "PAD specifier in WRITE statement at ... has invalid value" }
+write (1, pad='no') ! { dg-error "the PAD= specifier at ... must be with an explicit format expression" }
+write (1, pad=null()) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=(1)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=(1., 0.)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=[1]) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+write (1, pad=['']) ! { dg-error "PAD tag at ... must be scalar" }
+
+write (1, round=1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=1e1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=1d1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=.false.) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round='') ! { dg-error "ROUND specifier in WRITE statement at ... has invalid value" }
+write (1, round='no') ! { dg-error "ROUND specifier in WRITE statement at ... has invalid value" }
+write (1, round=null()) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=(1)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=(1., 0.)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=[1]) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+write (1, round=['']) ! { dg-error "ROUND tag at ... must be scalar" }
+
+write (1, sign=1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=1e1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=1d1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=.false.) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign='') ! { dg-error "SIGN specifier in WRITE statement at ... has invalid value" }
+write (1, sign='no') ! { dg-error "SIGN specifier in WRITE statement at ... has invalid value" }
+write (1, sign=null()) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=(1)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=(1., 0.)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=[1]) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+write (1, sign=['']) ! { dg-error "SIGN tag at ... must be scalar" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_2.f90 b/gcc/testsuite/gfortran.dg/io_tags_2.f90
new file mode 100644
index 0000000..3eb1137
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_2.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+close (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg='') ! { dg-error "Non-variable expression" }
+close (1, iomsg='no') ! { dg-error "Non-variable expression" }
+close (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+close (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+close (1, iomsg=['no']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+close (1, status=1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=1e1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=1d1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=.false.) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status='') ! { dg-error "STATUS specifier in CLOSE statement at ... has invalid value" }
+close (1, status='no') ! { dg-error "STATUS specifier in CLOSE statement at ... has invalid value" }
+close (1, status=null()) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=(1)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=(1., 0.)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=[1]) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+close (1, status=['']) ! { dg-error "STATUS tag at ... must be scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_3.f90 b/gcc/testsuite/gfortran.dg/io_tags_3.f90
new file mode 100644
index 0000000..198342b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_3.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+endfile (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg='') ! { dg-error "Non-variable expression" }
+endfile (1, iomsg='no') ! { dg-error "Non-variable expression" }
+endfile (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+endfile (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_4.f90 b/gcc/testsuite/gfortran.dg/io_tags_4.f90
new file mode 100644
index 0000000..9396ef4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+flush (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg='') ! { dg-error "Non-variable expression" }
+flush (1, iomsg='no') ! { dg-error "Non-variable expression" }
+flush (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+flush (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_5.f90 b/gcc/testsuite/gfortran.dg/io_tags_5.f90
new file mode 100644
index 0000000..a602661
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_5.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+inquire (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg='') ! { dg-error "Non-variable expression" }
+inquire (1, iomsg='no') ! { dg-error "Non-variable expression" }
+inquire (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+inquire (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_6.f90 b/gcc/testsuite/gfortran.dg/io_tags_6.f90
new file mode 100644
index 0000000..a8cc383
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_6.f90
@@ -0,0 +1,175 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+open (1, access=1) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=1e1) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=1d1) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=.false.) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access='') ! { dg-error "ACCESS specifier in OPEN statement at ... has invalid value" }
+open (1, access='no') ! { dg-error "ACCESS specifier in OPEN statement at ... has invalid value" }
+open (1, access=null()) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=(1)) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=(1., 0.)) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=[1]) ! { dg-error "ACCESS tag at ... must be of type CHARACTER" }
+open (1, access=['']) ! { dg-error "ACCESS tag at ... must be scalar" }
+
+open (1, action=1) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=1e1) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=1d1) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=.false.) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action='') ! { dg-error "ACTION specifier in OPEN statement at ... has invalid value" }
+open (1, action='no') ! { dg-error "ACTION specifier in OPEN statement at ... has invalid value" }
+open (1, action=null()) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=(1)) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=(1., 0.)) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=[1]) ! { dg-error "ACTION tag at ... must be of type CHARACTER" }
+open (1, action=['']) ! { dg-error "ACTION tag at ... must be scalar" }
+
+open (1, asynchronous=1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=1e1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=1d1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=.false.) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous='') ! { dg-error "ASYNCHRONOUS specifier in OPEN statement at ... has invalid value" }
+open (1, asynchronous='no')
+open (1, asynchronous=null()) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=(1)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=(1., 0.)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=[1]) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+open (1, asynchronous=['']) ! { dg-error "ASYNCHRONOUS tag at ... must be scalar" }
+
+open (1, blank=1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=1e1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=1d1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=.false.) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank='') ! { dg-error "BLANK specifier in OPEN statement at ... has invalid value" }
+open (1, blank='no') ! { dg-error "BLANK specifier in OPEN statement at ... has invalid value" }
+open (1, blank=null()) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=(1)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=(1., 0.)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=[1]) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+open (1, blank=['']) ! { dg-error "BLANK tag at ... must be scalar" }
+
+open (1, delim=1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=1e1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=1d1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=.false.) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim='') ! { dg-error "DELIM specifier in OPEN statement at ... has invalid value" }
+open (1, delim='no') ! { dg-error "DELIM specifier in OPEN statement at ... has invalid value" }
+open (1, delim=null()) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=(1)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=(1., 0.)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=[1]) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+open (1, delim=['']) ! { dg-error "DELIM tag at ... must be scalar" }
+
+open (1, decimal=1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=1e1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=1d1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=.false.) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal='') ! { dg-error "DECIMAL specifier in OPEN statement at ... has invalid value" }
+open (1, decimal='no') ! { dg-error "DECIMAL specifier in OPEN statement at ... has invalid value" }
+open (1, decimal=null()) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=(1)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=(1., 0.)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=[1]) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+open (1, decimal=['']) ! { dg-error "DECIMAL tag at ... must be scalar" }
+
+open (1, encoding=1) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=1e1) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=1d1) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=.false.) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding='') ! { dg-error "ENCODING specifier in OPEN statement at ... has invalid value" }
+open (1, encoding='no') ! { dg-error "ENCODING specifier in OPEN statement at ... has invalid value" }
+open (1, encoding=null()) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=(1)) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=(1., 0.)) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=[1]) ! { dg-error "ENCODING tag at ... must be of type CHARACTER" }
+open (1, encoding=['']) ! { dg-error "ENCODING tag at ... must be scalar" }
+
+open (1, form=1) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=1e1) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=1d1) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=.false.) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form='') ! { dg-error "FORM specifier in OPEN statement at ... has invalid value" }
+open (1, form='no') ! { dg-error "FORM specifier in OPEN statement at ... has invalid value" }
+open (1, form=null()) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=(1)) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=(1., 0.)) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=[1]) ! { dg-error "FORM tag at ... must be of type CHARACTER" }
+open (1, form=['']) ! { dg-error "FORM tag at ... must be scalar" }
+
+open (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg='') ! { dg-error "Non-variable expression" }
+open (1, iomsg='no') ! { dg-error "Non-variable expression" }
+open (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+open (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+open (1, pad=1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=1e1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=1d1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=.false.) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad='') ! { dg-error "PAD specifier in OPEN statement at ... has invalid value" }
+open (1, pad='no')
+open (1, pad=null()) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=(1)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=(1., 0.)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=[1]) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+open (1, pad=['']) ! { dg-error "PAD tag at ... must be scalar" }
+
+open (1, position=1) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=1e1) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=1d1) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=.false.) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position='') ! { dg-error "POSITION specifier in OPEN statement at ... has invalid value" }
+open (1, position='no') ! { dg-error "POSITION specifier in OPEN statement at ... has invalid value" }
+open (1, position=null()) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=(1)) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=(1., 0.)) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=[1]) ! { dg-error "POSITION tag at ... must be of type CHARACTER" }
+open (1, position=['']) ! { dg-error "POSITION tag at ... must be scalar" }
+
+open (1, round=1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=1e1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=1d1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=.false.) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round='') ! { dg-error "ROUND specifier in OPEN statement at ... has invalid value" }
+open (1, round='no') ! { dg-error "ROUND specifier in OPEN statement at ... has invalid value" }
+open (1, round=null()) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=(1)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=(1., 0.)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=[1]) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+open (1, round=['']) ! { dg-error "ROUND tag at ... must be scalar" }
+
+open (1, sign=1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=1e1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=1d1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=.false.) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign='') ! { dg-error "SIGN specifier in OPEN statement at ... has invalid value" }
+open (1, sign='no') ! { dg-error "SIGN specifier in OPEN statement at ... has invalid value" }
+open (1, sign=null()) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=(1)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=(1., 0.)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=[1]) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+open (1, sign=['']) ! { dg-error "SIGN tag at ... must be scalar" }
+
+open (1, status=1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=1e1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=1d1) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=.false.) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status='') ! { dg-error "STATUS specifier in OPEN statement at ... has invalid value" }
+open (1, status='no') ! { dg-error "STATUS specifier in OPEN statement at ... has invalid value" }
+open (1, status=null()) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=(1)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=(1., 0.)) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=[1]) ! { dg-error "STATUS tag at ... must be of type CHARACTER" }
+open (1, status=['']) ! { dg-error "STATUS tag at ... must be scalar" }
+
+
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_7.f90 b/gcc/testsuite/gfortran.dg/io_tags_7.f90
new file mode 100644
index 0000000..12e3189
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_7.f90
@@ -0,0 +1,103 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+read (1, asynchronous=1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=1e1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=1d1) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=.false.) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous='') ! { dg-error "ASYNCHRONOUS specifier in READ statement at ... has invalid value" }
+read (1, asynchronous='no')
+read (1, asynchronous=null()) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=(1)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=(1., 0.)) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=[1]) ! { dg-error "ASYNCHRONOUS tag at ... must be of type CHARACTER" }
+read (1, asynchronous=['']) ! { dg-error "ASYNCHRONOUS tag at ... must be scalar" }
+
+read (1, blank=1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=1e1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=1d1) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=.false.) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank='') ! { dg-error "BLANK specifier in READ statement at ... has invalid value" }
+read (1, blank='no') ! { dg-error "BLANK specifier in READ statement at ... has invalid value" }
+read (1, blank=null()) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=(1)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=(1., 0.)) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=[1]) ! { dg-error "BLANK tag at ... must be of type CHARACTER" }
+read (1, blank=['']) ! { dg-error "BLANK tag at ... must be scalar" }
+
+read (1, delim=1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=1e1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=1d1) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=.false.) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim='') ! { dg-error "DELIM specifier in READ statement at ... has invalid value" }
+read (1, delim='no') ! { dg-error "DELIM specifier in READ statement at ... has invalid value" }
+read (1, delim=null()) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=(1)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=(1., 0.)) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=[1]) ! { dg-error "DELIM tag at ... must be of type CHARACTER" }
+read (1, delim=['']) ! { dg-error "DELIM tag at ... must be scalar" }
+
+read (1, decimal=1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=1e1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=1d1) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=.false.) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal='') ! { dg-error "DECIMAL specifier in READ statement at ... has invalid value" }
+read (1, decimal='no') ! { dg-error "DECIMAL specifier in READ statement at ... has invalid value" }
+read (1, decimal=null()) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=(1)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=(1., 0.)) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=[1]) ! { dg-error "DECIMAL tag at ... must be of type CHARACTER" }
+read (1, decimal=['']) ! { dg-error "DECIMAL tag at ... must be scalar" }
+
+read (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg='') ! { dg-error "Non-variable expression" }
+read (1, iomsg='no') ! { dg-error "Non-variable expression" }
+read (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+read (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+read (1, pad=1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=1e1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=1d1) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=.false.) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad='') ! { dg-error "PAD specifier in READ statement at ... has invalid value" }
+read (1, pad='no') ! { dg-error "the PAD= specifier at ... must be with an explicit format expression" }
+read (1, pad=null()) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=(1)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=(1., 0.)) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=[1]) ! { dg-error "PAD tag at ... must be of type CHARACTER" }
+read (1, pad=['']) ! { dg-error "PAD tag at ... must be scalar" }
+
+read (1, round=1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=1e1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=1d1) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=.false.) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round='') ! { dg-error "ROUND specifier in READ statement at ... has invalid value" }
+read (1, round='no') ! { dg-error "ROUND specifier in READ statement at ... has invalid value" }
+read (1, round=null()) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=(1)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=(1., 0.)) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=[1]) ! { dg-error "ROUND tag at ... must be of type CHARACTER" }
+read (1, round=['']) ! { dg-error "ROUND tag at ... must be scalar" }
+
+read (1, sign=1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=1e1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=1d1) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=.false.) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign='') ! { dg-error "SIGN specifier in READ statement at ... has invalid value" }
+read (1, sign='no') ! { dg-error "SIGN specifier in READ statement at ... has invalid value" }
+read (1, sign=null()) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=(1)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=(1., 0.)) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=[1]) ! { dg-error "SIGN tag at ... must be of type CHARACTER" }
+read (1, sign=['']) ! { dg-error "SIGN tag at ... must be scalar" }
+
+
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_8.f90 b/gcc/testsuite/gfortran.dg/io_tags_8.f90
new file mode 100644
index 0000000..f37210e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_8.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+rewind (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg='') ! { dg-error "Non-variable expression" }
+rewind (1, iomsg='no') ! { dg-error "Non-variable expression" }
+rewind (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+rewind (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/io_tags_9.f90 b/gcc/testsuite/gfortran.dg/io_tags_9.f90
new file mode 100644
index 0000000..55f9545
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/io_tags_9.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! Based on PR fortran/66724, also covers fortran/66725 and fortran/87923.
+!
+
+wait (1, iomsg=1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=1e1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=1d1) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=.false.) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg='') ! { dg-error "Non-variable expression" }
+wait (1, iomsg='no') ! { dg-error "Non-variable expression" }
+wait (1, iomsg=null()) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=(1)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=(1., 0.)) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=[1]) ! { dg-error "IOMSG tag at ... must be of type CHARACTER" }
+wait (1, iomsg=['']) ! { dg-error "IOMSG tag at ... must be scalar" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/iomsg_2.f90 b/gcc/testsuite/gfortran.dg/iomsg_2.f90
index 29500ed0..5023692 100644
--- a/gcc/testsuite/gfortran.dg/iomsg_2.f90
+++ b/gcc/testsuite/gfortran.dg/iomsg_2.f90
@@ -2,30 +2,30 @@
 subroutine foo1
    implicit none
    integer i
-   open(1, iomsg=666)      ! { dg-error "IOMSG must be" }
-   open(1, iomsg='sgk')    ! { dg-error "IOMSG must be" }
-   open(1, iomsg=i)        ! { dg-error "IOMSG must be" }
-   close(1, iomsg=666)     ! { dg-error "IOMSG must be" }
-   close(1, iomsg='sgk')   ! { dg-error "IOMSG must be" }
-   close(1, iomsg=i)       ! { dg-error "IOMSG must be" }
+   open(1, iomsg=666)      ! { dg-error "must be of type CHARACTER" }
+   open(1, iomsg='sgk')    ! { dg-error "Non-variable expression" }
+   open(1, iomsg=i)        ! { dg-error "must be of type CHARACTER" }
+   close(1, iomsg=666)     ! { dg-error "must be of type CHARACTER" }
+   close(1, iomsg='sgk')   ! { dg-error "Non-variable expression" }
+   close(1, iomsg=i)       ! { dg-error "must be of type CHARACTER" }
 end subroutine foo1
 
 subroutine foo
    implicit none
    integer i
    real :: x = 1
-   write(1, *, iomsg='sgk') x   ! { dg-error "IOMSG must be" }
-   write(1, *, iomsg=i)     x   ! { dg-error "IOMSG must be" }
-   read(1,  *, iomsg='sgk') x   ! { dg-error "IOMSG must be" }
-   read(1,  *, iomsg=i)     x   ! { dg-error "IOMSG must be" }
-   flush(1,    iomsg='sgk')     ! { dg-error "IOMSG must be" }
-   flush(1,    iomsg=i)         ! { dg-error "IOMSG must be" }
-   rewind(1,   iomsg='sgk')     ! { dg-error "IOMSG must be" }
-   rewind(1,   iomsg=i)         ! { dg-error "IOMSG must be" }
-   backspace(1,iomsg='sgk')     ! { dg-error "IOMSG must be" }
-   backspace(1,iomsg=i)         ! { dg-error "IOMSG must be" }
-   wait(1,     iomsg='sgk')     ! { dg-error "IOMSG must be" }
-   wait(1,     iomsg=i)         ! { dg-error "IOMSG must be" }
+   write(1, *, iomsg='sgk') x   ! { dg-error "Non-variable expression" }
+   write(1, *, iomsg=i)     x   ! { dg-error "must be of type CHARACTER" }
+   read(1,  *, iomsg='sgk') x   ! { dg-error "Non-variable expression" }
+   read(1,  *, iomsg=i)     x   ! { dg-error "must be of type CHARACTER" }
+   flush(1,    iomsg='sgk')     ! { dg-error "Non-variable expression" }
+   flush(1,    iomsg=i)         ! { dg-error "must be of type CHARACTER" }
+   rewind(1,   iomsg='sgk')     ! { dg-error "Non-variable expression" }
+   rewind(1,   iomsg=i)         ! { dg-error "must be of type CHARACTER" }
+   backspace(1,iomsg='sgk')     ! { dg-error "Non-variable expression" }
+   backspace(1,iomsg=i)         ! { dg-error "must be of type CHARACTER" }
+   wait(1,     iomsg='sgk')     ! { dg-error "Non-variable expression" }
+   wait(1,     iomsg=i)         ! { dg-error "must be of type CHARACTER" }
 end subroutine foo
 
 subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/pr66725.f90 b/gcc/testsuite/gfortran.dg/pr66725.f90
index 8ad97f7..d845646 100644
--- a/gcc/testsuite/gfortran.dg/pr66725.f90
+++ b/gcc/testsuite/gfortran.dg/pr66725.f90
@@ -3,29 +3,29 @@
 !
 program foo
 
-   open(unit=1,access = 999)        ! { dg-error "ACCESS requires" }
-   open(unit=1,action = 999)        ! { dg-error "ACTION requires" }
-   open(unit=1,asynchronous = 999)  ! { dg-error "ASYNCHRONOUS requires" }
-   open(unit=1,blank = 999)         ! { dg-error "BLANK requires" }
-   open(unit=1,decimal = 999)       ! { dg-error "DECIMAL requires" }
-   open(unit=1,delim = 999)         ! { dg-error "DELIM requires" }
-   open(unit=1,encoding = 999)      ! { dg-error "ENCODING requires" }
-   open(unit=1,form = 999)          ! { dg-error "FORM requires" }
-   open(unit=1,pad = 999)           ! { dg-error "PAD requires" }
-   open(unit=1,position = 999)      ! { dg-error "POSITION requires" }
-   open(unit=1,round = 999)         ! { dg-error "ROUND requires" }
-   open(unit=1,sign = 999)          ! { dg-error "SIGN requires" }
-   open(unit=1,status = 999)        ! { dg-error "STATUS requires" }
+   open(unit=1,access = 999)        ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,action = 999)        ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,asynchronous = 999)  ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,blank = 999)         ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,decimal = 999)       ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,delim = 999)         ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,encoding = 999)      ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,form = 999)          ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,pad = 999)           ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,position = 999)      ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,round = 999)         ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,sign = 999)          ! { dg-error "must be of type CHARACTER" }
+   open(unit=1,status = 999)        ! { dg-error "must be of type CHARACTER" }
 
-   close(unit=1, status=999)        ! { dg-error "STATUS requires" }
+   close(unit=1, status=999)        ! { dg-error "must be of type CHARACTER" }
 
-   write (unit=1, asynchronous=257) ! { dg-error "ASYNCHRONOUS requires" }
-   write (unit=1, delim=257)        ! { dg-error "DELIM requires" }
-   write (unit=1, decimal=257)      ! { dg-error "DECIMAL requires" }
-   write (unit=1, round=257)        ! { dg-error "ROUND requires" }
-   write (unit=1, sign=257)         ! { dg-error "SIGN requires" }
+   write (unit=1, asynchronous=257) ! { dg-error "must be of type CHARACTER" }
+   write (unit=1, delim=257)        ! { dg-error "must be of type CHARACTER" }
+   write (unit=1, decimal=257)      ! { dg-error "must be of type CHARACTER" }
+   write (unit=1, round=257)        ! { dg-error "must be of type CHARACTER" }
+   write (unit=1, sign=257)         ! { dg-error "must be of type CHARACTER" }
 
-   write (unit=1, blank=257)        ! { dg-error "BLANK requires" }
-   write (unit=1, pad=257)          ! { dg-error "PAD requires" }
+   write (unit=1, blank=257)        ! { dg-error "must be of type CHARACTER" }
+   write (unit=1, pad=257)          ! { dg-error "must be of type CHARACTER" }
 
 end program foo
diff --git a/gcc/testsuite/gfortran.dg/pr88205.f90 b/gcc/testsuite/gfortran.dg/pr88205.f90
index d9e0806..419bad3 100644
--- a/gcc/testsuite/gfortran.dg/pr88205.f90
+++ b/gcc/testsuite/gfortran.dg/pr88205.f90
@@ -2,13 +2,13 @@
 ! PR fortran/88205
 subroutine s1
    real, parameter :: status = 0
-   open (newunit=n, status=status)        ! { dg-error "STATUS requires" }
+   open (newunit=n, status=status)        ! { dg-error "must be of type CHARACTER" }
 end
 subroutine s2
    complex, parameter :: status = 0
-   open (newunit=n, status=status)        ! { dg-error "STATUS requires" }
+   open (newunit=n, status=status)        ! { dg-error "must be of type CHARACTER" }
 end
 program p
   logical, parameter :: status = .false.
-  open (newunit=a, status=status)         ! { dg-error "STATUS requires" }
+  open (newunit=a, status=status)         ! { dg-error "must be of type CHARACTER" }
 end
diff --git a/gcc/testsuite/gfortran.dg/write_check4.f90 b/gcc/testsuite/gfortran.dg/write_check4.f90
index f418ba8..107baca 100644
--- a/gcc/testsuite/gfortran.dg/write_check4.f90
+++ b/gcc/testsuite/gfortran.dg/write_check4.f90
@@ -11,7 +11,7 @@
   no = "no"
   open (unit=10, asynchronous = no)              ! Ok, it isn't a transfer stmt
   write(*,*, asynchronous="Y"//"E"//trim("S  ")) ! Ok, it is an init expr
-  write(*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" } 
+  write(*,*, asynchronous=no)  ! { dg-error "does not reduce to a constant expression" }
   read (*,*, asynchronous="Y"//"e"//trim("S  "))
-  read (*,*, asynchronous=no)  ! { dg-error "must be an initialization expression" }
+  read (*,*, asynchronous=no)  ! { dg-error "does not reduce to a constant expression" }
 end
diff --git a/gcc/testsuite/gfortran.dg/write_check5.f90 b/gcc/testsuite/gfortran.dg/write_check5.f90
new file mode 100644
index 0000000..296c51a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/write_check5.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! The asynchronous specifier for a data transfer statement shall be
+! an initialization expression
+!
+
+module write_check5
+contains
+
+function no()
+  implicit none
+  character(3) :: no
+  no = "yes"
+endfunction
+
+end module
+
+use write_check5
+implicit none
+
+open (unit=10, asynchronous=no())              ! Ok, it isn't a transfer stmt
+write(*,*, asynchronous=no())  ! { dg-error "must be an intrinsic function" }
+read (*,*, asynchronous=no())  ! { dg-error "must be an intrinsic function" }
+end