re PR fortran/78662 ([F03] Incorrect parsing of quotes in the char-literal-constant...

2016-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e460504..fba0d98 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/78622
+       * io.c (format_lex): Continue of string delimiter seen.
+
 2016-12-16  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/78757

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index d35437a..8f4f268 100644 (file)
--- 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 c0b8493..5cfda76 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/78622
+       * gfortran.dg/dtio_20.f03: New test.
+
 2016-12-16  Jakub Jelinek  <jakub@redhat.com>
 
        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 (file)
index 0000000..dce4872
--- /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 2d73744..bcd8cd3 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2016-12-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       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  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        * configure.ac: Call GCC_CHECK_LINKER_HWCAP.

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 5830362..c90e8c5 100644 (file)
--- 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;