From patchwork Sat Jan 13 20:02:05 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 860369 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-471121-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="WufoM7FJ"; dkim-atps=neutral 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 3zJrB92FsJz9sP1 for ; Sun, 14 Jan 2018 07:02:23 +1100 (AEDT) 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=UDO/bLbrX/KAGmdTq5Uhd3QZ+ZKm9645+zDwz030R82KIYcBNM sijc7oTg2u0fdeSaKYim0Lj/QGYTLUzdgBvzycBfpFm1xa8Iz6UnysHSHaemmZ15 IMtQjdaLn082xs9fewZdKf9Ky+uXpuIaRpmj2IrA+NLF7SQD48wMvx8z8= 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=n7V0xRJxTQ0DbeoTNJy9aeldmUE=; b=WufoM7FJ8NvnDivXw9ZC IqaZR1hcehBLlJ3CxtZ0d5+3P2gRSIfjrl6L7ZNPgXvabXkndbUHc1Rs1FyDwv7F 3QNtwYK2YRYuBHavyLuyrj6qxhJGS1RD4haXz8OMtOg6U4O+YiP71fQxGj0DGtqU 2bPCISaqTivfZ6WJkpeEtSM= Received: (qmail 3126 invoked by alias); 13 Jan 2018 20:02:12 -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 3103 invoked by uid 89); 13 Jan 2018 20:02:11 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-23.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, RCVD_IN_SORBS_WEB, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=H*MI:charter, sk:gfc_eva, H*Ad:D*charter.net, H*F:D*charter.net X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout003-public.msg.strl.va.charter.net Received: from mtaout003-public.msg.strl.va.charter.net (HELO mtaout003-public.msg.strl.va.charter.net) (68.114.190.28) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 13 Jan 2018 20:02:10 +0000 Received: from impout004 ([68.114.189.19]) by mtaout003.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20180113200208.QAJV7355.mtaout003.msg.strl.va.charter.net@impout004>; Sat, 13 Jan 2018 14:02:08 -0600 Received: from [172.16.1.46] ([66.96.68.196]) by impout004 with charter.net id xw271w00J4E4Wx601w28eW; Sat, 13 Jan 2018 14:02:08 -0600 X-Authority-Analysis: v=2.2 cv=EdC4eLuC c=1 sm=1 tr=0 a=3BTVQCqdHQ9ozV1XzgarEg==:117 a=3BTVQCqdHQ9ozV1XzgarEg==:17 a=x7bEGLp0ZPQA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=8jPwRE8lRtDKQGisNmIA:9 a=QEXdDO2ut3YA:10 a=Dm8Vu3FFV6wBpl4-YcQA:9 a=hquHOILUSkIA:10 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: gfortran Cc: gcc patches From: Jerry DeLisle Subject: [patch, fortran] DTIO write format stored in a string leads to severe errors Message-ID: <5943cbac-95c4-7ec8-6b50-571f98599c6c@charter.net> Date: Sat, 13 Jan 2018 12:02:05 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.5.0 MIME-Version: 1.0 I plan to commit the attached patch which eliminates the offending behavior and allows the test cases to run. I opened a new PR to address the remaining issues. See Bug 83829 - Implement runtime checks for DT format specifier and alignment with effective item. Regression tested on x86_64-pc-linux-gnu. The patch is simple. I will roll in a test case soon. Regards, Jerry 2018-01-13 Jerry DeLisle PR fortran/82007 * resolve.c (resolve_transfer): Delete code looking for 'DT' format specifiers in format strings. Set formatted to true if a format string or format label is present. * trans-io.c (get_dtio_proc): Likewise. (transfer_expr): Fix whitespace. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e9f91d883ef..67568710b05 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9198,19 +9198,9 @@ resolve_transfer (gfc_code *code) else derived = ts->u.derived->components->ts.u.derived; - if (dt->format_expr) - { - char *fmt; - fmt = gfc_widechar_to_char (dt->format_expr->value.character.string, - -1); - if (strtok (fmt, "DT") != NULL) - formatted = true; - } - else if (dt->format_label == &format_asterisk) - { - /* List directed io must call the formatted DTIO procedure. */ - formatted = true; - } + /* Determine when to use the formatted DTIO procedure. */ + if (dt && (dt->format_expr || dt->format_label)) + formatted = true; write = dt->dt_io_kind->value.iokind == M_WRITE || dt->dt_io_kind->value.iokind == M_PRINT; diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 9eb77e5986d..082b9f7a52f 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2227,25 +2227,9 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub) bool formatted = false; gfc_dt *dt = code->ext.dt; - if (dt) - { - char *fmt = NULL; - - if (dt->format_label == &format_asterisk) - { - /* List directed io must call the formatted DTIO procedure. */ - formatted = true; - } - else if (dt->format_expr) - fmt = gfc_widechar_to_char (dt->format_expr->value.character.string, - -1); - else if (dt->format_label) - fmt = gfc_widechar_to_char (dt->format_label->format->value.character.string, - -1); - if (fmt && strtok (fmt, "DT") != NULL) - formatted = true; - - } + /* Determine when to use the formatted DTIO procedure. */ + if (dt && (dt->format_expr || dt->format_label)) + formatted = true; if (ts->type == BT_CLASS) derived = ts->u.derived->components->ts.u.derived; @@ -2455,8 +2439,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, { /* Recurse into the elements of the derived type. */ expr = gfc_evaluate_now (addr_expr, &se->pre); - expr = build_fold_indirect_ref_loc (input_location, - expr); + expr = build_fold_indirect_ref_loc (input_location, expr); /* Make sure that the derived type has been built. An external function, if only referenced in an io statement, requires this