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

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

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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@266968 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbb8ce18d0e836144b4e78f561cc4fa052f36d15..f5e397946e1786f6464a7dd0ddbe6d1bc89c089f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2018-12-10  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/97922
+       * io.c (gfc_match_open): Additional checks on ASYNCHRONOUS.
+
 2018-12-10  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/88269

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 8d5410721ef3fea3ddbaa6204e2763185a031a56..8415df1c68eba59b79d7096f5d02f11e557d6e79 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -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 };
@@ -3799,6 +3814,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,
                 dt->asynchronous->value.character.string,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 414ecd3c74f60582515b2f86ff4fc4a908a775b3..43675b9adb04679f9ff3c44d8d27758be8fe09d0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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  Martin Sebor  <msebor@redhat.com>
 
        PR tree-optimization/86196

diff --git a/gcc/testsuite/gfortran.dg/io_constraints_8.f90 b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
index 81cece430ed594601e1521150cbe6d91792db18e..216a41b758b771439c3e6f6cd50a722a7593561e 100644 (file)
--- 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 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 (file)
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