From: Jerry DeLisle Date: Sun, 23 Apr 2017 15:49:16 +0000 (+0000) Subject: re PR fortran/80484 (Three syntax errors involving derived-type I/O) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c7eb642efa06145c84fc368284839fe6aa4b4650;p=gcc.git re PR fortran/80484 (Three syntax errors involving derived-type I/O) 2017-04-23 Jerry DeLisle PR fortran/80484 * io.c (format_lex): Check for '/' and set token to FMT_SLASH. (check_format): Move FMT_DT checking code to data_desc section. * module.c (gfc_match_use): Include the case of INTERFACE_DTIO. PR fortran/80484 * gfortran.dg/dtio_29.f03: New test. From-SVN: r247084 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b186bfd65aa..c5ed5071b09 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-04-23 Jerry DeLisle + + PR fortran/80484 + * io.c (format_lex): Check for '/' and set token to FMT_SLASH. + (check_format): Move FMT_DT checking code to data_desc section. + * module.c (gfc_match_use): Include the case of INTERFACE_DTIO. + 2017-04-22 Janus Weil PR fortran/80121 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 60df44dc695..7ab897daa44 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -491,6 +491,11 @@ format_lex (void) token = FMT_END; break; } + if (c == '/') + { + token = FMT_SLASH; + break; + } if (c == delim) continue; unget_char (); @@ -498,6 +503,11 @@ format_lex (void) } } } + else if (c == '/') + { + token = FMT_SLASH; + break; + } else unget_char (); } @@ -687,54 +697,6 @@ format_item_1: return false; goto between_desc; - case FMT_DT: - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - switch (t) - { - case FMT_RPAREN: - level--; - if (level < 0) - goto finished; - goto between_desc; - - case FMT_COMMA: - goto format_item; - - case FMT_LPAREN: - - dtio_vlist: - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - - if (t != FMT_POSINT) - { - error = posint_required; - goto syntax; - } - - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - - if (t == FMT_COMMA) - goto dtio_vlist; - if (t != FMT_RPAREN) - { - error = _("Right parenthesis expected at %C"); - goto syntax; - } - goto between_desc; - - default: - error = unexpected_element; - goto syntax; - } - - goto format_item; - case FMT_SIGN: case FMT_BLANK: case FMT_DP: @@ -783,6 +745,7 @@ format_item_1: case FMT_A: case FMT_D: case FMT_H: + case FMT_DT: goto data_desc; case FMT_END: @@ -1004,6 +967,53 @@ data_desc: break; + case FMT_DT: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + switch (t) + { + case FMT_RPAREN: + level--; + if (level < 0) + goto finished; + goto between_desc; + + case FMT_COMMA: + goto format_item; + + case FMT_LPAREN: + + dtio_vlist: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t != FMT_POSINT) + { + error = posint_required; + goto syntax; + } + + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t == FMT_COMMA) + goto dtio_vlist; + if (t != FMT_RPAREN) + { + error = _("Right parenthesis expected at %C"); + goto syntax; + } + goto between_desc; + + default: + error = unexpected_element; + goto syntax; + } + break; + case FMT_F: t = format_lex (); if (t == FMT_ERROR) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 4d6afa55d38..e8cba1455aa 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -631,6 +631,7 @@ gfc_match_use (void) case INTERFACE_USER_OP: case INTERFACE_GENERIC: + case INTERFACE_DTIO: m = gfc_match (" =>"); if (type == INTERFACE_USER_OP && m == MATCH_YES diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 27f5be805ec..e87a01adf3c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-04-23 Jerry DeLisle + + PR fortran/80484 + * gfortran.dg/dtio_29.f03: New test. + 2017-04-22 Janus Weil PR fortran/80121 diff --git a/gcc/testsuite/gfortran.dg/dtio_29.f03 b/gcc/testsuite/gfortran.dg/dtio_29.f03 new file mode 100644 index 00000000000..46961e4ccc4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_29.f03 @@ -0,0 +1,47 @@ +! { dg-do compile } +! PR80484 Three syntax errors involving derived-type I/O +module dt_write_mod + type, public :: B_type + real :: amount + end type B_type + interface write (formatted) + procedure :: Write_b + end interface +contains + +subroutine Write_b & + (amount, unit, b_edit_descriptor, v_list, iostat, iomsg) + + class (B_type), intent(in) :: amount + integer, intent(in) :: unit + character (len=*), intent(in) :: b_edit_descriptor + integer, dimension(:), intent(in) :: v_list + integer, intent(out) :: iostat + character (len=*), intent(inout) :: iomsg + write (unit=unit, fmt="(f9.3)", iostat=iostat) amount%amount + +end subroutine Write_b + +end module dt_write_mod + +program test + use dt_write_mod, only: B_type , write(formatted) + implicit none + + real :: wage = 15.10 + integer :: ios + character(len=99) :: iom = "OK" + + write (unit=*, fmt="(DT'$$$Z.##')", iostat=ios, iomsg=iom) & + B_type(wage), B_type(wage) + print *, trim(iom) + write (unit=*, fmt="(2DT'$$$Z.##')", iostat=ios, iomsg=iom) & + B_type(wage), B_type(wage) + print *, trim(iom) + write (unit=*, fmt="(3DT'$$$Z.##')", iostat=ios, iomsg=iom) & + B_type(wage), B_type(wage) + print *, trim(iom) + write (unit=*, fmt="(DT'$$$Z.##'/)", iostat=ios, iomsg=iom) & + B_type(wage), B_type(wage) + print *, trim(iom) +end program test