From: Arnaud Charlet <charlet@adacore.com>
Date: Tue, 14 Jan 2020 13:21:20 +0000 (-0500)
Subject: [Ada] Add detection of uninitialized big reals
X-Git-Tag: basepoints/gcc-12~7389
X-Git-Url: http://git.ipfire.org/?p=thirdparty%2Fgcc.git;a=commitdiff_plain;h=3f06f6c30a8c168388886c13785597e56b398981

[Ada] Add detection of uninitialized big reals

2020-06-03  Arnaud Charlet  <charlet@adacore.com>

gcc/ada/

	* libgnat/a-nbnbin.ads: Minor reformatting.
	* libgnat/a-nbnbre.ads, libgnat/a-nbnbre.adb (Is_Valid): Add
	convention Intrinsic. Add detection of uninitialized big reals.
---

diff --git a/gcc/ada/libgnat/a-nbnbin.ads b/gcc/ada/libgnat/a-nbnbin.ads
index a54b09f6ab90..4c1a22c2e4df 100644
--- a/gcc/ada/libgnat/a-nbnbin.ads
+++ b/gcc/ada/libgnat/a-nbnbin.ads
@@ -13,9 +13,9 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Finalization;
 with Ada.Streams;
 
+private with Ada.Finalization;
 private with System;
 
 --  Note that some Ada 2020 aspects are commented out since they are not
@@ -89,7 +89,7 @@ is
 
    end Unsigned_Conversions;
 
-   function To_String (Arg : Big_Integer;
+   function To_String (Arg   : Big_Integer;
                        Width : Field := 0;
                        Base  : Number_Base := 10) return String
      with Post => To_String'Result'First = 1;
diff --git a/gcc/ada/libgnat/a-nbnbre.adb b/gcc/ada/libgnat/a-nbnbre.adb
index a2b40f73cd8e..07a94424df15 100644
--- a/gcc/ada/libgnat/a-nbnbre.adb
+++ b/gcc/ada/libgnat/a-nbnbre.adb
@@ -46,7 +46,7 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    --------------
 
    function Is_Valid (Arg : Big_Real) return Boolean is
-     (Is_Valid (Arg.Num) and then Is_Valid (Arg.Den));
+     (Is_Valid (Arg.Num) and Is_Valid (Arg.Den));
 
    ---------
    -- "/" --
@@ -69,13 +69,17 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    -- Numerator --
    ---------------
 
-   function Numerator (Arg : Big_Real) return Big_Integer is (Arg.Num);
+   function Numerator (Arg : Big_Real) return Big_Integer is
+     (if Is_Valid (Arg.Num) then Arg.Num
+      else raise Constraint_Error with "invalid big real");
 
    -----------------
    -- Denominator --
    -----------------
 
-   function Denominator (Arg : Big_Real) return Big_Positive is (Arg.Den);
+   function Denominator (Arg : Big_Real) return Big_Positive is
+     (if Is_Valid (Arg.Den) then Arg.Den
+      else raise Constraint_Error with "invalid big real");
 
    ---------
    -- "=" --
@@ -409,6 +413,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "+" (L : Big_Real) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       Result.Num := L.Num;
       Result.Den := L.Den;
       return Result;
@@ -419,14 +427,16 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    ---------
 
    function "-" (L : Big_Real) return Big_Real is
-     (Num => -L.Num, Den => L.Den);
+     (if Is_Valid (L) then (Num => -L.Num, Den => L.Den)
+      else raise Constraint_Error with "invalid big real");
 
    -----------
    -- "abs" --
    -----------
 
    function "abs" (L : Big_Real) return Big_Real is
-     (Num => abs L.Num, Den => L.Den);
+     (if Is_Valid (L) then (Num => abs L.Num, Den => L.Den)
+      else raise Constraint_Error with "invalid big real");
 
    ---------
    -- "+" --
@@ -435,6 +445,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "+" (L, R : Big_Real) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) or not Is_Valid (R) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       Result.Num := L.Num * R.Den + R.Num * L.Den;
       Result.Den := L.Den * R.Den;
       Normalize (Result);
@@ -448,6 +462,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "-" (L, R : Big_Real) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) or not Is_Valid (R) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       Result.Num := L.Num * R.Den - R.Num * L.Den;
       Result.Den := L.Den * R.Den;
       Normalize (Result);
@@ -461,6 +479,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "*" (L, R : Big_Real) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) or not Is_Valid (R) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       Result.Num := L.Num * R.Num;
       Result.Den := L.Den * R.Den;
       Normalize (Result);
@@ -474,6 +496,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "/" (L, R : Big_Real) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) or not Is_Valid (R) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       Result.Num := L.Num * R.Den;
       Result.Den := L.Den * R.Num;
       Normalize (Result);
@@ -487,6 +513,10 @@ package body Ada.Numerics.Big_Numbers.Big_Reals is
    function "**" (L : Big_Real; R : Integer) return Big_Real is
       Result : Big_Real;
    begin
+      if not Is_Valid (L) then
+         raise Constraint_Error with "invalid big real";
+      end if;
+
       if R = 0 then
          Result.Num := To_Big_Integer (1);
          Result.Den := To_Big_Integer (1);
diff --git a/gcc/ada/libgnat/a-nbnbre.ads b/gcc/ada/libgnat/a-nbnbre.ads
index 4827caae3e38..3ea93f62291e 100644
--- a/gcc/ada/libgnat/a-nbnbre.ads
+++ b/gcc/ada/libgnat/a-nbnbre.ads
@@ -27,7 +27,8 @@ is
 --   with Real_Literal => From_String,
 --        Put_Image    => Put_Image;
 
-   function Is_Valid (Arg : Big_Real) return Boolean;
+   function Is_Valid (Arg : Big_Real) return Boolean
+     with Convention => Intrinsic;
 
    function "/" (Num, Den : Big_Integers.Big_Integer) return Big_Real;
 --   with Pre => (if Big_Integers."=" (Den, Big_Integers.To_Big_Integer (0))