re PR fortran/78662 ([F03] Incorrect parsing of quotes in the char-literal-constant of the DT data descriptor)

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

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

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;
 		    }

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

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

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.

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 = get_dt_format (f->u.udf.string, &iotype_len);
-	      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);
-	    }
 
 	  /* 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 = get_dt_format (f->u.udf.string, &iotype_len);
-	      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);
-	    }
 
 	  /* Set iostat, intent(out).  */
 	  noiostat = 0;