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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 88e4d9236f3..f830e7cecc7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3468,18 +3468,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 59cd9cee3f0..d0310a63df1 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,15 @@  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 +3771,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 +3783,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 +3800,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 +3817,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 +3830,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 +3896,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 +3929,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 +3941,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 +3951,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 +3963,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 +3975,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 +3995,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 +4010,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 +4020,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 +4038,7 @@  if (condition) \
 			 "NML= specifier", &dt->delim->where);
 	}
     }
-  
+
   if (dt->namelist)
     {
       io_constraint (io_code && dt->namelist,
@@ -4225,17 +4115,40 @@  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 +4161,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 +4364,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 +4395,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 +4519,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 +4540,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 +4819,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 97de6ddce84..ccd2a5e3b7d 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/gfortran.dg/asynchronous_5.f03 b/gcc/testsuite/gfortran.dg/asynchronous_5.f03
new file mode 100644
index 00000000000..fcd281d5001
--- /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 4d2f002fd0e..5604e0413e2 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 00000000000..47a5bf6923f
--- /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 00000000000..dcbbbae17c0
--- /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 00000000000..5864351debc
--- /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 00000000000..1694871c5f6
--- /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 216a41b758b..e3272e4a388 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 00000000000..2ada161310c
--- /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 00000000000..377ac616680
--- /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 00000000000..3eb11376fb4
--- /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 00000000000..198342b0672
--- /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 00000000000..9396ef443a0
--- /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 00000000000..a6026619dba
--- /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 00000000000..a8cc38300b6
--- /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 00000000000..12e3189ec10
--- /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 00000000000..f37210ef5cc
--- /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 00000000000..55f9545f51d
--- /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 29500ed01ae..5023692daef 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 8ad97f7e18d..d845646cf79 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 d9e08069109..419bad37156 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 f418ba8fbf0..107baca2c31 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 00000000000..296c51a1962
--- /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