diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bbb8ce18d0e8..f5e397946e17 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2018-12-10 Steven G. Kargl + + PR fortran/97922 + * io.c (gfc_match_open): Additional checks on ASYNCHRONOUS. + 2018-12-10 Steven G. Kargl PR fortran/88269 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 8d5410721ef3..8415df1c68eb 100644 --- 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 414ecd3c74f6..43675b9adb04 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-12-10 Steven G. Kargl + + PR fortran/97922 + * gfortran.dg/io_constraints_8.f90: Update error message. + * gfortran.dg/pr87922.f90: New test. + 2018-12-10 Martin Sebor 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 81cece430ed5..216a41b758b7 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 000000000000..8bdc6bc556b1 --- /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