From patchwork Mon Dec 24 19:59:50 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 1018299 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-493100-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=troutmask.apl.washington.edu Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="U+70uuc9"; 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 43Nqpb5G94z9sC7 for ; Tue, 25 Dec 2018 07:00:22 +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:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=FMEmz0bFWauytnO+tgkgK22d33oe6xKeCyti7HaZIIW s8Ut4DTnPSqC7upUOwvTa54qHt+tuBmTf17uCS9UGRlqjNY0tsXqiBJkxcvnb8OM GqlIPW5oDKZqHd/QK8mZk2gSa7SnVHmg+lPy1ySBZIFka3rSYDsw6rfcbAav6h7E = 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:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=zGApgCuHxiPK+8cBC6vWy1RGBB4=; b=U+70uuc9q6xODB6Uq /XGcMF1xREXlpriCXwoS8mJSrBReBXqpflxrnAVdzI1eDvicXI1Y00h7g4/oNrPc aZqSEbCfw1thLxhJZW4TZ6rnTtncXU+VxK2pT5/ZcExvW50ZpnoIyj0o+4PPFcCF hSabNj4+HazIp3PPyhS7dScAvA= Received: (qmail 29423 invoked by alias); 24 Dec 2018 19:59:58 -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 29405 invoked by uid 89); 24 Dec 2018 19:59:57 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-10.1 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY autolearn=ham version=3.3.2 spammy=Fortran, CLASS X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 24 Dec 2018 19:59:53 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id wBOJxpAB094090 (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384 bits=256 verify=NO); Mon, 24 Dec 2018 11:59:51 -0800 (PST) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id wBOJxoDW094089; Mon, 24 Dec 2018 11:59:50 -0800 (PST) (envelope-from sgk) Date: Mon, 24 Dec 2018 11:59:50 -0800 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] fortran/88342 -- interaction of -ffpe-trap and IEEE_VALUE Message-ID: <20181224195950.GA94080@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.10.1 (2018-07-13) All, The IEEE modules and -ffpe-trap are to some extent orthogonal features of gfortran. Unfortunately, some users have the expectation of using -ffpe-trap for debugging while also using only some of the mechanisms provided by the IEEE modules. For example, % t.f90 program test use, intrinsic :: ieee_arithmetic real :: inf inf = ieee_value(inf, ieee_positive_inf) end program test % gfc8 -o z -ffpe-trap=overflow t.f90 && ./z Floating exception (core dumped) The correct use of the module would be along the lines of program test use, intrinsic :: ieee_arithmetic real :: inf logical h call ieee_get_halting_mode(ieee_overflow, h) ! store halting mode call ieee_set_halting_mode(ieee_overflow, .false.) ! no halting inf = ieee_value(inf, ieee_positive_inf) call ieee_set_halting_mode(ieee_overflow, h) ! restore halting mode end program test Technically (as I have done in the patch), the user should also use 'ieee_support_halting(ieee_overflow)', but that's just a detail. Now, IEEE_VALUE() is specifically included in the Fortran standard to allow it to provide qNaN, sNaN, +inf, and -inf (among a few other questionable constants). The attached patch allows gfortran to generate an executable that does not abort with SIGFPE. 2018-12-24 Steven G. Kargl PR fortran/88342 * ieee/ieee_arithmetic.F90: Prevent exceptions in IEEE_VALUE if -ffpe-trap=invalid or -ffpe-trap=overflow is used. 2018-12-24 Steven G. Kargl PR fortran/88342 * gfortran.dg/ieee/ieee_10.f90: New test. Regression tested on i586-*-freebsd and x86_64-*-freebsd. OK to commit? Index: gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 =================================================================== --- gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/ieee/ieee_10.f90 (working copy) @@ -0,0 +1,32 @@ +! { dg-do run } +! { dg-options "-ffpe-trap=overflow,invalid" } +program foo + + use ieee_arithmetic + + implicit none + + real x + real(8) y + + x = ieee_value(x, ieee_signaling_nan) + if (.not. ieee_is_nan(x)) stop 1 + x = ieee_value(x, ieee_quiet_nan) + if (.not. ieee_is_nan(x)) stop 2 + + x = ieee_value(x, ieee_positive_inf) + if (ieee_is_finite(x)) stop 3 + x = ieee_value(x, ieee_negative_inf) + if (ieee_is_finite(x)) stop 4 + + y = ieee_value(y, ieee_signaling_nan) + if (.not. ieee_is_nan(y)) stop 5 + y = ieee_value(y, ieee_quiet_nan) + if (.not. ieee_is_nan(y)) stop 6 + + y = ieee_value(y, ieee_positive_inf) + if (ieee_is_finite(y)) stop 7 + y = ieee_value(y, ieee_negative_inf) + if (ieee_is_finite(y)) stop 8 + +end program foo Index: libgfortran/ieee/ieee_arithmetic.F90 =================================================================== --- libgfortran/ieee/ieee_arithmetic.F90 (revision 267415) +++ libgfortran/ieee/ieee_arithmetic.F90 (working copy) @@ -914,17 +914,39 @@ contains real(kind=4), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -941,8 +963,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -952,17 +981,39 @@ contains real(kind=8), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -979,8 +1030,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -991,17 +1049,39 @@ contains real(kind=10), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) - case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if + case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -1018,8 +1098,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select @@ -1032,17 +1119,39 @@ contains real(kind=16), intent(in) :: X type(IEEE_CLASS_TYPE), intent(in) :: CLASS + logical flag select case (CLASS%hidden) case (1) ! IEEE_SIGNALING_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (2) ! IEEE_QUIET_NAN + if (ieee_support_halting(ieee_invalid)) then + call ieee_get_halting_mode(ieee_invalid, flag) + call ieee_set_halting_mode(ieee_invalid, .false.) + end if res = -1 res = sqrt(res) + if (ieee_support_halting(ieee_invalid)) then + call ieee_set_halting_mode(ieee_invalid, flag) + end if case (3) ! IEEE_NEGATIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = (-res) * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case (4) ! IEEE_NEGATIVE_NORMAL res = -42 case (5) ! IEEE_NEGATIVE_DENORMAL @@ -1059,8 +1168,15 @@ contains case (9) ! IEEE_POSITIVE_NORMAL res = 42 case (10) ! IEEE_POSITIVE_INF + if (ieee_support_halting(ieee_overflow)) then + call ieee_get_halting_mode(ieee_overflow, flag) + call ieee_set_halting_mode(ieee_overflow, .false.) + end if res = huge(res) res = res * res + if (ieee_support_halting(ieee_overflow)) then + call ieee_set_halting_mode(ieee_overflow, flag) + end if case default ! IEEE_OTHER_VALUE, should not happen res = 0 end select