From 75933b07b7a2b35b731e4f66e69eb800a824595e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 13 May 2011 20:16:37 +0200 Subject: re PR fortran/48972 (OPEN with Unicode file name) 2011-05-12 Tobias Burnus 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 PR fortran/48972 * gfortran.dg/io_constraints_8.f90: New. * gfortran.dg/io_constraints_9.f90: New. From-SVN: r173736 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/io.c | 16 +++++++++++++--- 2 files changed, 20 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6a6fba0..73a39d9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-05-13 Tobias Burnus + + 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 PR fortran/48972 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) -- cgit v1.1