diff mbox

[fortran] PR78622 [F03] Incorrect parsing of quotes in the char-literal-constant of the DT data descriptor

Message ID e767a683-ee6f-2e75-b596-ddbe79077061@charter.net
State New
Headers show

Commit Message

Jerry DeLisle Dec. 16, 2016, 2:16 a.m. UTC 
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

Comments

Janne Blomqvist Dec. 16, 2016, 7:46 p.m. UTC | #1 
On Fri, Dec 16, 2016 at 4:16 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
> 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.

Ok, thanks.

>
> 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.
diff mbox

Patch

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index d35437a..8f4f268 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/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 5830362..c90e8c5 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;