@@ -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;
}
@@ -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;
Hi all, The attached patch regression tested on x86-64-linux. This adds a static function to allocate and extract the DT format string that may contain doubled quotes. OK for trunk, test case also attched. Jerry 2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/78622 * io.c (format_lex): Continue of string delimiter seen. 2016-12-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/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. 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