From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id 658C93858C98; Tue, 5 Mar 2024 21:23:53 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 658C93858C98 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 658C93858C98 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.19 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709673836; cv=none; b=qzYXQ4PvlCnHZHQaXkm76T7D3Z9aiD4oZdH/tg9dMnDEEthp4b+ablAzRDBbjevuiO4LBIKzVrlS7Bvcq4/bJkg9iuZ2IkkZ6fMN/pUuH4HWJfNXuK7uIvboHzKT37PJBmPAF4+8hm7CCUUt2cWKxM0phV39MTyUUeMThZSuK08= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1709673836; c=relaxed/simple; bh=a/JtsI9wOm+qc8iqgXyGL3UM7nlr3FaVMXNflsWxyKs=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=Q7HQWdcSuWa24XO4nTFjkPQp4gcQ9T4m/0qBHmutspYVSiUO229zMGSjDkL+X6+YJV023CLyPuy6Hs1kB+L8SJc7SR3c+oOSH5LlatKxBCEY6QUlNrQ9I0mEIsWd3l2SSVIRtf11ooIjmjarzMpQgncqqiF7NPe0XNLKt3w2X3E= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1709673832; x=1710278632; i=anlauf@gmx.de; bh=a/JtsI9wOm+qc8iqgXyGL3UM7nlr3FaVMXNflsWxyKs=; h=X-UI-Sender-Class:From:To:Subject:Date; b=jVC89yAd+mPiv1Q3uq2qFezNv120nFGqE55iDe0jYV1CGeCkzEeEQ2+ZzAOQYQ95 TNRQ4hhvC2MRwmNxgZBXX9X34pR82FUdTS6An8XOrw0b8hi8pK3vfmOESr3B177Bv jtVb3JgcjoMe5I3x62MEUfl5hhdZpRF+fgI2Vv92yDUA8eaNwm1DIQ5IAN8yUFvKF DwuSoyz7HN732Q/1OB/rYfMXSIqIQut4yKB06I1X8OnBxKmwgpSoPytoKrMB8Q75X WTgog/YJKARw38khFHCQdsAkcrH2zDiT+PpglZnEbHocC2Ycstc3ozvhi7difXw+W iYKAt+l+fpk5puDNYg== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.148.95] ([79.232.148.95]) by web-mail.gmx.net (3c-app-gmx-bs32.server.lan [172.19.170.84]) (via HTTP); Tue, 5 Mar 2024 22:23:52 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: error recovery while simplifying expressions [PR103707,PR106987] Content-Type: multipart/mixed; boundary=rekceb-868325ae-aa95-4284-b15a-c45091b8077c Date: Tue, 5 Mar 2024 22:23:52 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:wTh6c8PzxrtZROM/SP3xpetQX7Gf3dhUR/VoYenpiXUioOSYSfWfe58IhlDK0IHnMhEvc DUVGMivto7YVc/k0jd3T7xb8QkOZeItjdKaOdpa2qHJv+I54EROA0GiiQIn/8eQxHXpPywgthRBm J2b4mUFy3MrN9QFxG+QPEeDagl+RG4uSnVLjic3unhDRnzoVGQRfXECTNr8eVZEndlMNfXkXhd7i TBmAJ+pyjqjyT1LsF8WyV+Q/tv+Jd4K9t/jo7LDOJkR+vrTKKnaw9+UzDNby3FpUoTfiG2KOU+GS IA= UI-OutboundReport: notjunk:1;M01:P0:UEmbrvrmpOU=;rro2AXM83APiPPQ1dTUQLWuOTwt yjbgMc3ss+pJmU051i9NwKaGhJVg5WdO/BpB3nU3a/ZUjpaSvS2NCjZSbVhHnh+Ww+KpTkkpi VGFTiKkuELDjTGp/7FpRXbMzqqEas3RX7SplU8+rj/kB2ZfrbNZ/JCs4pwKvPfW6ZIKwK0HOq xMP+IoFG1lWok/HZmbGTrmAmmVvon3Lm+SlZtVOZ46pJh1eKOpji0IsODzV4BVqma7zK0KRNh 5FI4yghfiKyzk/ajydqB9P4GjDud8BLqaaPpHqIH06gg2+lqSmUhUj9LX3FTmz71ORpQNmYVJ jMMAgbjfUoJsEg+uFDJoUprLTJqKjk6VSeo6D14o4e9OBtZWeLovvCBlpenCYisPk4Rx+jxCw P27k/8qxTYIzI8wrsdjTEgynb+uXpFFFsZjhiYnlh/p6LhJlFuSVnpzRMd+kYPjz1/y1BOu1H DdQzrvvPomdUwIOnXkFqMm3INqHneVGsqC69/afsw6GZULX7Q2s9Lt4fVydb9494kBQVO0Jf3 I+6vQaFpcLvynChsaOtX5sO34Xz6BlMasB2MAbyjTk7mHNl/ImadHFlmzTfbfBJwgphnzcWWP E+FRe1ywoaT8cpvAxiOWWN+d4OFsufWEIRq3TAUJeDzimWadQR0viiUGE2vRn06/fYMO8n+RY cFzHLDYkCTyUPAL+xPZ8AYN9eoP6wDZpfQSjiCD0inOPaU8XQqkph6miufjSLMs= 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_H3,RCVD_IN_MSPIKE_WL,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-868325ae-aa95-4284-b15a-c45091b8077c Content-Type: text/plain; charset=UTF-8 Dear all, error recovery on arithmetic errors during simplification has bugged me for a long time, especially since the occurence of ICEs depended on whether -frange-check is specified or not, whether array ctors were involved, etc. I've now come up with the attached patch that classifies the arithmetic result codes into "hard" and "soft" errors. A "soft" error means that it is an overflow or other exception (e.g. NaN) that is ignored with -fno-range-check. After the patch, a soft error will not stop simplification (a hard one will), and error status will be passed along. I took this opportunity to change the emitted error for division by zero for real and complex division dependent on whether the numerator is regular or not. This makes e.g. (0.)/0 a NaN and now says so, in accordance with some other brands. Regtested on x86_64-pc-linux-gnu. OK for mainline? Other comments? Thanks, Harald --rekceb-868325ae-aa95-4284-b15a-c45091b8077c Content-Type: text/x-patch Content-Disposition: attachment; filename=pr106987.diff Content-Transfer-Encoding: quoted-printable =46rom d9b87bea6af77fbc794e1f21cfecb0468c68cb72 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 5 Mar 2024 21:54:26 +0100 Subject: [PATCH] Fortran: error recovery while simplifying expressions [PR103707,PR106987] When an exception is encountered during simplification of arithmetic expressions, the result may depend on whether range-checking is active (-frange-check) or not. However, the code path in the front-end should stay the same for "soft" errors for which the exception is triggered by th= e check, while "hard" errors should always terminate the simplification, so that error recovery is independent of the flag. Separation of arithmetic error codes into "hard" and "soft" errors shall be done consistently via is_hard_arith_error(). PR fortran/103707 PR fortran/106987 gcc/fortran/ChangeLog: * arith.cc (is_hard_arith_error): New helper function to determine whether an arithmetic error is "hard" or not. (check_result): Use it. (gfc_arith_divide): Set "Division by zero" only for regular numerators of real and complex divisions. (reduce_unary): Use is_hard_arith_error to determine whether a hard or (recoverable) soft error was encountered. Terminate immediately on hard error, otherwise remember code of first soft error. (reduce_binary_ac): Likewise. (reduce_binary_ca): Likewise. (reduce_binary_aa): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/pr99350.f90: * gfortran.dg/arithmetic_overflow_3.f90: New test. =2D-- gcc/fortran/arith.cc | 134 ++++++++++++------ .../gfortran.dg/arithmetic_overflow_3.f90 | 48 +++++++ gcc/testsuite/gfortran.dg/pr99350.f90 | 2 +- 3 files changed, 143 insertions(+), 41 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/arithmetic_overflow_3.f90 diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index d17d1aaa1d9..b373c25e5e1 100644 =2D-- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -130,6 +130,30 @@ gfc_arith_error (arith code) } +/* Check if a certain arithmetic error code is severe enough to prevent + further simplification, as opposed to errors thrown by the range check + (e.g. overflow) or arithmetic exceptions that are tolerated with + -fno-range-check. */ + +static bool +is_hard_arith_error (arith code) +{ + switch (code) + { + case ARITH_OK: + case ARITH_OVERFLOW: + case ARITH_UNDERFLOW: + case ARITH_NAN: + case ARITH_DIV0: + case ARITH_ASYMMETRIC: + return false; + + default: + return true; + } +} + + /* Get things ready to do math. */ void @@ -579,10 +603,10 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r, gf= c_expr **rp) val =3D ARITH_OK; } - if (val =3D=3D ARITH_OK || val =3D=3D ARITH_OVERFLOW) - *rp =3D r; - else + if (is_hard_arith_error (val)) gfc_free_expr (r); + else + *rp =3D r; return val; } @@ -792,23 +816,26 @@ gfc_arith_divide (gfc_expr *op1, gfc_expr *op2, gfc_= expr **resultp) break; case BT_REAL: - if (mpfr_sgn (op2->value.real) =3D=3D 0 && flag_range_check =3D=3D = 1) - { - rc =3D ARITH_DIV0; - break; - } + /* Set "Division by zero" only for regular numerator. */ + if (flag_range_check =3D=3D 1 + && mpfr_zero_p (op2->value.real) + && mpfr_regular_p (op1->value.real)) + rc =3D ARITH_DIV0; mpfr_div (result->value.real, op1->value.real, op2->value.real, GFC_RND_MODE); break; case BT_COMPLEX: - if (mpc_cmp_si_si (op2->value.complex, 0, 0) =3D=3D 0 - && flag_range_check =3D=3D 1) - { - rc =3D ARITH_DIV0; - break; - } + /* Set "Division by zero" only for regular numerator. */ + if (flag_range_check =3D=3D 1 + && mpfr_zero_p (mpc_realref (op2->value.complex)) + && mpfr_zero_p (mpc_imagref (op2->value.complex)) + && ((mpfr_regular_p (mpc_realref (op1->value.complex)) + && mpfr_number_p (mpc_imagref (op1->value.complex))) + || (mpfr_regular_p (mpc_imagref (op1->value.complex)) + && mpfr_number_p (mpc_realref (op1->value.complex))))) + rc =3D ARITH_DIV0; gfc_set_model (mpc_realref (op1->value.complex)); if (mpc_cmp_si_si (op2->value.complex, 0, 0) =3D=3D 0) @@ -1323,7 +1350,6 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **= ), gfc_expr *op, gfc_constructor *c; gfc_expr *r; arith rc; - bool ov =3D false; if (op->expr_type =3D=3D EXPR_CONSTANT) return eval (op, result); @@ -1335,19 +1361,22 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr = **), gfc_expr *op, head =3D gfc_constructor_copy (op->value.constructor); for (c =3D gfc_constructor_first (head); c; c =3D gfc_constructor_next = (c)) { - rc =3D reduce_unary (eval, c->expr, &r); + arith rc_tmp =3D reduce_unary (eval, c->expr, &r); - /* Remember any overflow encountered during reduction and continue, - but terminate on serious errors. */ - if (rc =3D=3D ARITH_OVERFLOW) - ov =3D true; - else if (rc !=3D ARITH_OK) - break; + /* Remember first recoverable ("soft") error encountered during + reduction and continue, but terminate on serious errors. */ + if (is_hard_arith_error (rc_tmp)) + { + rc =3D rc_tmp; + break; + } + else if (rc_tmp !=3D ARITH_OK && rc =3D=3D ARITH_OK) + rc =3D rc_tmp; gfc_replace_expr (c->expr, r); } - if (rc !=3D ARITH_OK && rc !=3D ARITH_OVERFLOW) + if (is_hard_arith_error (rc)) gfc_constructor_free (head); else { @@ -1368,7 +1397,7 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **= ), gfc_expr *op, *result =3D r; } - return ov ? ARITH_OVERFLOW : rc; + return rc; } @@ -1384,22 +1413,31 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_e= xpr *, gfc_expr **), head =3D gfc_constructor_copy (op1->value.constructor); for (c =3D gfc_constructor_first (head); c; c =3D gfc_constructor_next = (c)) { + arith rc_tmp; + gfc_simplify_expr (c->expr, 0); if (c->expr->expr_type =3D=3D EXPR_CONSTANT) - rc =3D eval (c->expr, op2, &r); + rc_tmp =3D eval (c->expr, op2, &r); else if (c->expr->expr_type !=3D EXPR_ARRAY) - rc =3D ARITH_NOT_REDUCED; + rc_tmp =3D ARITH_NOT_REDUCED; else - rc =3D reduce_binary_ac (eval, c->expr, op2, &r); + rc_tmp =3D reduce_binary_ac (eval, c->expr, op2, &r); - if (rc !=3D ARITH_OK) - break; + /* Remember first recoverable ("soft") error encountered during + reduction and continue, but terminate on serious errors. */ + if (is_hard_arith_error (rc_tmp)) + { + rc =3D rc_tmp; + break; + } + else if (rc_tmp !=3D ARITH_OK && rc =3D=3D ARITH_OK) + rc =3D rc_tmp; gfc_replace_expr (c->expr, r); } - if (rc !=3D ARITH_OK) + if (is_hard_arith_error (rc)) gfc_constructor_free (head); else { @@ -1438,22 +1476,31 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_e= xpr *, gfc_expr **), head =3D gfc_constructor_copy (op2->value.constructor); for (c =3D gfc_constructor_first (head); c; c =3D gfc_constructor_next = (c)) { + arith rc_tmp; + gfc_simplify_expr (c->expr, 0); if (c->expr->expr_type =3D=3D EXPR_CONSTANT) - rc =3D eval (op1, c->expr, &r); + rc_tmp =3D eval (op1, c->expr, &r); else if (c->expr->expr_type !=3D EXPR_ARRAY) - rc =3D ARITH_NOT_REDUCED; + rc_tmp =3D ARITH_NOT_REDUCED; else - rc =3D reduce_binary_ca (eval, op1, c->expr, &r); + rc_tmp =3D reduce_binary_ca (eval, op1, c->expr, &r); - if (rc !=3D ARITH_OK) - break; + /* Remember first recoverable ("soft") error encountered during + reduction and continue, but terminate on serious errors. */ + if (is_hard_arith_error (rc_tmp)) + { + rc =3D rc_tmp; + break; + } + else if (rc_tmp !=3D ARITH_OK && rc =3D=3D ARITH_OK) + rc =3D rc_tmp; gfc_replace_expr (c->expr, r); } - if (rc !=3D ARITH_OK) + if (is_hard_arith_error (rc)) gfc_constructor_free (head); else { @@ -1503,10 +1550,17 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_e= xpr *, gfc_expr **), c && d; c =3D gfc_constructor_next (c), d =3D gfc_constructor_next (d)) { - rc =3D reduce_binary (eval, c->expr, d->expr, &r); + arith rc_tmp =3D reduce_binary (eval, c->expr, d->expr, &r); - if (rc !=3D ARITH_OK) - break; + /* Remember first recoverable ("soft") error encountered during + reduction and continue, but terminate on serious errors. */ + if (is_hard_arith_error (rc_tmp)) + { + rc =3D rc_tmp; + break; + } + else if (rc_tmp !=3D ARITH_OK && rc =3D=3D ARITH_OK) + rc =3D rc_tmp; gfc_replace_expr (c->expr, r); } @@ -1514,7 +1568,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_exp= r *, gfc_expr **), if (rc =3D=3D ARITH_OK && (c || d)) rc =3D ARITH_INCOMMENSURATE; - if (rc !=3D ARITH_OK) + if (is_hard_arith_error (rc)) gfc_constructor_free (head); else { diff --git a/gcc/testsuite/gfortran.dg/arithmetic_overflow_3.f90 b/gcc/tes= tsuite/gfortran.dg/arithmetic_overflow_3.f90 new file mode 100644 index 00000000000..4dc552742a3 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/arithmetic_overflow_3.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! { dg-additional-options "-frange-check" } +! +! PR fortran/103707 +! PR fortran/106987 +! +! Check error recovery on arithmetic exceptions + +program p + implicit none + integer, parameter :: a(3) =3D [30,31,32] + integer, parameter :: e(1) =3D 2 + print *, 2 ** a ! { dg-error "Arithmetic overflow" } + print *, e ** 31 ! { dg-error "Arithmetic overflow" } +end + +! { dg-prune-output "Result of exponentiation" } + +subroutine s + implicit none + real, parameter :: inf =3D real (z'7F800000') + real, parameter :: nan =3D real (z'7FC00000') + + ! Unary operators + print *, -[inf,nan] ! { dg-error "Arithmetic overflow" } + print *, -[nan,inf] ! { dg-error "Arithmetic NaN" } + + ! Binary operators + print *, [1.]/[0.] ! { dg-error "Division by zero" } + print *, [0.]/[0.] ! { dg-error "Arithmetic NaN" } + print *, 0. / [(0.,0.)] ! { dg-error "Arithmetic NaN" } + print *, [1.,0.]/[0.,0.] ! { dg-error "Division by zero" } + print *, [(1.,1.)]/[0.] ! { dg-error "Division by zero" } + print *, [(1.,0.)]/[0.] ! { dg-error "Division by zero" } + print *, [(0.,0.)]/[0.] ! { dg-error "Arithmetic NaN" } + print *, - [1./0.]/[0.] ! { dg-error "Division by zero" } + print *, - [ 1/0 ] * 1 ! { dg-error "Division by zero" } + + ! Binary operators, exceptional input + print *, 1. / nan ! { dg-error "Arithmetic NaN" } + print *, [inf] / inf ! { dg-error "Arithmetic NaN" } + print *, inf + [nan] ! { dg-error "Arithmetic NaN" } + print *, [(1.,0.)]/[(nan,0.)] ! { dg-error "Arithmetic NaN" } + print *, [(1.,0.)]/[(0.,nan)] ! { dg-error "Arithmetic NaN" } + print *, [(1.,0.)]/[(inf,0.)] ! OK + print *, [nan,inf] / (0.) ! { dg-error "Arithmetic NaN" } + print *, [inf,nan] / (0.) ! { dg-error "Arithmetic overflow" } +end diff --git a/gcc/testsuite/gfortran.dg/pr99350.f90 b/gcc/testsuite/gfortra= n.dg/pr99350.f90 index 7f751b9fdcc..ec198810f1c 100644 =2D-- a/gcc/testsuite/gfortran.dg/pr99350.f90 +++ b/gcc/testsuite/gfortran.dg/pr99350.f90 @@ -7,7 +7,7 @@ program p character(:), pointer :: a end type type(t) :: z - character((0.)/0), target :: c =3D 'abc' ! { dg-error "Division by zer= o" } + character((0.)/0), target :: c =3D 'abc' ! { dg-error "Arithmetic NaN"= } z%a =3D> c ! The associate statement was not needed to trigger the ICE. associate (y =3D> z%a) =2D- 2.35.3 --rekceb-868325ae-aa95-4284-b15a-c45091b8077c--