From patchwork Fri Dec 16 02:16:17 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 706316 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3tfv8253dNz9t1H for ; Fri, 16 Dec 2016 13:16:49 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="uKAarBU4"; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=G96tCRsewfVky7tBwnOuNS8LmqQKWGQxE2KxVncbAV+xJ8/MUS xvmRWtT2heagTxEVxxHNTwBKTCXcDVf7ihsbtJHEaLma3YW7e7ZcuXWLbkZBBL1Q VOj91NMWdgJzvOD5OqnjiizPFijd26gnADUn1FOljSZOLtLZ31wkHXoTo= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=dSm7/JqCES5Nhu1ZNswzSjVgN+A=; b=uKAarBU4yv5U7lCLKBwt PHnbGN1Qs79+ogHtYqvymXo+Nd/WBgcvmwWJDA5ttIlFqo2sB6rLXufFG7fd2c7u ds0pZ3a+wAlVe+0/DIHqL9ZkuE+mTVFYDJYZ31GnHkNgzZLgYC0SDT9KgHc0kXkU vZuFdGdGNHb1ULprXkX3M2g= Received: (qmail 9015 invoked by alias); 16 Dec 2016 02:16:34 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 8899 invoked by uid 89); 16 Dec 2016 02:16:30 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-4.1 required=5.0 tests=AWL, BAYES_05, RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=2016-12-16, PROGRAM, kin, H*r:InterMail X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout001-public.msg.strl.va.charter.net Received: from mtaout001-public.msg.strl.va.charter.net (HELO mtaout001-public.msg.strl.va.charter.net) (68.114.190.26) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Fri, 16 Dec 2016 02:16:20 +0000 Received: from impout001 ([68.114.189.16]) by mtaout001.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20161216021619.JMZA7355.mtaout001.msg.strl.va.charter.net@impout001>; Thu, 15 Dec 2016 20:16:19 -0600 Received: from amda8.localdomain ([96.41.215.23]) by impout001 with charter.net id LSGH1u00F0Wrkg001SGJbu; Thu, 15 Dec 2016 20:16:19 -0600 X-Authority-Analysis: v=2.1 cv=GMSGE49K c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=EZ7k4fenKbZdZkRCNkgA:9 a=QEXdDO2ut3YA:10 a=i_gLaQmkefGa_uWAH0QA:9 a=Og6Jn2dWr2Tud6zO:21 a=sWT-kUDJkFEpK6B2:21 a=rgBPF_EBi-9xrN9bYI8A:9 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: "fortran@gcc.gnu.org" Cc: GCC Patches From: Jerry DeLisle Subject: [patch, fortran] PR78622 [F03] Incorrect parsing of quotes in the char-literal-constant of the DT data descriptor Message-ID: Date: Thu, 15 Dec 2016 18:16:17 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.5.1 MIME-Version: 1.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 PR fortran/78622 * io.c (format_lex): Continue of string delimiter seen. 2016-12-16 Jerry DeLisle 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 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;