From 75933b07b7a2b35b731e4f66e69eb800a824595e Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 13 May 2011 20:16:37 +0200 Subject: [PATCH] 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 ++++- gcc/testsuite/ChangeLog | 6 ++ .../gfortran.dg/io_constraints_8.f90 | 72 +++++++++++++++++++ .../gfortran.dg/io_constraints_9.f90 | 13 ++++ 5 files changed, 111 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/io_constraints_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/io_constraints_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6a6fba08240..73a39d91035 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 df9ee1e9793..c2d46afdd66 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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9340d919f58..8ef95d148e0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-05-13 Tobias Burnus + + PR fortran/48972 + * gfortran.dg/io_constraints_8.f90: New. + * gfortran.dg/io_constraints_9.f90: New. + 2011-05-13 Martin Thuresson PR gcov-profile/47793 diff --git a/gcc/testsuite/gfortran.dg/io_constraints_8.f90 b/gcc/testsuite/gfortran.dg/io_constraints_8.f90 new file mode 100644 index 00000000000..81cece430ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/io_constraints_8.f90 @@ -0,0 +1,72 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=100 -Wall" } +! +! PR fortran/48972 +! +! +! All string arguments to I/O statements shall +! be of default-character type. (Except for the +! internal unit.) +! + +character(len=30, kind=4) :: str1 +integer :: i + +OPEN(99, access=4_'direct') ! { dg-error "must be a character string of default kind" } +OPEN(99, action=4_'read') ! { dg-error "must be a character string of default kind" } +OPEN(99, asynchronous=4_'no') ! { dg-error "must be a character string of default kind" }) +OPEN(99, blank=4_'null') ! { dg-error "must be a character string of default kind" } +OPEN(99, decimal=4_'comma') ! { dg-error "must be a character string of default kind" } +OPEN(99, delim=4_'quote') ! { dg-error "must be a character string of default kind" } +OPEN(99, encoding=4_'default') ! { dg-error "must be a character string of default kind" } +OPEN(99, file=4_'Test.dat') ! { dg-error "must be a character string of default kind" } +OPEN(99, form=4_'formatted') ! { dg-error "must be a character string of default kind" } +OPEN(99, pad=4_'yes') ! { dg-error "must be a character string of default kind" } +OPEN(99, position=4_'asis') ! { dg-error "must be a character string of default kind" } +OPEN(99, round=4_'down') ! { dg-error "must be a character string of default kind" } +OPEN(99, sign=4_'plus') ! { dg-error "must be a character string of default kind" } +OPEN(99, status=4_'old') ! { dg-error "must be a character string of default kind" } +OPEN(99, IOSTAT=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } + +close(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } +close(99, status=4_'delete') ! { dg-error "must be a character string of default kind" } + +write(99, '(a)', advance=4_'no')! { dg-error "must be a character string of default kind" } +read (99, *, blank=4_'null') ! { dg-error "must be a character string of default kind" } +write(99, *, decimal=4_'comma') ! { dg-error "must be a character string of default kind" } +write(99, *, delim=4_'quote') ! { dg-error "must be a character string of default kind" } +read (99, *, pad=4_'yes') ! { dg-error "must be a character string of default kind" } +write(99, *, round=4_'down') ! { dg-error "must be a character string of default kind" } +write(99, *, sign=4_'plus') ! { dg-error "must be a character string of default kind" } + +wait(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } + +endfile (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } +backspace(99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } +rewind (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } +flush (99, iostat=i, iomsg=str1) ! { dg-error "must be a character string of default kind" } + +inquire (file=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,access=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,action=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,asynchronous=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,blank=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,decimal=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,delim=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,direct=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,encoding=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,form=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,formatted=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,iomsg=str1, iostat=i) ! { dg-error "must be a character string of default kind" } +inquire (99,name=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,pad=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,position=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,read=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,readwrite=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,round=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,sequential=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,sign=str1) ! { dg-error "must be a character string of default kind" } +!inquire (99,stream=str1) ! Fails due to PR 48976 +inquire (99,unformatted=str1) ! { dg-error "must be a character string of default kind" } +inquire (99,write=str1) ! { dg-error "must be a character string of default kind" } +end diff --git a/gcc/testsuite/gfortran.dg/io_constraints_9.f90 b/gcc/testsuite/gfortran.dg/io_constraints_9.f90 new file mode 100644 index 00000000000..9d8df88efc2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/io_constraints_9.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! +! PR fortran/48972 +! +! All string arguments to I/O statements shall +! be of default-character type. (Except for the +! internal unit.) +! +character(len=20, kind=4) :: str1 + +write(99, str1) 'a' ! { dg-error "must be of type default-kind CHARACTER" } +read(99, fmt=str1) ! { dg-error "must be of type default-kind CHARACTER" } +end -- 2.30.2