[multiple changes]
2015-07-04 Steven G. Kargl <kargl@gcc.gnu.org> 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 <kargl@gcc.gnu.org> PR fortran/66725 * gfortran.dg/pr66725.f90: New test. From-SVN: r225415
This commit is contained in:
parent
26232bbbda
commit
2e43164383
|
@ -1,3 +1,9 @@
|
||||||
|
2015-07-04 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||||
|
|
||||||
|
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 <dje.gcc@gmail.com>
|
2015-07-02 David Edelsohn <dje.gcc@gmail.com>
|
||||||
|
|
||||||
* trans-common.c: Include <map> after system.h.
|
* trans-common.c: Include <map> after system.h.
|
||||||
|
|
|
@ -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. */
|
/* Match an expression I/O tag of some sort. */
|
||||||
|
|
||||||
static match
|
static match
|
||||||
|
@ -1870,6 +1883,9 @@ gfc_match_open (void)
|
||||||
static const char *access_f2003[] = { "STREAM", NULL };
|
static const char *access_f2003[] = { "STREAM", NULL };
|
||||||
static const char *access_gnu[] = { "APPEND", 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,
|
if (!compare_to_allowed_values ("ACCESS", access_f95, access_f2003,
|
||||||
access_gnu,
|
access_gnu,
|
||||||
open->access->value.character.string,
|
open->access->value.character.string,
|
||||||
|
@ -1882,6 +1898,9 @@ gfc_match_open (void)
|
||||||
{
|
{
|
||||||
static const char *action[] = { "READ", "WRITE", "READWRITE", NULL };
|
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,
|
if (!compare_to_allowed_values ("ACTION", action, NULL, NULL,
|
||||||
open->action->value.character.string,
|
open->action->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -1895,6 +1914,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("ASYNCHRONOUS", open->asynchronous))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->asynchronous->expr_type == EXPR_CONSTANT)
|
if (open->asynchronous->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * asynchronous[] = { "YES", "NO", NULL };
|
static const char * asynchronous[] = { "YES", "NO", NULL };
|
||||||
|
@ -1913,6 +1935,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("BLANK", open->blank))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->blank->expr_type == EXPR_CONSTANT)
|
if (open->blank->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char *blank[] = { "ZERO", "NULL", NULL };
|
static const char *blank[] = { "ZERO", "NULL", NULL };
|
||||||
|
@ -1931,6 +1956,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("DECIMAL", open->decimal))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->decimal->expr_type == EXPR_CONSTANT)
|
if (open->decimal->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * decimal[] = { "COMMA", "POINT", NULL };
|
static const char * decimal[] = { "COMMA", "POINT", NULL };
|
||||||
|
@ -1949,6 +1977,9 @@ gfc_match_open (void)
|
||||||
{
|
{
|
||||||
static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
|
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,
|
if (!compare_to_allowed_values ("DELIM", delim, NULL, NULL,
|
||||||
open->delim->value.character.string,
|
open->delim->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -1963,6 +1994,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("ENCODING", open->encoding))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->encoding->expr_type == EXPR_CONSTANT)
|
if (open->encoding->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * encoding[] = { "DEFAULT", "UTF-8", NULL };
|
static const char * encoding[] = { "DEFAULT", "UTF-8", NULL };
|
||||||
|
@ -1979,6 +2013,9 @@ gfc_match_open (void)
|
||||||
{
|
{
|
||||||
static const char *form[] = { "FORMATTED", "UNFORMATTED", NULL };
|
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,
|
if (!compare_to_allowed_values ("FORM", form, NULL, NULL,
|
||||||
open->form->value.character.string,
|
open->form->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -1990,6 +2027,9 @@ gfc_match_open (void)
|
||||||
{
|
{
|
||||||
static const char *pad[] = { "YES", "NO", NULL };
|
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,
|
if (!compare_to_allowed_values ("PAD", pad, NULL, NULL,
|
||||||
open->pad->value.character.string,
|
open->pad->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -2001,6 +2041,9 @@ gfc_match_open (void)
|
||||||
{
|
{
|
||||||
static const char *position[] = { "ASIS", "REWIND", "APPEND", NULL };
|
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,
|
if (!compare_to_allowed_values ("POSITION", position, NULL, NULL,
|
||||||
open->position->value.character.string,
|
open->position->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -2014,6 +2057,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("ROUND", open->round))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->round->expr_type == EXPR_CONSTANT)
|
if (open->round->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
|
static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
|
||||||
|
@ -2034,6 +2080,9 @@ gfc_match_open (void)
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
goto cleanup;
|
goto cleanup;
|
||||||
|
|
||||||
|
if (!is_char_type ("SIGN", open->sign))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (open->sign->expr_type == EXPR_CONSTANT)
|
if (open->sign->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
|
static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
|
||||||
|
@ -2071,6 +2120,9 @@ gfc_match_open (void)
|
||||||
static const char *status[] = { "OLD", "NEW", "SCRATCH",
|
static const char *status[] = { "OLD", "NEW", "SCRATCH",
|
||||||
"REPLACE", "UNKNOWN", NULL };
|
"REPLACE", "UNKNOWN", NULL };
|
||||||
|
|
||||||
|
if (!is_char_type ("STATUS", open->status))
|
||||||
|
goto cleanup;
|
||||||
|
|
||||||
if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
|
if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
|
||||||
open->status->value.character.string,
|
open->status->value.character.string,
|
||||||
"OPEN", warn))
|
"OPEN", warn))
|
||||||
|
@ -2256,6 +2308,9 @@ gfc_match_close (void)
|
||||||
{
|
{
|
||||||
static const char *status[] = { "KEEP", "DELETE", NULL };
|
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,
|
if (!compare_to_allowed_values ("STATUS", status, NULL, NULL,
|
||||||
close->status->value.character.string,
|
close->status->value.character.string,
|
||||||
"CLOSE", warn))
|
"CLOSE", warn))
|
||||||
|
@ -2708,6 +2763,7 @@ match_dt_element (io_kind k, gfc_dt *dt)
|
||||||
m = match_out_tag (&tag_iomsg, &dt->iomsg);
|
m = match_out_tag (&tag_iomsg, &dt->iomsg);
|
||||||
if (m != MATCH_NO)
|
if (m != MATCH_NO)
|
||||||
return m;
|
return m;
|
||||||
|
|
||||||
m = match_out_tag (&tag_iostat, &dt->iostat);
|
m = match_out_tag (&tag_iostat, &dt->iostat);
|
||||||
if (m != MATCH_NO)
|
if (m != MATCH_NO)
|
||||||
return m;
|
return m;
|
||||||
|
@ -3305,6 +3361,9 @@ if (condition) \
|
||||||
return MATCH_ERROR;
|
return MATCH_ERROR;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
if (!is_char_type ("ASYNCHRONOUS", dt->asynchronous))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (!compare_to_allowed_values
|
if (!compare_to_allowed_values
|
||||||
("ASYNCHRONOUS", asynchronous, NULL, NULL,
|
("ASYNCHRONOUS", asynchronous, NULL, NULL,
|
||||||
dt->asynchronous->value.character.string,
|
dt->asynchronous->value.character.string,
|
||||||
|
@ -3334,6 +3393,9 @@ if (condition) \
|
||||||
{
|
{
|
||||||
static const char * decimal[] = { "COMMA", "POINT", NULL };
|
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,
|
if (!compare_to_allowed_values ("DECIMAL", decimal, NULL, NULL,
|
||||||
dt->decimal->value.character.string,
|
dt->decimal->value.character.string,
|
||||||
io_kind_name (k), warn))
|
io_kind_name (k), warn))
|
||||||
|
@ -3351,10 +3413,14 @@ if (condition) \
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
return MATCH_ERROR;
|
return MATCH_ERROR;
|
||||||
|
|
||||||
|
if (!is_char_type ("BLANK", dt->blank))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (dt->blank->expr_type == EXPR_CONSTANT)
|
if (dt->blank->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * blank[] = { "NULL", "ZERO", NULL };
|
static const char * blank[] = { "NULL", "ZERO", NULL };
|
||||||
|
|
||||||
|
|
||||||
if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
|
if (!compare_to_allowed_values ("BLANK", blank, NULL, NULL,
|
||||||
dt->blank->value.character.string,
|
dt->blank->value.character.string,
|
||||||
io_kind_name (k), warn))
|
io_kind_name (k), warn))
|
||||||
|
@ -3372,6 +3438,9 @@ if (condition) \
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
return MATCH_ERROR;
|
return MATCH_ERROR;
|
||||||
|
|
||||||
|
if (!is_char_type ("PAD", dt->pad))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (dt->pad->expr_type == EXPR_CONSTANT)
|
if (dt->pad->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * pad[] = { "YES", "NO", NULL };
|
static const char * pad[] = { "YES", "NO", NULL };
|
||||||
|
@ -3393,6 +3462,9 @@ if (condition) \
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
return MATCH_ERROR;
|
return MATCH_ERROR;
|
||||||
|
|
||||||
|
if (!is_char_type ("ROUND", dt->round))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (dt->round->expr_type == EXPR_CONSTANT)
|
if (dt->round->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
|
static const char * round[] = { "UP", "DOWN", "ZERO", "NEAREST",
|
||||||
|
@ -3412,6 +3484,10 @@ if (condition) \
|
||||||
if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
|
if (gfc_notify_std (GFC_STD_F2003, "SIGN= at %C "
|
||||||
"not allowed in Fortran 95") == false)
|
"not allowed in Fortran 95") == false)
|
||||||
return MATCH_ERROR; */
|
return MATCH_ERROR; */
|
||||||
|
|
||||||
|
if (!is_char_type ("SIGN", dt->sign))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (dt->sign->expr_type == EXPR_CONSTANT)
|
if (dt->sign->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
|
static const char * sign[] = { "PLUS", "SUPPRESS", "PROCESSOR_DEFINED",
|
||||||
|
@ -3438,6 +3514,9 @@ if (condition) \
|
||||||
"not allowed in Fortran 95"))
|
"not allowed in Fortran 95"))
|
||||||
return MATCH_ERROR;
|
return MATCH_ERROR;
|
||||||
|
|
||||||
|
if (!is_char_type ("DELIM", dt->delim))
|
||||||
|
return MATCH_ERROR;
|
||||||
|
|
||||||
if (dt->delim->expr_type == EXPR_CONSTANT)
|
if (dt->delim->expr_type == EXPR_CONSTANT)
|
||||||
{
|
{
|
||||||
static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
|
static const char *delim[] = { "APOSTROPHE", "QUOTE", "NONE", NULL };
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
2015-07-04 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/66725
|
||||||
|
* gfortran.dg/pr66725.f90: New test.
|
||||||
|
|
||||||
2015-07-03 Jason Merrill <jason@redhat.com>
|
2015-07-03 Jason Merrill <jason@redhat.com>
|
||||||
|
|
||||||
* gcc.dg/plugin/wide-int_plugin.c (test_double_int_round_udiv):
|
* gcc.dg/plugin/wide-int_plugin.c (test_double_int_round_udiv):
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue