diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-05-13 20:16:37 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-05-13 20:16:37 +0200 |
| commit | 75933b07b7a2b35b731e4f66e69eb800a824595e (patch) | |
| tree | 2e15441bbc737144da8857227539ad282963537b /gcc/fortran/io.c | |
| parent | 9f47a24e79fbd0b73f65444c8c39d783e36f3a28 (diff) | |
| download | gcc-75933b07b7a2b35b731e4f66e69eb800a824595e.zip gcc-75933b07b7a2b35b731e4f66e69eb800a824595e.tar.gz gcc-75933b07b7a2b35b731e4f66e69eb800a824595e.tar.bz2 | |
re PR fortran/48972 (OPEN with Unicode file name)
2011-05-12 Tobias Burnus <burnus@net-b.de>
PR fortran/48972
* io.c (resolve_tag_format, resolve_tag): Make sure
that the string is of default kind.
(gfc_resolve_inquire): Also resolve decimal tag.
2011-05-12 Tobias Burnus <burnus@net-b.de>
PR fortran/48972
* gfortran.dg/io_constraints_8.f90: New.
* gfortran.dg/io_constraints_9.f90: New.
From-SVN: r173736
Diffstat (limited to 'gcc/fortran/io.c')
| -rw-r--r-- | gcc/fortran/io.c | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index df9ee1e..c2d46af 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1394,10 +1394,12 @@ resolve_tag_format (const gfc_expr *e) || e->symtree->n.sym->as == NULL || e->symtree->n.sym->as->rank == 0)) { - if (e->ts.type != BT_CHARACTER && e->ts.type != BT_INTEGER) + if ((e->ts.type != BT_CHARACTER + || e->ts.kind != gfc_default_character_kind) + && e->ts.type != BT_INTEGER) { - gfc_error ("FORMAT tag at %L must be of type CHARACTER or INTEGER", - &e->where); + gfc_error ("FORMAT tag at %L must be of type default-kind CHARACTER " + "or of INTEGER", &e->where); return FAILURE; } else if (e->ts.type == BT_INTEGER && e->expr_type == EXPR_VARIABLE) @@ -1478,6 +1480,13 @@ resolve_tag (const io_tag *tag, gfc_expr *e) return FAILURE; } + if (e->ts.type == BT_CHARACTER && e->ts.kind != gfc_default_character_kind) + { + gfc_error ("%s tag at %L must be a character string of default kind", + tag->name, &e->where); + return FAILURE; + } + if (e->rank != 0) { gfc_error ("%s tag at %L must be scalar", tag->name, &e->where); @@ -4059,6 +4068,7 @@ gfc_resolve_inquire (gfc_inquire *inquire) INQUIRE_RESOLVE_TAG (&tag_s_round, inquire->round); INQUIRE_RESOLVE_TAG (&tag_pending, inquire->pending); INQUIRE_RESOLVE_TAG (&tag_size, inquire->size); + INQUIRE_RESOLVE_TAG (&tag_s_decimal, inquire->decimal); #undef INQUIRE_RESOLVE_TAG if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) |