It seems that when the matching of various specifiers in
OPEN, CLOSE, and WRITE were written with much confidence
that user would not do something stupid.
The attached patch fixes multiple ICEs. Regression tested
on i386-*-freebsd. OK to commit?
PS: There are other ICEs caused be ill-formed specifiers.
This patch does not address those.
2015-07-03 Steven G. Kargl <ka...@gcc.gnu.org>
* 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 <ka...@gcc.gnu.org>
* gfortran.dg/pr66725.f90: New test.
--
Steve
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 225367)
+++ gcc/fortran/io.c (working copy)
@@ -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 };
Index: gcc/testsuite/gfortran.dg/pr66725.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr66725.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pr66725.f90 (working copy)
@@ -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
