From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id 6C64A3858409; Fri, 14 Apr 2023 18:58:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 6C64A3858409 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1681498695; i=anlauf@gmx.de; bh=miy/6EmTlnDg23MC8kX8B2kDSLqwoEWUUAC4h2GTfbo=; h=X-UI-Sender-Class:From:To:Date; b=lvQXWAlkFb2o8S/7Ac97VQde7AjzDHOOGgcffxmqw5NIYNXBXLa07LwNzjdKhhzoA s0P0UfgyafTrLz9OvTVSi2N9arAjmHxyO8ho1eezkiG2KsrIFoMdfIWLaI1GooWvce uwvPpFrYMwRlzOzzJWM8HrwaNdeG4HPtSFOIdUSZfsClViBaOkFVb0NCVxHLMTBiVG NowKrxI8EvDvkHAeXjnQhDIBN5iHkj6WpaaTusLSQVSmmR9lHkH7K6FNDsZtLyxRXk Q2tsrNN0VVVTBkwUg1jQNEQ6N+hJEhAGqJmYaJvesC/L75QM6OzriKIHsMQmu4Ht6n 4b+nNXkSmGrgg== 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:58:15 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Content-Type: multipart/mixed; boundary=rekceb-3b76e115-be73-4b90-9541-67bed15cc681 Date: Fri, 14 Apr 2023 20:58:15 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:6MsNylzPuxtE7ZxtSTrEWCVtm+Z4kMJBZhTQDD+CF1U+k0IkY85UtwqKWcv0xfI4Iagmn nxAorjUBeE7hk1cXGUs/RyHsTyxa49M3cHXQdtHMPeE/40NFwe+1bWRcbfJu/0HLyt9q5M9541eD 9YvjbVdYTCjs2e0m44KtdtviZbEmunQAS5XOS0u/JVEFx9fehZf8dE4IvrsJzLHmp5b/q9HgGOOV 1eJSO0H5G/WECIq7jfLUMjsar4Q6x6GVHh1k6v1Q8QYN01kwj7ivj0TVpO6/c2TlXy89fmAPM3S9 Vg= UI-OutboundReport: notjunk:1;M01:P0:0RB56NpR6XA=;1+YFInTmB4JqYqbpqy86bwzsMnE a+k3nWUlEN0xHEvL6O06KEw6NZP6LCd04HDbKx311gfd6MDD08q/NbhqhUDeQ6EJLmC57VcPM IL66ZwAU3Wc7/g5W8anNLhCw2/PA039BEPPyEyl5pgtjjrD+gIpc4gTVprypzyt4Zp/zQTi5q kfSK8475f5QusmAk962HG8HkgjZ1fvq/IIY5pqh/jfDWMt0tU/ws9lmkhXoRMUOne8se5plWO NuOuxlXQJjYorR1fkMOE+1glK9flYeC6tiOdJcU4AUZArparFdg91ErQweKtIvPOYtKRNvQju TK61TlUK3dxM6ahQCfh+f133wUl2T3UmQfNKWqq9zwNTHhemXs1pY/5yEB92lBMcQWYaOe4cZ zUqBFjMrsUpILQP50+imgOww8GecB0WVgCBS9wcN2mvqoJ8BTyShXKElyAzvUH5Yq/Qvb3/Pk h3Ad1VXmxdFI1LJQ1eAW+2jcU38HJy7E52q68c0SGA6fP4SXo1iXC7UXx+uLkA7hm9zZNYmYx iDgdJ+hhK0tv+tU9gTm/HqfsrJ3NUowURFBaJVAKNdwer2hvKVFVdajDVM1zJh7vS7lcpch21 4OF5Rt+CAP6UQchrVw+aB0PLylo39JDmX2jOD3WLVDq1xj1shxZsmjdqnQdmP9rU6IPOkC17b 608d33sEZVnkSPw3n2Lx37nl9UxBdGgmlNHgU86rB88MwBdOO98HPp/9xlYjKyMTOLYo0JDwn 1HPkY8OYgALLZSmIVMu0LJDH4U90GjYYHE5TJtq3+sTGNhSs0bDTLmgylVuBCUX98cMoA+PPQ tJ9mJLeCpbbBMhshmx7YXjvw== X-Spam-Status: No, score=-11.1 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,KAM_BLANKSUBJECT,MISSING_SUBJECT,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 List-Id: --rekceb-3b76e115-be73-4b90-9541-67bed15cc681 Content-Type: text/plain; charset=UTF-8 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 --rekceb-3b76e115-be73-4b90-9541-67bed15cc681 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr109511.diff Content-Transfer-Encoding: quoted-printable =46rom 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. =2D-- 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 =2D-- 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 !=3D EXPR_CONSTANT || i->expr_type !=3D 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 =3D (unsigned long) mpz_get_d (i->value.integer); - mpfr_mul_2exp (result->value.real, frac, exp2, GFC_RND_MODE); + exp2 =3D 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 =2D-- /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 =3D 0 + print *, i, set_exponent(1., 0), set_exponent(1., i) + if (set_exponent(1., 0) /=3D set_exponent(1., i)) stop 1 + i =3D 1 + print *, i, set_exponent(1., 1), set_exponent(1., i) + if (set_exponent(1., 1) /=3D set_exponent(1., i)) stop 2 + i =3D 2 + print *, i, set_exponent(-1.75, 2), set_exponent(-1.75, i) + if (set_exponent(-1.75, 2) /=3D 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) /=3D set_exponent(0.1875, i)) stop 4 + i =3D 3 + print *, i, set_exponent(0.75, 3), set_exponent(0.75, i) + if (set_exponent(0.75, 3) /=3D set_exponent(0.75, i)) stop 5 + i =3D 4 + print *, i, set_exponent(-2.5, 4), set_exponent(-2.5, i) + if (set_exponent(-2.5, 4) /=3D set_exponent(-2.5, i)) stop 6 + i =3D -1 + print *, i, set_exponent(1., -1), set_exponent(1., i) + if (set_exponent(1., -1) /=3D set_exponent(1., i)) stop 7 + i =3D -2 + print *, i, set_exponent(1.125, -2), set_exponent(1.125, i) + if (set_exponent(1.125, -2) /=3D 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) /=3D set_exponent(-0.25, i)) stop 9 + i =3D -3 + print *, i, set_exponent(0.75, -3), set_exponent(0.75, i) + if (set_exponent(0.75, -3) /=3D set_exponent(0.75, i)) stop 10 +end program exponent =2D- 2.35.3 --rekceb-3b76e115-be73-4b90-9541-67bed15cc681--