From 5cdc4b0ef0381439be6cebd6ba8925f69e4d51d6 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 16 Dec 2016 20:27:51 +0000 Subject: [PATCH] re PR fortran/78662 ([F03] Incorrect parsing of quotes in the char-literal-constant of the DT data descriptor) 2016-12-16 Jerry DeLisle PR fortran/78622 * io.c (format_lex): Continue of string delimiter seen. * io/transfer.c (get_dt_format): New static function to alloc and set the DT iotype string, handling doubled quotes. (formatted_transfer_scalar_read, formatted_transfer_scalar_write): Use new function. * gfortran.dg/dtio_20.f03: New test. From-SVN: r243765 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/io.c | 3 +- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/dtio_20.f03 | 31 ++++++++++++++++++ libgfortran/ChangeLog | 8 +++++ libgfortran/io/transfer.c | 47 ++++++++++++++++++--------- 6 files changed, 82 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dtio_20.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e4605048b17..fba0d985b0d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2016-12-16 Jerry DeLisle + + PR fortran/78622 + * io.c (format_lex): Continue of string delimiter seen. + 2016-12-16 Jakub Jelinek PR fortran/78757 diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index d35437aeb23..8f4f2680717 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -486,12 +486,13 @@ format_lex (void) if (c == delim) { c = next_char (NONSTRING); - if (c == '\0') { token = FMT_END; break; } + if (c == delim) + continue; unget_char (); break; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c0b849324d2..5cfda764ca4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-12-16 Jerry DeLisle + + PR fortran/78622 + * gfortran.dg/dtio_20.f03: New test. + 2016-12-16 Jakub Jelinek PR fortran/78757 diff --git a/gcc/testsuite/gfortran.dg/dtio_20.f03 b/gcc/testsuite/gfortran.dg/dtio_20.f03 new file mode 100644 index 00000000000..dce487256fa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dtio_20.f03 @@ -0,0 +1,31 @@ +MODULE m + IMPLICIT NONE + + TYPE :: t + CHARACTER :: c + CONTAINS + PROCEDURE :: write_formatted + GENERIC :: WRITE(FORMATTED) => write_formatted + END TYPE t +CONTAINS + SUBROUTINE write_formatted(dtv, unit, iotype, v_list, iostat, iomsg) + CLASS(t), INTENT(IN) :: dtv + INTEGER, INTENT(IN) :: unit + CHARACTER(*), INTENT(IN) :: iotype + INTEGER, INTENT(IN) :: v_list(:) + INTEGER, INTENT(OUT) :: iostat + CHARACTER(*), INTENT(INOUT) :: iomsg + + WRITE (unit, "(A)", IOSTAT=iostat, IOMSG=iomsg) iotype + END SUBROUTINE write_formatted +END MODULE m + +PROGRAM p + USE m + IMPLICIT NONE + CHARACTER(25) :: str + + TYPE(t) :: x + WRITE (str, "(DT'a''b')") x + if (str.ne."DTa'b") call abort +END PROGRAM p diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2d737449e6d..bcd8cd3e24f 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2016-12-16 Jerry DeLisle + + PR fortran/78622 + * io/transfer.c (get_dt_format): New static function to alloc + and set the DT iotype string, handling doubled quotes. + (formatted_transfer_scalar_read, + formatted_transfer_scalar_write): Use new function. + 2016-12-12 Rainer Orth * configure.ac: Call GCC_CHECK_LINKER_HWCAP. diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 583036292f9..c90e8c5e480 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1264,6 +1264,33 @@ require_numeric_type (st_parameter_dt *dtp, bt actual, const fnode *f) return 1; } +static char * +get_dt_format (char *p, gfc_charlen_type *length) +{ + char delim = p[-1]; /* The delimiter is always the first character back. */ + char c, *q, *res; + gfc_charlen_type len = *length; /* This length already correct, less 'DT'. */ + + res = q = xmalloc (len + 2); + + /* Set the beginning of the string to 'DT', length adjusted below. */ + *q++ = 'D'; + *q++ = 'T'; + + /* The string may contain doubled quotes so scan and skip as needed. */ + for (; len > 0; len--) + { + c = *q++ = *p++; + if (c == delim) + p++; /* Skip the doubled delimiter. */ + } + + /* Adjust the string length by two now that we are done. */ + *length += 2; + + return res; +} + /* This function is in the main loop for a formatted data transfer statement. It would be natural to implement this as a coroutine @@ -1420,7 +1447,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind gfc_charlen_type child_iomsg_len; int noiostat; int *child_iostat = NULL; - char *iotype = f->u.udf.string; + char *iotype; gfc_charlen_type iotype_len = f->u.udf.string_len; /* Build the iotype string. */ @@ -1430,13 +1457,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind iotype = dt; } else - { - iotype_len += 2; - iotype = xmalloc (iotype_len); - iotype[0] = dt[0]; - iotype[1] = dt[1]; - memcpy (iotype + 2, f->u.udf.string, f->u.udf.string_len); - } + iotype = get_dt_format (f->u.udf.string, &iotype_len); /* Set iostat, intent(out). */ noiostat = 0; @@ -1890,7 +1911,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin gfc_charlen_type child_iomsg_len; int noiostat; int *child_iostat = NULL; - char *iotype = f->u.udf.string; + char *iotype; gfc_charlen_type iotype_len = f->u.udf.string_len; /* Build the iotype string. */ @@ -1900,13 +1921,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin iotype = dt; } else - { - iotype_len += 2; - iotype = xmalloc (iotype_len); - iotype[0] = dt[0]; - iotype[1] = dt[1]; - memcpy (iotype + 2, f->u.udf.string, f->u.udf.string_len); - } + iotype = get_dt_format (f->u.udf.string, &iotype_len); /* Set iostat, intent(out). */ noiostat = 0; -- 2.30.2