checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Handle case of…

checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated): Handle case of appearing in range in membership test.

2012-10-01  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
	Handle case of appearing in range in membership test.
	* exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
	New procedure (Expand_N_In): Use
	Expand_Membership_Minimize_Eliminate_Overflow.
	* rtsfind.ads: Add RE_Bignum_In_LLI_Range.
	* s-bignum.ads, s-bignum.adb (Bignum_In_LLI_Range): New function.
	* sinfo.ads, sinfo.adb (No_Minimize_Eliminate): New flag.

2012-10-01  Robert Dewar  <dewar@adacore.com>

	* uintp.ads: Minor reformatting.

From-SVN: r191918

gcc/ada/ChangeLog

+2012-10-01  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Apply_Arithmetic_Overflow_Minimized_Eliminated):
+	Handle case of appearing in range in membership test.
+	* exp_ch4.adb (Expand_Membership_Minimize_Eliminate_Overflow):
+	New procedure (Expand_N_In): Use
+	Expand_Membership_Minimize_Eliminate_Overflow.
+	* rtsfind.ads: Add RE_Bignum_In_LLI_Range.
+	* s-bignum.ads, s-bignum.adb (Bignum_In_LLI_Range): New function.
+	* sinfo.ads, sinfo.adb (No_Minimize_Eliminate): New flag.
+
+2012-10-01  Robert Dewar  <dewar@adacore.com>
+
+	* uintp.ads: Minor reformatting.
+
 2012-10-01  Ed Schonberg  <schonberg@adacore.com>
 
 	* checks.adb: Improve warning message.

gcc/ada/checks.adb

@@ -1091,6 +1091,12 @@ package body Checks is
       if Is_Signed_Integer_Arithmetic_Op (P)
         or else Nkind (Op) in N_Membership_Test
         or else Nkind (Op) in N_Op_Compare
+
+        --  We may also be a range operand in a membership test
+
+        or else (Nkind (Op) = N_Range
+                  and then Nkind (Parent (Op)) in N_Membership_Test)
+
       then
          return;
       end if;

gcc/ada/rtsfind.ads

@@ -778,6 +778,7 @@ package Rtsfind is
      RE_Big_NE,                          -- System.Bignums
 
      RE_Bignum,                          -- System.Bignums
+     RE_Bignum_In_LLI_Range,             -- System.Bignums
      RE_To_Bignum,                       -- System.Bignums
      RE_From_Bignum,                     -- System.Bignums
 
@@ -2021,6 +2022,7 @@ package Rtsfind is
      RE_Big_NE                           => System_Bignums,
 
      RE_Bignum                           => System_Bignums,
+     RE_Bignum_In_LLI_Range              => System_Bignums,
      RE_To_Bignum                        => System_Bignums,
      RE_From_Bignum                      => System_Bignums,
 

gcc/ada/s-bignum.adb

@@ -963,6 +963,33 @@ package body System.Bignums is
       raise Constraint_Error with "expression value out of range";
    end From_Bignum;
 
+   -------------------------
+   -- Bignum_In_LLI_Range --
+   -------------------------
+
+   function Bignum_In_LLI_Range (X : Bignum) return Boolean is
+   begin
+      --  If length is 0 or 1, definitely fits
+
+      if X.Len <= 1 then
+         return True;
+
+      --  If length is greater than 2, definitely does not fit
+
+      elsif X.Len > 2 then
+         return False;
+
+      --  Length is 2, more tests needed
+
+      else
+         declare
+            Mag : constant DD := X.D (1) & X.D (2);
+         begin
+            return Mag < 2 ** 63 or else (X.Neg and then Mag = 2 ** 63);
+         end;
+      end if;
+   end Bignum_In_LLI_Range;
+
    ---------------
    -- Normalize --
    ---------------

gcc/ada/s-bignum.ads

@@ -91,6 +91,10 @@ package System.Bignums is
    --  Perform indicated comparison on bignums, returning result as Boolean.
    --  No exception raised for any input arguments.
 
+   function Bignum_In_LLI_Range (X : Bignum) return Boolean;
+   --  Returns True if the Bignum value is in the range of Long_Long_Integer,
+   --  so that a call to From_Bignum is guaranteed not to raise an exception.
+
    function To_Bignum (X : Long_Long_Integer) return Bignum;
    --  Convert Long_Long_Integer to Bignum. No exception can be raised for any
    --  input argument.

gcc/ada/sinfo.adb

@@ -2235,6 +2235,15 @@ package body Sinfo is
       return Flag13 (N);
    end No_Initialization;
 
+   function No_Minimize_Eliminate
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_In
+        or else NT (N).Nkind = N_Not_In);
+      return Flag17 (N);
+   end No_Minimize_Eliminate;
+
    function No_Truncation
       (N : Node_Id) return Boolean is
    begin
@@ -5288,6 +5297,15 @@ package body Sinfo is
       Set_Flag13 (N, Val);
    end Set_No_Initialization;
 
+   procedure Set_No_Minimize_Eliminate
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_In
+        or else NT (N).Nkind = N_Not_In);
+      Set_Flag17 (N, Val);
+   end Set_No_Minimize_Eliminate;
+
    procedure Set_No_Truncation
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1545,6 +1545,11 @@ package Sinfo is
    --    should not be taken into account (needed for in place initialization
    --    with aggregates).
 
+   --  No_Minimize_Eliminate (Flag17-Sem)
+   --    This flag is present in membership operator nodes (N_In/N_Not_In).
+   --    It is used to indicate that processing for extended overflow checking
+   --    modes is not required (this is used to prevent infinite recursion).
+
    --  No_Truncation (Flag17-Sem)
    --    Present in N_Unchecked_Type_Conversion node. This flag has an effect
    --    only if the RM_Size of the source is greater than the RM_Size of the
@@ -3675,6 +3680,7 @@ package Sinfo is
       --  Left_Opnd (Node2)
       --  Right_Opnd (Node3)
       --  Alternatives (List4) (set to No_List if only one set alternative)
+      --  No_Minimize_Eliminate (Flag17)
       --  plus fields for expression
 
       --  N_Not_In
@@ -3682,6 +3688,7 @@ package Sinfo is
       --  Left_Opnd (Node2)
       --  Right_Opnd (Node3)
       --  Alternatives (List4) (set to No_List if only one set alternative)
+      --  No_Minimize_Eliminate (Flag17)
       --  plus fields for expression
 
       --------------------
@@ -8794,6 +8801,9 @@ package Sinfo is
    function No_Initialization
      (N : Node_Id) return Boolean;    -- Flag13
 
+   function No_Minimize_Eliminate
+     (N : Node_Id) return Boolean;    -- Flag17
+
    function No_Truncation
      (N : Node_Id) return Boolean;    -- Flag17
 
@@ -9766,6 +9776,9 @@ package Sinfo is
    procedure Set_No_Initialization
      (N : Node_Id; Val : Boolean := True);    -- Flag13
 
+   procedure Set_No_Minimize_Eliminate
+     (N : Node_Id; Val : Boolean := True);    -- Flag17
+
    procedure Set_No_Truncation
      (N : Node_Id; Val : Boolean := True);    -- Flag17
 
@@ -12017,6 +12030,7 @@ package Sinfo is
    pragma Inline (No_Elaboration_Check);
    pragma Inline (No_Entities_Ref_In_Spec);
    pragma Inline (No_Initialization);
+   pragma Inline (No_Minimize_Eliminate);
    pragma Inline (No_Truncation);
    pragma Inline (Null_Present);
    pragma Inline (Null_Exclusion_Present);
@@ -12337,6 +12351,7 @@ package Sinfo is
    pragma Inline (Set_No_Elaboration_Check);
    pragma Inline (Set_No_Entities_Ref_In_Spec);
    pragma Inline (Set_No_Initialization);
+   pragma Inline (Set_No_Minimize_Eliminate);
    pragma Inline (Set_No_Truncation);
    pragma Inline (Set_Null_Present);
    pragma Inline (Set_Null_Exclusion_Present);

gcc/ada/uintp.ads

@@ -248,9 +248,9 @@ package Uintp is
    --  not in Char_Code range.
 
    function Num_Bits (Input : Uint) return Nat;
-   --  Approximate number of binary bits in given universal integer.
-   --  This function is used for capacity checks, and it can be one
-   --  bit off without affecting its usage.
+   --  Approximate number of binary bits in given universal integer. This
+   --  function is used for capacity checks, and it can be one bit off
+   --  without affecting its usage.
 
    ---------------------
    -- Output Routines --
@@ -258,8 +258,8 @@ package Uintp is
 
    type UI_Format is (Hex, Decimal, Auto);
    --  Used to determine whether UI_Image/UI_Write output is in hexadecimal
-   --  or decimal format. Auto, the default setting, lets the routine make
-   --  a decision based on the value.
+   --  or decimal format. Auto, the default setting, lets the routine make a
+   --  decision based on the value.
 
    UI_Image_Max    : constant := 48; -- Enough for a 128-bit number
    UI_Image_Buffer : String (1 .. UI_Image_Max);
@@ -271,8 +271,8 @@ package Uintp is
    --  followed by the value in UI_Image_Buffer. The form of the value is an
    --  integer literal in either decimal (no base) or hexadecimal (base 16)
    --  format. If Hex is True on entry, then hex mode is forced, otherwise
-   --  UI_Image makes a guess at which output format is more convenient. The
-   --  value must fit in UI_Image_Buffer. If necessary, the result is an
+   --  UI_Image makes a guess at which output format is more convenient.
+   --  The value must fit in UI_Image_Buffer. If necessary, the result is an
    --  approximation of the proper value, using an exponential format. The
    --  image of No_Uint is output as a single question mark.
 
@@ -280,9 +280,9 @@ package Uintp is
    --  Writes a representation of Uint, consisting of a possible minus sign,
    --  followed by the value to the output file. The form of the value is an
    --  integer literal in either decimal (no base) or hexadecimal (base 16)
-   --  format as appropriate. UI_Format shows which format to use. Auto,
-   --  the default, asks UI_Write to make a guess at which output format
-   --  will be more convenient to read.
+   --  format as appropriate. UI_Format shows which format to use. Auto, the
+   --  default, asks UI_Write to make a guess at which output format will be
+   --  more convenient to read.
 
    procedure pid (Input : Uint);
    pragma Export (Ada, pid);
@@ -355,11 +355,11 @@ package Uintp is
    -- Mark/Release Processing --
    -----------------------------
 
-   --  The space used by Uint data is not automatically reclaimed. However,
-   --  a mark-release regime is implemented which allows storage to be
-   --  released back to a previously noted mark. This is used for example
-   --  when doing comparisons, where only intermediate results get stored
-   --  that do not need to be saved for future use.
+   --  The space used by Uint data is not automatically reclaimed. However, a
+   --  mark-release regime is implemented which allows storage to be released
+   --  back to a previously noted mark. This is used for example when doing
+   --  comparisons, where only intermediate results get stored that do not
+   --  need to be saved for future use.
 
    type Save_Mark is private;
 
@@ -370,18 +370,16 @@ package Uintp is
    --  Release storage allocated since mark was noted
 
    procedure Release_And_Save (M : Save_Mark; UI : in out Uint);
-   --  Like Release, except that the given Uint value (which is typically
-   --  among the data being released) is recopied after the release, so
-   --  that it is the most recent item, and UI is updated to point to
-   --  its copied location.
+   --  Like Release, except that the given Uint value (which is typically among
+   --  the data being released) is recopied after the release, so that it is
+   --  the most recent item, and UI is updated to point to its copied location.
 
    procedure Release_And_Save (M : Save_Mark; UI1, UI2 : in out Uint);
    --  Like Release, except that the given Uint values (which are typically
-   --  among the data being released) are recopied after the release, so
-   --  that they are the most recent items, and UI1 and UI2 are updated if
-   --  necessary to point to the copied locations. This routine is careful
-   --  to do things in the right order, so that the values do not clobber
-   --  one another.
+   --  among the data being released) are recopied after the release, so that
+   --  they are the most recent items, and UI1 and UI2 are updated if necessary
+   --  to point to the copied locations. This routine is careful to do things
+   --  in the right order, so that the values do not clobber one another.
 
    -----------------------------------
    -- Representation of Uint Values --
@@ -499,15 +497,14 @@ private
    type UI_Vector is array (Pos range <>) of Int;
    --  Vector containing the integer values of a Uint value
 
-   --  Note: An earlier version of this package used pointers of arrays
-   --  of Ints (dynamically allocated) for the Uint type. The change
-   --  leads to a few less natural idioms used throughout this code, but
-   --  eliminates all uses of the heap except for the table package itself.
-   --  For example, Uint parameters are often converted to UI_Vectors for
-   --  internal manipulation. This is done by creating the local UI_Vector
-   --  using the function N_Digits on the Uint to find the size needed for
-   --  the vector, and then calling Init_Operand to copy the values out
-   --  of the table into the vector.
+   --  Note: An earlier version of this package used pointers of arrays of Ints
+   --  (dynamically allocated) for the Uint type. The change leads to a few
+   --  less natural idioms used throughout this code, but eliminates all uses
+   --  of the heap except for the table package itself. For example, Uint
+   --  parameters are often converted to UI_Vectors for internal manipulation.
+   --  This is done by creating the local UI_Vector using the function N_Digits
+   --  on the Uint to find the size needed for the vector, and then calling
+   --  Init_Operand to copy the values out of the table into the vector.
 
    type Uint_Entry is record
       Length : Pos;