Skip to content

R
riscv-gcc-1
Commit 2e431643 by Steven G. Kargl
Options

[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
parent 26232bbb
Showing with 122 additions and 1 deletions
gcc/fortran/ChangeLog
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>
* trans-common.c: Include <map> after system.h.
......
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 };
......
gcc/testsuite/ChangeLog
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>
* gcc.dg/plugin/wide-int_plugin.c (test_double_int_round_udiv):
......
gcc/testsuite/gfortran.dg/pr66725.f90 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment