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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-8-branch@266969 138bc75d-0d04-0410-961f-82ee72b054a4
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2f707ce..01728ed 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,10 @@
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/88269
* io.c (io_constraint): Update macro. If locus line buffer is NULL,
use gfc_current_locus in error messages.
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 8d54107..8415df1 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2205,6 +2205,21 @@
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 };
@@ -3799,6 +3814,21 @@
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,
dt->asynchronous->value.character.string,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5cbaa82..e4c9d4a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,11 @@
2018-12-10 Steven G. Kargl <kargl@gcc.gnu.org>
+ PR fortran/97922
+ * gfortran.dg/io_constraints_8.f90: Update error message.
+ * gfortran.dg/pr87922.f90: New test.
+
+2018-12-10 Steven G. Kargl <kargl@gcc.gnu.org>
+
PR fortran/88269
* gfortran.dg/pr88269.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_8.f90 b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
index 81cece4..216a41b 100644
--- a/gcc/testsuite/gfortran.dg/io_constraints_8.f90
+++ b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
@@ -14,7 +14,7 @@
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" }
diff --git a/gcc/testsuite/gfortran.dg/pr87922.f90 b/gcc/testsuite/gfortran.dg/pr87922.f90
new file mode 100644
index 0000000..8bdc6bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr87922.f90
@@ -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
