From patchwork Mon Dec 25 04:02:47 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 852769 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-469813-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="jdy2QHnf"; 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 3z4lp33FV2z9s03 for ; Mon, 25 Dec 2017 15:03:03 +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=tGaPy6ZSco2FxWZyUaYu+rR7H1sRT7UF/WcVm9UNe3cdHrOBjo UrGBNGnznSt6ksOzKPgIvmKQvIXcr0L8f7j8DMgqRkdCWSHtqdj7dpWAv0doYXzK wq4JfGAb9TaXTnbY4LERj+ai/hWbsIVD+AOGXVJfW8dCL6a6tUFIQqjdw= 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=PIGpfDdcYSsS43t8FPIvEgK5mTY=; b=jdy2QHnfpPECSxmP1hIm vzxwr7XWzynrZNQ6eLnOMvnY+sDhNgZsh+iBA+0IL8Hb7yzYciWtq7+UBF1Lzr2S PidLUpxxoBsF5gy3VDkls6mpNOyxlDidHatj3KDC4mDy1vSLNr5v6/G1uHomKehq cIGkS+hUL2+dGeoh67nV00U= Received: (qmail 32801 invoked by alias); 25 Dec 2017 04:02:55 -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 32762 invoked by uid 89); 25 Dec 2017 04:02:53 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-25.4 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=2017-12-25, H*Ad:D*charter.net, H*F:D*charter.net, H*r:InterMail X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout004-public.msg.strl.va.charter.net Received: from mtaout004-public.msg.strl.va.charter.net (HELO mtaout004-public.msg.strl.va.charter.net) (68.114.190.29) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 25 Dec 2017 04:02:51 +0000 Received: from impout005 ([68.114.189.20]) by mtaout004.msg.strl.va.charter.net (InterMail vM.9.00.023.01 201-2473-194) with ESMTP id <20171225040249.YGHP3685.mtaout004.msg.strl.va.charter.net@impout005>; Sun, 24 Dec 2017 22:02:49 -0600 Received: from [192.168.1.5] ([96.41.213.35]) by impout005 with charter.net id q42o1w0070mPCJg0142oK5; Sun, 24 Dec 2017 22:02:49 -0600 X-Authority-Analysis: v=2.2 cv=VrVTO6+n c=1 sm=1 tr=0 a=NNeuWy7OTYa7gJ+3pFFB5Q==:117 a=NNeuWy7OTYa7gJ+3pFFB5Q==:17 a=x7bEGLp0ZPQA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=7b7TavYJN8aar34TlBgA:9 a=QEXdDO2ut3YA:10 a=UjLdmLLkPoZM2IoMcEgA:9 a=xkqusan2wREwztNQ:21 a=IHLF7Mf6eejOQflz:21 a=hquHOILUSkIA:10 a=_FVE-zBwftR9WsbkzFJk:22 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: gfortran Cc: gcc patches From: Jerry DeLisle Subject: [patch, lingfortran] Bug 83560 - list-directed formatting of INTEGER is missing plus on output Message-ID: <645f227c-aed5-c143-2b4d-4b093a79ae65@charter.net> Date: Sun, 24 Dec 2017 20:02:47 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.5.0 MIME-Version: 1.0 Attached patch changes the use of write_integer for the test case which uses the sign='plus' specifier when opening a file and using list directed output. To fix, I used the write decimal function for namelist writes. For compatibility, I used the content of the previous write_integer function in a new function namelist_write_integer. Regression tested on x86_64-pc-linux. OK for trunk? Regards, Jerry 2017-12-25 Jerry DeLisle PR libgfortran/83560 * io/write.c (write_integer): Modify to use write_decimal. Change paramter from len to kind to be better understood. (namelist_write_integer): New function based on previous write_integer. (nml_write_obj): Use namelist_write_integer instead of write_integer. diff --git a/gcc/testsuite/gfortran.dg/integer_plus.f90 b/gcc/testsuite/gfortran.dg/integer_plus.f90 new file mode 100644 index 00000000000..47f5aa88f17 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/integer_plus.f90 @@ -0,0 +1,14 @@ +! { dg-run run ) +! PR83560 list-directed formatting of INTEGER is missing plus on output +! when output open with SIGN='PLUS' +character(64) :: astring +a=12.3456 +i=789 +open(unit=10, status='scratch', sign='plus') +open(unit=10,sign='plus') +write(10,*) i +rewind(10) +read(10,*) astring +close (10) +if (astring.ne.'+789') call abort +end diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 926d510f4d7..3efe60c12a7 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1300,17 +1300,16 @@ write_logical (st_parameter_dt *dtp, const char *source, int length) /* Write a list-directed integer value. */ static void -write_integer (st_parameter_dt *dtp, const char *source, int length) +write_integer (st_parameter_dt *dtp, const char *source, int kind) { char *p; const char *q; int digits; int width; char itoa_buf[GFC_ITOA_BUF_SIZE]; + fnode f; - q = gfc_itoa (extract_int (source, length), itoa_buf, sizeof (itoa_buf)); - - switch (length) + switch (kind) { case 1: width = 4; @@ -1332,41 +1331,9 @@ write_integer (st_parameter_dt *dtp, const char *source, int length) width = 0; break; } - - digits = strlen (q); - - if (width < digits) - width = digits; - p = write_block (dtp, width); - if (p == NULL) - return; - - if (unlikely (is_char4_unit (dtp))) - { - gfc_char4_t *p4 = (gfc_char4_t *) p; - if (dtp->u.p.no_leading_blank) - { - memcpy4 (p4, q, digits); - memset4 (p4 + digits, ' ', width - digits); - } - else - { - memset4 (p4, ' ', width - digits); - memcpy4 (p4 + width - digits, q, digits); - } - return; - } - - if (dtp->u.p.no_leading_blank) - { - memcpy (p, q, digits); - memset (p + digits, ' ', width - digits); - } - else - { - memset (p, ' ', width - digits); - memcpy (p + width - digits, q, digits); - } + f.u.integer.w = width; + f.u.integer.m = -1; + write_decimal (dtp, &f, source, kind, (void *) gfc_itoa); } @@ -1984,6 +1951,76 @@ list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind, #define NML_DIGITS 20 +static void +namelist_write_integer (st_parameter_dt *dtp, const char *source, int kind) +{ + char *p; + const char *q; + int digits; + int width; + char itoa_buf[GFC_ITOA_BUF_SIZE]; + + q = gfc_itoa (extract_int (source, kind), itoa_buf, sizeof (itoa_buf)); + + switch (kind) + { + case 1: + width = 4; + break; + + case 2: + width = 6; + break; + + case 4: + width = 11; + break; + + case 8: + width = 20; + break; + + default: + width = 0; + break; + } + + digits = strlen (q); + + if (width < digits) + width = digits; + p = write_block (dtp, width); + if (p == NULL) + return; + + if (unlikely (is_char4_unit (dtp))) + { + gfc_char4_t *p4 = (gfc_char4_t *) p; + if (dtp->u.p.no_leading_blank) + { + memcpy4 (p4, q, digits); + memset4 (p4 + digits, ' ', width - digits); + } + else + { + memset4 (p4, ' ', width - digits); + memcpy4 (p4 + width - digits, q, digits); + } + return; + } + + if (dtp->u.p.no_leading_blank) + { + memcpy (p, q, digits); + memset (p + digits, ' ', width - digits); + } + else + { + memset (p, ' ', width - digits); + memcpy (p + width - digits, q, digits); + } +} + static void namelist_write_newline (st_parameter_dt *dtp) { @@ -2183,7 +2220,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset, { case BT_INTEGER: - write_integer (dtp, p, len); + namelist_write_integer (dtp, p, len); break; case BT_LOGICAL: