diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 106 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 1 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/dtio_29.f03 | 47 |
5 files changed, 118 insertions, 48 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b186bfd..c5ed507 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-04-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + 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 <janus@gcc.gnu.org> PR fortran/80121 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 60df44d..7ab897d 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 4d6afa5..e8cba14 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 27f5be8..e87a01a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-04-23 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/80484 + * gfortran.dg/dtio_29.f03: New test. + 2017-04-22 Janus Weil <janus@gcc.gnu.org> 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 0000000..46961e4 --- /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 |