[Committed] PR fortran/87922 -- Additional checks for ASYNCHRONOUS

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

I've committed the attached patch to trunk and branch-8.
ChangeLogs on trunk record wrong PR number.  I fix those
someday.

2018-12-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/87922
	* io.c (gfc_match_open): Additional checks on ASYNCHRONOUS.

2018-12-10  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/87922
	* gfortran.dg/io_constraints_8.f90: Update error message.
	* gfortran.dg/pr87922.f90: New test.

-- 
Steve

Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c	(revision 266959)
+++ gcc/fortran/io.c	(working copy)
@@ -2205,6 +2205,21 @@ gfc_match_open (void)
       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 (open->asynchronous->expr_type == EXPR_CONSTANT)
 	{
 	  static const char * asynchronous[] = { "YES", "NO", NULL };
@@ -3798,6 +3813,21 @@ if (condition) \
 
       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;
+	}
 
       if (!compare_to_allowed_values
 		("ASYNCHRONOUS", asynchronous, NULL, NULL,
Index: gcc/testsuite/gfortran.dg/io_constraints_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/io_constraints_8.f90	(revision 266958)
+++ gcc/testsuite/gfortran.dg/io_constraints_8.f90	(working copy)
@@ -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 a character string of default kind" })
+OPEN(99, asynchronous=4_'no')   ! { dg-error "must be of default CHARACTER 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" }
Index: gcc/testsuite/gfortran.dg/pr87922.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr87922.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr87922.f90	(working copy)
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/87922
+subroutine p
+   read(1, asynchronous=['no'])           ! { dg-error "must be scalar" }
+   read(1, asynchronous=[character::])    ! { dg-error "must be scalar" }
+end
+subroutine q
+   write(1, asynchronous=['no'])          ! { dg-error "must be scalar" }
+   write(1, asynchronous=[character::])   ! { dg-error "must be scalar" }
+end