From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 16 Dec 2016 12:21:45 +0000 (+0000)
Subject: opt61.adb: New test.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cc0ca4999b681022fe5a409d187d4af2f86adff2;p=gcc.git

opt61.adb: New test.

	* gnat.dg/opt61.adb: New test.
	* gnat.dg/opt61_pkg.ad[sb]: New helper.

From-SVN: r243740
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8aa1ad9fd5b..afd90ee71d1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-12-16  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/opt61.adb: New test.
+	* gnat.dg/opt61_pkg.ad[sb]: New helper.
+
 2016-12-16  Richard Biener  <rguenther@suse.de>
 
 	PR c++/71694
diff --git a/gcc/testsuite/gnat.dg/opt61.adb b/gcc/testsuite/gnat.dg/opt61.adb
new file mode 100644
index 00000000000..09d5cdc385c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt61.adb
@@ -0,0 +1,21 @@
+-- { dg-do run }
+-- { dg-options "-O2" }
+
+with Interfaces;
+with Opt61_Pkg; use Opt61_Pkg;
+
+procedure Opt61 is
+
+   use type Interfaces.Integer_64;
+
+   X : constant Int64 := 3125;
+   Y : constant Int64 := 5;
+   Z : constant Int64 := 10;
+   Q, R: Int64;
+
+begin
+   Double_Divide (X, Y, Z, Q, R, False);
+   if R /= 25 then
+     raise Program_Error;
+   end if;
+end;
diff --git a/gcc/testsuite/gnat.dg/opt61_pkg.adb b/gcc/testsuite/gnat.dg/opt61_pkg.adb
new file mode 100644
index 00000000000..c35f703ffde
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt61_pkg.adb
@@ -0,0 +1,132 @@
+with Interfaces; use Interfaces;
+
+with Ada.Unchecked_Conversion;
+
+package body Opt61_Pkg is
+
+   pragma Suppress (Overflow_Check);
+   pragma Suppress (Range_Check);
+
+   subtype Uns64 is Unsigned_64;
+
+   function To_Int is new Ada.Unchecked_Conversion (Uns64, Int64);
+
+   subtype Uns32 is Unsigned_32;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function "+" (A : Uns64; B : Uns32) return Uns64 is (A + Uns64 (B));
+   --  Length doubling additions
+
+   function "*" (A, B : Uns32) return Uns64 is (Uns64 (A) * Uns64 (B));
+   --  Length doubling multiplication
+
+   function "&" (Hi, Lo : Uns32) return Uns64 is
+     (Shift_Left (Uns64 (Hi), 32) or Uns64 (Lo));
+   --  Concatenate hi, lo values to form 64-bit result
+
+   function "abs" (X : Int64) return Uns64 is
+     (if X = Int64'First then 2**63 else Uns64 (Int64'(abs X)));
+   --  Convert absolute value of X to unsigned. Note that we can't just use
+   --  the expression of the Else, because it overflows for X = Int64'First.
+
+   function Lo (A : Uns64) return Uns32 is (Uns32 (A and 16#FFFF_FFFF#));
+   --  Low order half of 64-bit value
+
+   function Hi (A : Uns64) return Uns32 is (Uns32 (Shift_Right (A, 32)));
+   --  High order half of 64-bit value
+
+   -------------------
+   -- Double_Divide --
+   -------------------
+
+   procedure Double_Divide
+     (X, Y, Z : Int64;
+      Q, R    : out Int64;
+      Round   : Boolean)
+   is
+      Xu  : constant Uns64 := abs X;
+      Yu  : constant Uns64 := abs Y;
+
+      Yhi : constant Uns32 := Hi (Yu);
+      Ylo : constant Uns32 := Lo (Yu);
+
+      Zu  : constant Uns64 := abs Z;
+      Zhi : constant Uns32 := Hi (Zu);
+      Zlo : constant Uns32 := Lo (Zu);
+
+      T1, T2     : Uns64;
+      Du, Qu, Ru : Uns64;
+      Den_Pos    : Boolean;
+
+   begin
+      if Yu = 0 or else Zu = 0 then
+         raise Constraint_Error;
+      end if;
+
+      --  Compute Y * Z. Note that if the result overflows 64 bits unsigned,
+      --  then the rounded result is clearly zero (since the dividend is at
+      --  most 2**63 - 1, the extra bit of precision is nice here).
+
+      if Yhi /= 0 then
+         if Zhi /= 0 then
+            Q := 0;
+            R := X;
+            return;
+         else
+            T2 := Yhi * Zlo;
+         end if;
+
+      else
+         T2 := (if Zhi /= 0 then Ylo * Zhi else 0);
+      end if;
+
+      T1 := Ylo * Zlo;
+      T2 := T2 + Hi (T1);
+
+      if Hi (T2) /= 0 then
+         Q := 0;
+         R := X;
+         return;
+      end if;
+
+      Du := Lo (T2) & Lo (T1);
+
+      --  Set final signs (RM 4.5.5(27-30))
+
+      Den_Pos := (Y < 0) = (Z < 0);
+
+      --  Check overflow case of largest negative number divided by 1
+
+      if X = Int64'First and then Du = 1 and then not Den_Pos then
+         raise Constraint_Error;
+      end if;
+
+      --  Perform the actual division
+
+      Qu := Xu / Du;
+      Ru := Xu rem Du;
+
+      --  Deal with rounding case
+
+      if Round and then Ru > (Du - Uns64'(1)) / Uns64'(2) then
+         Qu := Qu + Uns64'(1);
+      end if;
+
+      --  Case of dividend (X) sign positive
+
+      if X >= 0 then
+         R := To_Int (Ru);
+         Q := (if Den_Pos then To_Int (Qu) else -To_Int (Qu));
+
+      --  Case of dividend (X) sign negative
+
+      else
+         R := -To_Int (Ru);
+         Q := (if Den_Pos then -To_Int (Qu) else To_Int (Qu));
+      end if;
+   end Double_Divide;
+
+end Opt61_Pkg;
diff --git a/gcc/testsuite/gnat.dg/opt61_pkg.ads b/gcc/testsuite/gnat.dg/opt61_pkg.ads
new file mode 100644
index 00000000000..ffc5634fad9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt61_pkg.ads
@@ -0,0 +1,12 @@
+with Interfaces;
+
+package Opt61_Pkg is
+
+   subtype Int64 is Interfaces.Integer_64;
+
+   procedure Double_Divide
+     (X, Y, Z : Int64;
+      Q, R    : out Int64;
+      Round   : Boolean);
+
+end Opt61_Pkg;