From 2e431643836cae690344bd77d38772c5ac73dd00 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 4 Jul 2015 15:37:04 +0000 Subject: [PATCH] [multiple changes] 2015-07-04 Steven G. Kargl PR fortran/66725 * io.c (is_char_type): New function to test for BT_CHARACTER (gfc_match_open, gfc_match_close, match_dt_element): Use it. 2015-07-03 Steven G. Kargl PR fortran/66725 * gfortran.dg/pr66725.f90: New test. From-SVN: r225415 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/io.c | 81 ++++++++++++++++++++++++++++++++++- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/pr66725.f90 | 31 ++++++++++++++ 4 files changed, 122 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr66725.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index df7c869..981f742 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2015-07-04 Steven G. Kargl + + PR fortran/66725 + * io.c (is_char_type): New function to test for BT_CHARACTER + (gfc_match_open, gfc_match_close, match_dt_element): Use it. + 2015-07-02 David Edelsohn * trans-common.c: Include after system.h. diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 0ac4f4a..fe3edb9 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1242,6 +1242,19 @@ gfc_match_format (void) } +static bool +is_char_type (const char *name, gfc_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 @@ -1870,6 +1883,9 @@ 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, @@ -1882,6 +1898,9 @@ gfc_match_open (void) { 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, open->action->value.character.string, "OPEN", warn)) @@ -1895,6 +1914,9 @@ gfc_match_open (void) "not allowed in Fortran 95")) goto cleanup; + if (!is_char_type ("ASYNCHRONOUS", open->asynchronous)) + goto cleanup; + if (open->asynchronous->expr_type == EXPR_CONSTANT) { static const char * asynchronous[] = { "YES", "NO", NULL }; @@ -1913,6 +1935,9 @@ gfc_match_open (void) "not allowed in Fortran 95")) goto cleanup; + if (!is_char_type ("BLANK", open->blank)) + goto cleanup; + if (open->blank->expr_type == EXPR_CONSTANT) { static const char *blank[] = { "ZERO", "NULL", NULL }; @@ -1931,6 +1956,9 @@ gfc_match_open (void) "not allowed in Fortran 95")) goto cleanup; + if (!is_char_type ("DECIMAL", open->decimal)) + goto cleanup; + if (open->decimal->expr_type == EXPR_CONSTANT) { static const char * decimal[] = { "COMMA", "POINT", NULL }; @@ -1949,6 +1977,9 @@ 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)) @@ -1962,7 +1993,10 @@ gfc_match_open (void) 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 (open->encoding->expr_type == EXPR_CONSTANT) { static const char * encoding[] = { "DEFAULT", "UTF-8", NULL }; @@ -1979,6 +2013,9 @@ 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)) @@ -1990,6 +2027,9 @@ 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)) @@ -2001,6 +2041,9 @@ 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)) @@ -2014,6 +2057,9 @@ gfc_match_open (void) "not allowed in Fortran 95")) goto cleanup; + if (!is_char_type ("ROUND", open->round)) + goto cleanup; + if (open->round->expr_type == EXPR_CONSTANT) { static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST", @@ -2034,6 +2080,9 @@ gfc_match_open (void) "not allowed in Fortran 95")) goto cleanup; + if (!is_char_type ("SIGN", open->sign)) + goto cleanup; + if (open->sign->expr_type == EXPR_CONSTANT) { static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", @@ -2071,6 +2120,9 @@ 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)) @@ -2256,6 +2308,9 @@ gfc_match_close (void) { 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)) @@ -2708,6 +2763,7 @@ match_dt_element (io_kind k, gfc_dt *dt) m = match_out_tag (&tag_iomsg, &dt->iomsg); if (m != MATCH_NO) return m; + m = match_out_tag (&tag_iostat, &dt->iostat); if (m != MATCH_NO) return m; @@ -3305,6 +3361,9 @@ if (condition) \ return MATCH_ERROR; } + if (!is_char_type ("ASYNCHRONOUS", dt->asynchronous)) + return MATCH_ERROR; + if (!compare_to_allowed_values ("ASYNCHRONOUS", asynchronous, NULL, NULL, dt->asynchronous->value.character.string, @@ -3334,6 +3393,9 @@ if (condition) \ { 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)) @@ -3351,10 +3413,14 @@ if (condition) \ "not allowed in Fortran 95")) return MATCH_ERROR; + if (!is_char_type ("BLANK", dt->blank)) + return MATCH_ERROR; + if (dt->blank->expr_type == EXPR_CONSTANT) { static const char * blank[] = { "NULL", "ZERO", NULL }; + if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL, dt->blank->value.character.string, io_kind_name (k), warn)) @@ -3372,6 +3438,9 @@ if (condition) \ "not allowed in Fortran 95")) return MATCH_ERROR; + if (!is_char_type ("PAD", dt->pad)) + return MATCH_ERROR; + if (dt->pad->expr_type == EXPR_CONSTANT) { static const char * pad[] = { "YES", "NO", NULL }; @@ -3393,6 +3462,9 @@ if (condition) \ "not allowed in Fortran 95")) return MATCH_ERROR; + if (!is_char_type ("ROUND", dt->round)) + return MATCH_ERROR; + if (dt->round->expr_type == EXPR_CONSTANT) { static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST", @@ -3412,6 +3484,10 @@ if (condition) \ 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 (dt->sign->expr_type == EXPR_CONSTANT) { static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED", @@ -3438,6 +3514,9 @@ if (condition) \ "not allowed in Fortran 95")) return MATCH_ERROR; + if (!is_char_type ("DELIM", dt->delim)) + return MATCH_ERROR; + if (dt->delim->expr_type == EXPR_CONSTANT) { static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL }; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 598918e..2b29e1a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-07-04 Steven G. Kargl + + PR fortran/66725 + * gfortran.dg/pr66725.f90: New test. + 2015-07-03 Jason Merrill * gcc.dg/plugin/wide-int_plugin.c (test_double_int_round_udiv): diff --git a/gcc/testsuite/gfortran.dg/pr66725.f90 b/gcc/testsuite/gfortran.dg/pr66725.f90 new file mode 100644 index 0000000..8ad97f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr66725.f90 @@ -0,0 +1,31 @@ +! { dg-do compile } +! PR fortran/66725 +! +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" } + + close(unit=1, status=999) ! { dg-error "STATUS requires" } + + 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, blank=257) ! { dg-error "BLANK requires" } + write (unit=1, pad=257) ! { dg-error "PAD requires" } + +end program foo -- 2.7.4