From patchwork Mon Aug 21 02:23:48 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 803828 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-460617-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="rmkdONO0"; 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 3xbHZ6191cz9s7v for ; Mon, 21 Aug 2017 12:24:11 +1000 (AEST) 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=rHYd4pHvrJI6z3tO9tJYXu9cH8pI2PbxEDCIM4xpeG4yWHSr+6 8guyhzBlq9LJY6C3GJ6DOa6oB77+DRP4Za5xYtgu7g7I885SAnv23oWCXTxQtJIx ztk031jMAtiBfbikRH1KTUDOjUlKJuAgGl1nCPraPiHbr1CHIybk2Iqfo= 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=FEhE10MuXiip7EKNtqIt5lnXSWI=; b=rmkdONO0d1YiCmunKxuk bJeamM6dlY/WaHDQLPXhzGb5NURhepBD0XR9uippSruZQ5kwjQnV4k8c05Snjv6S 21xGSIFTgmCg1YhNRkwrUC8fYOlPyW29u0zd8dtOGN9J0djpQ72uXEYgQswMgVnu SyHlesYaJy3yOiMf/yNqnZ4= Received: (qmail 102288 invoked by alias); 21 Aug 2017 02:23:54 -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 102105 invoked by uid 89); 21 Aug 2017 02:23:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-24.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, RCVD_IN_SORBS_SPAM, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=Hx-languages-length:2114, rewind X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout002-public.msg.strl.va.charter.net Received: from mtaout002-public.msg.strl.va.charter.net (HELO mtaout002-public.msg.strl.va.charter.net) (68.114.190.27) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 21 Aug 2017 02:23:51 +0000 Received: from impout003 ([68.114.189.18]) by mtaout002.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20170821022350.QLOW7360.mtaout002.msg.strl.va.charter.net@impout003>; Sun, 20 Aug 2017 21:23:50 -0500 Received: from amda8.localdomain ([96.41.215.23]) by impout003 with charter.net id zePp1v0050Wrkg001ePpPs; Sun, 20 Aug 2017 21:23:50 -0500 X-Authority-Analysis: v=2.2 cv=XZf59Mx5 c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=x7bEGLp0ZPQA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=FTeyQwsN5fp71VRUXGMA:9 a=QEXdDO2ut3YA:10 a=97_LXCnZcSqnK2QWGPgA:9 a=hquHOILUSkIA:10 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: "fortran@gcc.gnu.org" Cc: GCC Patches From: Jerry DeLisle Subject: [patch, fortran] Bug 81296 - derived type I/o problem Message-ID: Date: Sun, 20 Aug 2017 19:23:48 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.2.1 MIME-Version: 1.0 Hi all, The attached patch adds a check for the format label containing a "DT" format descriptor and enables the generation of the correct code. The patch modifies an existing test case as a future check on this. Regression tested on x86_64-linux. OK for trunk and backport to 7? Regards, Jerry 2017-08-21 Jerry DeLisle PR fortran/81296 * trans-io.c (get_dtio_proc): Add check for format label and set formatted flag accordingly. Reorganize the code a little. diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index c3c56f29..aa974eb3 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2214,18 +2214,24 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub) bool formatted = false; gfc_dt *dt = code->ext.dt; - if (dt && dt->format_expr) + if (dt) { - char *fmt; - fmt = gfc_widechar_to_char (dt->format_expr->value.character.string, - -1); - if (strtok (fmt, "DT") != NULL) + 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; - } - else if (dt && dt->format_label == &format_asterisk) - { - /* List directed io must call the formatted DTIO procedure. */ - formatted = true; + } if (ts->type == BT_CLASS) diff --git a/gcc/testsuite/gfortran.dg/dtio_12.f90 b/gcc/testsuite/gfortran.dg/dtio_12.f90 index 213f7ebb..cf1bfe38 100644 --- a/gcc/testsuite/gfortran.dg/dtio_12.f90 +++ b/gcc/testsuite/gfortran.dg/dtio_12.f90 @@ -70,5 +70,11 @@ end module rewind (10) read (10, *) msg if (trim (msg) .ne. "77") call abort + rewind (10) + write (10,40) child (77) ! Modified using format label +40 format(DT) + rewind (10) + read (10, *) msg + if (trim (msg) .ne. "77") call abort close(10) end