From patchwork Tue Oct 18 01:02:52 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 683480 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 3sycJT4Pknz9sCZ for ; Tue, 18 Oct 2016 12:03:19 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=KNY20ASu; 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:from :subject:to:cc:message-id:date:mime-version:content-type; q=dns; s=default; b=WCQeOZro6Qb96Swk/8Um43yWLvs2IuyrzNf6ZhZk283uafqS/Y 7m0dVuA6xkhJVSTWpwslDz8Wr/YY8nqC43g6DNI4heDox/FUBIos/jPEUG03ftfR qWYLW/Ufu0CXvdazHQjuOPNbuID9s/1k9ZJDwZZdp2V8+3GIDPh2+OxH8= 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:from :subject:to:cc:message-id:date:mime-version:content-type; s= default; bh=GxNNe5qzIXDIihXmHzb4MuSOCzg=; b=KNY20ASukEzsWemPej8G TXCvVUk+4fYFBa2tUBLObtJwtHC8Bo/Gbed3OjijHsF5QFzcBg18xGA8B9waa6Bp EYgtXByTZ2s3PnEg6TiAfndbmyleTYVeP/QS77uGTJCl0JoWmmCYqb2RMHm8IMo+ nMvMsLrldDyJEXSJu6J3zO8= Received: (qmail 4309 invoked by alias); 18 Oct 2016 01:03:07 -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 4269 invoked by uid 89); 18 Oct 2016 01:03:06 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RCVD_IN_SORBS_SPAM, RP_MATCHES_RCVD, SPF_PASS autolearn=no version=3.3.2 spammy=5146, 6506, 3989, SUCCESS X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout006-public.msg.strl.va.charter.net Received: from mtaout006-public.msg.strl.va.charter.net (HELO mtaout006-public.msg.strl.va.charter.net) (68.114.190.31) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 18 Oct 2016 01:02:56 +0000 Received: from impout001 ([68.114.189.16]) by mtaout006.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20161018010253.WXVU7358.mtaout006.msg.strl.va.charter.net@impout001>; Mon, 17 Oct 2016 20:02:53 -0500 Received: from amda8.localdomain ([96.41.215.23]) by impout001 with charter.net id wp2s1t00E0Wrkg001p2teZ; Mon, 17 Oct 2016 20:02:53 -0500 X-Authority-Analysis: v=2.1 cv=EKqI0jpC 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=jrlFcQwWLuFeFp81pRcA:9 a=QEXdDO2ut3YA:10 a=OZrciADcss0t3SOvAS0A:9 a=J6tb_IMykw9Y7pWl:21 a=Fo2YrCWb6738a2Qd:21 a=TkRovQr0dBXA2zbCWfEA:9 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 From: Jerry DeLisle Subject: [patch, gfortran] PR48298 DTIO, implement size= To: "fortran@gcc.gnu.org" Cc: GCC Patches Message-ID: <32d1a016-d097-9eb2-b5ea-95433f6f50ec@charter.net> Date: Mon, 17 Oct 2016 18:02:52 -0700 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:45.0) Gecko/20100101 Thunderbird/45.3.0 MIME-Version: 1.0 Hi all, The attached patch enables the size= specifier in a READ statement to work with child DTIO procedures. This is accomplished by moving the size_used variable from the dtp structure to the gfc_unit structure so that the accumulation of bytes during READ is carried across the procedures via the UNIT. As far as I know, this is the last DTIO patch needed for full implementation and will close the PR. After this patch is committed I plan to prepare a clean up patch to reorganize the dtp structure and clear at least one TODO related to stream IO. The follow-on patch will bump the major version number of libgfortran to 4. Regression tested on x86-64-linux. New test case attached. OK for trunk? Jerry 2016-10-17 Jerry DeLisle PR fortran/48298 * io/io.h: Move size_used from dtp to unit structure. Add bool has_size to unit structure. * read.c (read_x): Use has_size and size_used. * transfer.c (read_sf_internal): Likewise. (read_sf): Likewise. (read_block_form): Likewise. (read_block_form4): Likewise. (data_transfer_init): If parent, initialize the size variables. (finalize_transfer): Set the size variable using size_used in gfc_unit. (write_block): Delete bogus/dead code. diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bfda86df..f20c5106 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,15 @@ +2016-10-17 Jerry DeLisle + + PR fortran/48298 + * io/io.h: Move size_used from dtp to unit structure. Add bool + has_size to unit structure. + * read.c (read_x): Use has_size and size_used. + * transfer.c (read_sf_internal): Likewise. (read_sf): Likewise. + (read_block_form): Likewise. (read_block_form4): Likewise. + (data_transfer_init): If parent, initialize the size variables. + (finalize_transfer): Set the size variable using size_used in + gfc_unit. (write_block): Delete bogus/dead code. + 2016-10-16 Janne Blomqvist PR libfortran/48587 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index aaacc089..edc520a9 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -514,7 +514,6 @@ typedef struct st_parameter_dt large enough to hold a complex value (two reals) of the largest kind. */ char value[32]; - GFC_IO_INT size_used; formatted_dtio fdtio_ptr; unformatted_dtio ufdtio_ptr; } p; @@ -650,6 +649,8 @@ typedef struct gfc_unit /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */ int child_dtio; int last_char; + bool has_size; + GFC_IO_INT size_used; } gfc_unit; diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index f8d5b72e..d72cdb37 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -1282,8 +1282,9 @@ read_x (st_parameter_dt *dtp, int n) } done: - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) n; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) n; dtp->u.p.current_unit->bytes_left -= n; dtp->u.p.current_unit->strm_pos += (gfc_offset) n; } diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 2232417a..e5805772 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -267,8 +267,9 @@ read_sf_internal (st_parameter_dt *dtp, int * length) dtp->u.p.current_unit->bytes_left -= *length; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *length; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *length; return base; @@ -397,8 +398,9 @@ read_sf (st_parameter_dt *dtp, int * length) dtp->u.p.current_unit->bytes_left -= n; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) n; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) n; /* We can't call fbuf_getptr before the loop doing fbuf_getc, because fbuf_getc might reallocate the buffer. So return current pointer @@ -478,8 +480,9 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) source = fbuf_read (dtp->u.p.current_unit, nbytes); fbuf_seek (dtp->u.p.current_unit, *nbytes, SEEK_CUR); - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes; if (norig != *nbytes) { @@ -536,8 +539,9 @@ read_block_form4 (st_parameter_dt *dtp, int * nbytes) dtp->u.p.current_unit->bytes_left -= *nbytes; - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *nbytes; + if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) || + dtp->u.p.current_unit->has_size) + dtp->u.p.current_unit->size_used += (GFC_IO_INT) *nbytes; return source; } @@ -770,9 +774,6 @@ write_block (st_parameter_dt *dtp, int length) } } - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) length; - dtp->u.p.current_unit->strm_pos += (gfc_offset) length; return dest; @@ -2596,9 +2597,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) return; - if ((cf & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used = 0; /* Initialize the count. */ - dtp->u.p.current_unit = get_unit (dtp, 1); if (dtp->u.p.current_unit == NULL) @@ -2674,6 +2672,18 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) return; } + if (dtp->u.p.current_unit->child_dtio == 0) + { + if ((cf & IOPARM_DT_HAS_SIZE) != 0) + { + dtp->u.p.current_unit->has_size = true; + /* Initialize the count. */ + dtp->u.p.current_unit->size_used = 0; + } + else + dtp->u.p.current_unit->has_size = false; + } + /* Check the action. */ if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) @@ -3772,7 +3782,7 @@ finalize_transfer (st_parameter_dt *dtp) return; if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - *dtp->size = dtp->u.p.size_used; + *dtp->size = dtp->u.p.current_unit->size_used; if (dtp->u.p.eor_condition) {