From: Ed Schonberg Date: Tue, 29 May 2018 09:42:05 +0000 (+0000) Subject: [Ada] Improper behavior of floating-point attributes X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ef22a3b26940b059888ea409a53f5a91af44887d;p=gcc.git [Ada] Improper behavior of floating-point attributes This patch fixes an error in the handling of attributes Pred qnd Succ when applied to the limit values of a floating-point type. The RM mandates that such operations must raise constraint_error, but GNAT generated in most cases an infinite value, regardless of whether overflow checks were enabled. 2018-05-29 Ed Schonberg gcc/ada/ * libgnat/s-fatgen.adb (Succ, Pred): Raise Constraint_Error unconditionally when applied to the largest positive (resp. largest negative) value of a floating-point type. gcc/testsuite/ * gnat.dg/float_attributes_overflows.adb: New testcase. From-SVN: r260882 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 86d66804b21..9c529da0d29 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-05-29 Ed Schonberg + + * libgnat/s-fatgen.adb (Succ, Pred): Raise Constraint_Error + unconditionally when applied to the largest positive (resp. largest + negative) value of a floating-point type. + 2018-05-29 Ed Schonberg * einfo.ads, einfo.adb: Clarify use of Activation_Record_Component: diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb index 41e5fe7fcf2..d74c3d80274 100644 --- a/gcc/ada/libgnat/s-fatgen.adb +++ b/gcc/ada/libgnat/s-fatgen.adb @@ -415,16 +415,7 @@ package body System.Fat_Gen is elsif X = T'First then - -- If not generating infinities, we raise a constraint error - - if T'Machine_Overflows then - raise Constraint_Error with "Pred of largest negative number"; - - -- Otherwise generate a negative infinity - - else - return X / (X - X); - end if; + raise Constraint_Error with "Pred of largest negative number"; -- For infinities, return unchanged @@ -671,15 +662,10 @@ package body System.Fat_Gen is -- If not generating infinities, we raise a constraint error - if T'Machine_Overflows then - raise Constraint_Error with "Succ of largest negative number"; + raise Constraint_Error with "Succ of largest positive number"; -- Otherwise generate a positive infinity - else - return X / (X - X); - end if; - -- For infinities, return unchanged elsif X < T'First or else X > T'Last then diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 947dfc28565..bce064a523d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-29 Ed Schonberg + + * gnat.dg/float_attributes_overflows.adb: New testcase. + 2018-05-29 Pascal Obry * gnat.dg/normalize_pathname.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/float_attributes_overflows.adb b/gcc/testsuite/gnat.dg/float_attributes_overflows.adb new file mode 100644 index 00000000000..becee151d2a --- /dev/null +++ b/gcc/testsuite/gnat.dg/float_attributes_overflows.adb @@ -0,0 +1,35 @@ +-- { dg-do run } + +procedure Float_Attributes_Overflows is + + generic + type Float_Type is digits <>; + procedure Test_Float_Type; + + procedure Test_Float_Type is + Biggest_Positive_float : Float_Type := Float_Type'Last; + Biggest_Negative_Float : Float_Type := Float_Type'First; + Float_Var : Float_Type; + + begin + begin + Float_Var := Float_Type'succ (Biggest_Positive_Float); + raise Program_Error; + exception + when Constraint_Error => null; + end; + + begin + Float_Var := Float_Type'pred (Biggest_Negative_Float); + raise Program_Error; + exception + when Constraint_Error => null; + end; + end Test_Float_Type; + + procedure Test_Float is new Test_Float_Type (Float); + procedure Test_Long_Float is new Test_Float_Type (Long_Float); +begin + Test_Float; + Test_Long_Float; +end Float_Attributes_Overflows;