From patchwork Fri Apr 14 18:59:24 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 83560 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp595766vqo; Fri, 14 Apr 2023 12:00:14 -0700 (PDT) X-Google-Smtp-Source: AKy350ZipRBPK0jqkRg0EsbNsXWu16AIi4GhMAtrNUtcSZjHGCN+Bj9Sa+BYMZa6BcQymdqtbdE6 X-Received: by 2002:a05:6402:1b0a:b0:504:b993:7dba with SMTP id by10-20020a0564021b0a00b00504b9937dbamr7182584edb.41.1681498814026; Fri, 14 Apr 2023 12:00:14 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1681498814; cv=none; d=google.com; s=arc-20160816; b=suli2d0pHBNYCFzmN6g/A3N2Igj2GCEnJ/XuFjtBOLL3VS+ca9Ykyka+nYj4PXTeRt UDTcfbUzq/cTGNGIibwAHThxdRIsSOWTQRGhGM0nO7dDsdZq63Z5OcdJ+EvOPNJDVnba gk6jTAORwTMxAfESMBW/feU8Qf++BOggAoDFqmvGzth/jFoUQy7HQ+NPBEdsrgg2/FvR l+SfDFTCXaC56nxx7ebpF4eIOaTgfMZMogdO5Ra244zzDjaJ3wIeprbEIEvK6z41NgV7 rsGc6Ltq1Nyr8gNbHigT1d0QFwojofNv21sbxWMvAXSyIz2l1JY3lVnIrwXI3RE/zCqM Aphg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=u0Qi3y4yiy9nHyhtOr1+BEg+EL/kGhQcuU+p5A7zJJ4=; b=cB98YILy1gXbOLMdc/bDSgahpn2kgST6wq7TA4qokkl2CgTu3ri88oFO4hXB3NvxgO Tg7r/e7oVMjzOEo0hQdyLAPQ7kez74+sYezXfqYXbGKxehvP40aD+oFWw3KrBrVdpvYH xdxXjd0rgIeh4pA2Jbrjv2lEemT5p16lWGIE+NwFRQJY0xzKyPwBciMr+jS5Pd0+aYUB htbNuKABAY2MdU5sOdnWR+uzu/0H789bSsTTbfYgMm6nphBd6VkbkV9Y28rXNW8DpWGc Oruuaquf3tVA6AvJ0cJtLJQ836d/lJAOzZTnBNbBhBsDqxv0aIaVwWnVytfPtc44xZ3A bLrg== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=ugZSv1Yb; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id l4-20020a056402124400b004fb6e2b5aacsi4625332edw.582.2023.04.14.12.00.13 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 14 Apr 2023 12:00:14 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=ugZSv1Yb; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C0444385771F for ; Fri, 14 Apr 2023 19:00:08 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C0444385771F DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1681498808; bh=u0Qi3y4yiy9nHyhtOr1+BEg+EL/kGhQcuU+p5A7zJJ4=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=ugZSv1YbvIsHhY4EWH3WBW9AZ3E0qq6ZXLT59toALgxfVwH4Kx0KEAuFSZXaaxTff l9+liYkxjWDJ+WXlKntqhNUZX5BEVzj4xdHQKIM6FGjoCtq1EbdTjtVVO6VrQazyer 9WuUJjpOlPbPrG9NdekCyvhcJ2SBdFOD6MPG+FW0= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id 3B92F3858D20; Fri, 14 Apr 2023 18:59:25 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 3B92F3858D20 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.14.165] ([79.251.14.165]) by web-mail.gmx.net (3c-app-gmx-bs43.server.lan [172.19.170.95]) (via HTTP); Fri, 14 Apr 2023 20:59:24 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: fix compile-time simplification of SET_EXPONENT [PR109511] Date: Fri, 14 Apr 2023 20:59:24 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:36XYOPDnHrQdWsyra3/JWefDbrkEegGTLRMr/ePgzWpgr9lBCrAPIjTFFRMHK0+3eGcXk gaReeHwsQsQ5iPFDN4+u6RYYQ2gwhuNZp8TAmiijCd6LLqEd8Nc5JZX75lksLdGyoHb0wgDcRTxd elqy1HfX6KDcmDj4E10LMrh6wdskRMoxfF+JpcB7dgWm++3ytYXpDEW9KGMnlFHH45uJ5cHcaMUv OcK2Ze6swuukVrZtI5vBw4V5fdWFw/g4ljOC8ahF1Z4CVoZktqSP3ygs6/KL6VpI4v3CQp7sGIKq 8Q= UI-OutboundReport: notjunk:1;M01:P0:SQSAOQDzBus=;m4gMDfUDyQ0Szq1LtK7SA88WMoR HAcPGGsIk/I0dnD86jfETai3/6Lj0ryEkK9bdyoiJ5RTN28ZdosjImgxkUDVGASGgiCdigAx+ QS4WpVIjFyv9yRRNVbABLHy0X6gn5f3IDo9Z9uSdHPhnXsqcRsHBegN51bZXBtWOzLrC6xCA5 Gsgb9eYFN+K3m63IG6NAyyoekCm4wZbmSz1x8S/oE/C3z96A39x6cB9UMYE2BI3BFZO6PFfHl aANTo3umd1yS+tsSd9O+aOEO9PspS4LSAtv3DkTvjiKv1iH1RMOOVBvZYs40bh3YJby4GN4KO /SFXWSG40prKl6yxQ0skDLn754Z84JMpxVviuBo8ImdLCk7gFuKzcki+K6GhzooKYBoelxVvL 9rsxomL2sp+/g5jNbMJQaqbk/p9QRrh30OC4sLZ+TvGUjrosjL5vxeC/eyaGvqcc49BUzuDed Eg8PgBaEptysJiIYSZuOmnyJGPdashfne+VWR47asQfggdvzLhYy/OSvlgK15If31elSc8yoZ /qYeONrSt+VUBd5sMaGuSK5K5EHq/n947SSdtykQ3/iGVnuuvLUCsfKF+oyCfHCGgelZDpNiK 4nGsSc3a1im9hiyCqaUyWUvnyS0Dw2jkM4kkACXxqGarMturGg7wkGBTQQd+uTZUmAUsW8sIj PBRCdefH+m8sYxVbVrvrJLKmONc7FLcJTZXuruemXjRappj19tXNcpDynC8pgrxZrzB3B2gcx IdlU+unu20yECdlen9D8idGVW6IH+wYD4H2O6AuUQ3IXqQtTfwLy5L3zKzKCXJwoB8jSI4fep V6bG8YzAzc8keBgBPK3AWj/Q== X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1763179300576463465?= X-GMAIL-MSGID: =?utf-8?q?1763179300576463465?= [Now with subject added...] Dear all, the compile-time simplification of intrinsic SET_EXPONENT was broken since the early days of gfortran for argument X < 1 (including negative X) and for I < 0. I identified and fixed several issues in the implementation. The testcase explores argument space comparing compile-time and runtime results and is checked against Intel. Regtested on x86_64-pc-linux-gnu. OK for mainline? This is not a regression, but can lead to wrong code. Would it be OK to backport to open branches? Thanks, Harald From fa4cb42870df60deb8888dbd51e2ddc6d6ab9e6a Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 14 Apr 2023 20:45:19 +0200 Subject: [PATCH] Fortran: fix compile-time simplification of SET_EXPONENT [PR109511] gcc/fortran/ChangeLog: PR fortran/109511 * simplify.cc (gfc_simplify_set_exponent): Fix implementation of compile-time simplification of intrinsic SET_EXPONENT for argument X < 1 and for I < 0. gcc/testsuite/ChangeLog: PR fortran/109511 * gfortran.dg/set_exponent_1.f90: New test. --- gcc/fortran/simplify.cc | 12 +++---- gcc/testsuite/gfortran.dg/set_exponent_1.f90 | 36 ++++++++++++++++++++ 2 files changed, 42 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/set_exponent_1.f90 diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index ecf0e3558df..b65854c1021 100644 --- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -7364,7 +7364,7 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) { gfc_expr *result; mpfr_t exp, absv, log2, pow2, frac; - unsigned long exp2; + long exp2; if (x->expr_type != EXPR_CONSTANT || i->expr_type != EXPR_CONSTANT) return NULL; @@ -7396,19 +7396,19 @@ gfc_simplify_set_exponent (gfc_expr *x, gfc_expr *i) mpfr_abs (absv, x->value.real, GFC_RND_MODE); mpfr_log2 (log2, absv, GFC_RND_MODE); - mpfr_trunc (log2, log2); + mpfr_floor (log2, log2); mpfr_add_ui (exp, log2, 1, GFC_RND_MODE); /* Old exponent value, and fraction. */ mpfr_ui_pow (pow2, 2, exp, GFC_RND_MODE); - mpfr_div (frac, absv, pow2, GFC_RND_MODE); + mpfr_div (frac, x->value.real, pow2, GFC_RND_MODE); /* New exponent. */ - exp2 = (unsigned long) mpz_get_d (i->value.integer); - mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); + exp2 = mpz_get_si (i->value.integer); + mpfr_mul_2si (result->value.real, frac, exp2, GFC_RND_MODE); - mpfr_clears (absv, log2, pow2, frac, NULL); + mpfr_clears (absv, log2, exp, pow2, frac, NULL); return range_check (result, "SET_EXPONENT"); } diff --git a/gcc/testsuite/gfortran.dg/set_exponent_1.f90 b/gcc/testsuite/gfortran.dg/set_exponent_1.f90 new file mode 100644 index 00000000000..4c063e8330b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/set_exponent_1.f90 @@ -0,0 +1,36 @@ +! { dg-do run } +! PR fortran/109511 +! Check compile-time simplification of SET_EXPONENT against runtime + +program exponent + implicit none + integer :: i + i = 0 + print *, i, set_exponent(1., 0), set_exponent(1., i) + if (set_exponent(1., 0) /= set_exponent(1., i)) stop 1 + i = 1 + print *, i, set_exponent(1., 1), set_exponent(1., i) + if (set_exponent(1., 1) /= set_exponent(1., i)) stop 2 + i = 2 + print *, i, set_exponent(-1.75, 2), set_exponent(-1.75, i) + if (set_exponent(-1.75, 2) /= set_exponent(-1.75, i)) stop 3 + print *, i, set_exponent(0.1875, 2), set_exponent(0.1875, i) + if (set_exponent(0.1875, 2) /= set_exponent(0.1875, i)) stop 4 + i = 3 + print *, i, set_exponent(0.75, 3), set_exponent(0.75, i) + if (set_exponent(0.75, 3) /= set_exponent(0.75, i)) stop 5 + i = 4 + print *, i, set_exponent(-2.5, 4), set_exponent(-2.5, i) + if (set_exponent(-2.5, 4) /= set_exponent(-2.5, i)) stop 6 + i = -1 + print *, i, set_exponent(1., -1), set_exponent(1., i) + if (set_exponent(1., -1) /= set_exponent(1., i)) stop 7 + i = -2 + print *, i, set_exponent(1.125, -2), set_exponent(1.125, i) + if (set_exponent(1.125, -2) /= set_exponent(1.125, i)) stop 8 + print *, i, set_exponent(-0.25, -2), set_exponent(-0.25, i) + if (set_exponent(-0.25, -2) /= set_exponent(-0.25, i)) stop 9 + i = -3 + print *, i, set_exponent(0.75, -3), set_exponent(0.75, i) + if (set_exponent(0.75, -3) /= set_exponent(0.75, i)) stop 10 +end program exponent -- 2.35.3