From patchwork Sun Apr 23 02:28:19 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 753852 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 3w9YLh03yzz9s03 for ; Sun, 23 Apr 2017 12:28:42 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="niegLWPu"; 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=RNiZBwfET6atLfqei2HO8+HZ3MuMWmZIokMwR8iGDbfWWNfATH OmJU7joRTPatCB/bUPKCMaqRkkJzv02vC/8njI41hTi8+sU2/krVvRXNXQyld/LR eZr3rgMsbS8MBX0QKx8lIOrUFqHIBC95ltxEiqrIebaqFJse/J/ZqnY5A= 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=MPFegQPvRbIQHgPNpptG4p9AMSQ=; b=niegLWPu8HFxRDbs3UVQ GyKeoI7CMz1ckX1Fe1QMiN9NVxSiI8imURPKlKQPqljbdSqVPb/ZVrFma/xSd6Cs E5WshqWyjqnxt42KH9lpIsQSG8aYUL+q63MNqwD8lqy+rFZJ3TwJY+NMUmAhonqR lttQoHrWWowqEy0/tl3mkVI= Received: (qmail 75557 invoked by alias); 23 Apr 2017 02:28:28 -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 75371 invoked by uid 89); 23 Apr 2017 02:28:23 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=Trunk, U*jvdelisle, sk:jvdelis, H*Ad:D*charter.net X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout005-public.msg.strl.va.charter.net Received: from mtaout005-public.msg.strl.va.charter.net (HELO mtaout005-public.msg.strl.va.charter.net) (68.114.190.30) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 23 Apr 2017 02:28:21 +0000 Received: from impout003 ([68.114.189.18]) by mtaout005.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20170423022821.KVVP7356.mtaout005.msg.strl.va.charter.net@impout003>; Sat, 22 Apr 2017 21:28:21 -0500 Received: from amda8.localdomain ([96.41.215.23]) by impout003 with charter.net id BeUK1v0080Wrkg001eULe5; Sat, 22 Apr 2017 21:28:21 -0500 X-Authority-Analysis: v=2.2 cv=QNQYfkDL c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=Z7gcVASdYNCV7Z-uY4UA:9 a=QEXdDO2ut3YA:10 a=FLOiFHFKwKFsjCUH--IA:9 a=hquHOILUSkIA:10 a=e-5YLN8no0vs7j644XwA:9 a=voGCI5DAS3EA:10 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: "fortran@gcc.gnu.org" Cc: GCC Patches From: Jerry DeLisle Subject: [patch, libgfortran] PR80484 Three syntax errors involving derived-type I/O Message-ID: <0f1e7130-a126-3843-ffaa-ec1944fb93f3@charter.net> Date: Sat, 22 Apr 2017 19:28:19 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.0 MIME-Version: 1.0 Hi all, The attached patch fixes these issues. Regression tested on x86_64-pc-linux-gnu. New test attached. OK for Trunk (8)? I think we should backport to 7 when it re-opens. The failing repeat count on DT format is very not good. Regards, Jerry 2017-04-22 Jerry DeLisle PR fortran/80484 * io.c (format_lex): Check for '/' and set token to FMT_SLASH. (check_format): Move FMT_DT checking code to data_desc section. * module.c (gfc_match_use): Include the case of INTERFACE_DTIO. ! { dg-do compile } ! PR80484 Three syntax errors involving derived-type I/O module dt_write_mod type, public :: B_type real :: amount end type B_type interface write (formatted) procedure :: Write_b end interface contains subroutine Write_b & (amount, unit, b_edit_descriptor, v_list, iostat, iomsg) class (B_type), intent(in) :: amount integer, intent(in) :: unit character (len=*), intent(in) :: b_edit_descriptor integer, dimension(:), intent(in) :: v_list integer, intent(out) :: iostat character (len=*), intent(inout) :: iomsg write (unit=unit, fmt="(f9.3)", iostat=iostat) amount%amount end subroutine Write_b end module dt_write_mod program test use dt_write_mod, only: B_type , write(formatted) implicit none real :: wage = 15.10 integer :: ios character(len=99) :: iom = "OK" write (unit=*, fmt="(DT'$$$Z.##')", iostat=ios, iomsg=iom) & B_type(wage), B_type(wage) print *, trim(iom) write (unit=*, fmt="(2DT'$$$Z.##')", iostat=ios, iomsg=iom) & B_type(wage), B_type(wage) print *, trim(iom) write (unit=*, fmt="(3DT'$$$Z.##')", iostat=ios, iomsg=iom) & B_type(wage), B_type(wage) print *, trim(iom) write (unit=*, fmt="(DT'$$$Z.##'/)", iostat=ios, iomsg=iom) & B_type(wage), B_type(wage) print *, trim(iom) end program test diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 60df44dc..7ab897da 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -491,6 +491,11 @@ format_lex (void) token = FMT_END; break; } + if (c == '/') + { + token = FMT_SLASH; + break; + } if (c == delim) continue; unget_char (); @@ -498,6 +503,11 @@ format_lex (void) } } } + else if (c == '/') + { + token = FMT_SLASH; + break; + } else unget_char (); } @@ -687,54 +697,6 @@ format_item_1: return false; goto between_desc; - case FMT_DT: - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - switch (t) - { - case FMT_RPAREN: - level--; - if (level < 0) - goto finished; - goto between_desc; - - case FMT_COMMA: - goto format_item; - - case FMT_LPAREN: - - dtio_vlist: - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - - if (t != FMT_POSINT) - { - error = posint_required; - goto syntax; - } - - t = format_lex (); - if (t == FMT_ERROR) - goto fail; - - if (t == FMT_COMMA) - goto dtio_vlist; - if (t != FMT_RPAREN) - { - error = _("Right parenthesis expected at %C"); - goto syntax; - } - goto between_desc; - - default: - error = unexpected_element; - goto syntax; - } - - goto format_item; - case FMT_SIGN: case FMT_BLANK: case FMT_DP: @@ -783,6 +745,7 @@ format_item_1: case FMT_A: case FMT_D: case FMT_H: + case FMT_DT: goto data_desc; case FMT_END: @@ -1004,6 +967,53 @@ data_desc: break; + case FMT_DT: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + switch (t) + { + case FMT_RPAREN: + level--; + if (level < 0) + goto finished; + goto between_desc; + + case FMT_COMMA: + goto format_item; + + case FMT_LPAREN: + + dtio_vlist: + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t != FMT_POSINT) + { + error = posint_required; + goto syntax; + } + + t = format_lex (); + if (t == FMT_ERROR) + goto fail; + + if (t == FMT_COMMA) + goto dtio_vlist; + if (t != FMT_RPAREN) + { + error = _("Right parenthesis expected at %C"); + goto syntax; + } + goto between_desc; + + default: + error = unexpected_element; + goto syntax; + } + break; + case FMT_F: t = format_lex (); if (t == FMT_ERROR) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 4d6afa55..e8cba145 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -631,6 +631,7 @@ gfc_match_use (void) case INTERFACE_USER_OP: case INTERFACE_GENERIC: + case INTERFACE_DTIO: m = gfc_match (" =>"); if (type == INTERFACE_USER_OP && m == MATCH_YES