[multiple changes]

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

	* checks.adb: Minor reformatting.

2012-10-01  Javier Miranda  <miranda@adacore.com>

	* exp_ch3.adb (Expand_N_Object_Declaration): Suppress tag
	assignment for initializations that are aggregates.

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

	* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
	New procedure.

From-SVN: r191914

4 files changed, 325 insertions, 2 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b297746..ddc3f4d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,19 @@
 2012-10-01  Robert Dewar  <dewar@adacore.com>
 
+	* checks.adb: Minor reformatting.
+
+2012-10-01  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch3.adb (Expand_N_Object_Declaration): Suppress tag
+	assignment for initializations that are aggregates.
+
+2012-10-01  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch4.adb (Expand_Compare_Minimize_Eliminate_Overflow):
+	New procedure.
+
+2012-10-01  Robert Dewar  <dewar@adacore.com>
+
 	* checks.adb (Minimize_Eliminate_Checks): Changes from testing.
 	(Apply_Arithmetic_Overflow_Minimized_Eliminated): Changes
 	from testing.
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 840fca4..06d37864 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -1114,12 +1114,12 @@ package body Checks is
 
       elsif Is_RTE (Etype (Op), RE_Bignum) then
 
-         --  We need a sequence that looks like
+         --  We need a sequence that looks like:
 
          --    Rnn : Result_Type;
 
          --    declare
-         --       M   : Mark_Id := SS_Mark;
+         --       M : Mark_Id := SS_Mark;
          --    begin
          --       Rnn := Long_Long_Integer'Base (From_Bignum (Op));
          --       SS_Release (M);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 454348f..d7427d9 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5393,6 +5393,8 @@ package body Exp_Ch3 is
               and then not Is_CPP_Class (Typ)
               and then Tagged_Type_Expansion
               and then Nkind (Expr) /= N_Aggregate
+              and then (Nkind (Expr) /= N_Qualified_Expression
+                         or else Nkind (Expression (Expr)) /= N_Aggregate)
             then
                declare
                   Full_Typ : constant Entity_Id := Underlying_Type (Typ);
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7bad0dc..9d22e9c 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -140,6 +140,10 @@ package body Exp_Ch4 is
    procedure Expand_Short_Circuit_Operator (N : Node_Id);
    --  Common expansion processing for short-circuit boolean operators
 
+   procedure Expand_Compare_Minimize_Eliminate_Overflow (N : Node_Id);
+   --  Deal with comparison in Minimize/Eliminate overflow mode. This is where
+   --  we allow comparison of "out of range" values.
+
    function Expand_Composite_Equality
      (Nod    : Node_Id;
       Typ    : Entity_Id;
@@ -2276,6 +2280,237 @@ package body Exp_Ch4 is
       end;
    end Expand_Boolean_Operator;
 
+   ------------------------------------------------
+   -- Expand_Compare_Minimize_Eliminate_Overflow --
+   ------------------------------------------------
+
+   procedure Expand_Compare_Minimize_Eliminate_Overflow (N : Node_Id) is
+      Loc : constant Source_Ptr := Sloc (N);
+
+      Llo, Lhi : Uint;
+      Rlo, Rhi : Uint;
+
+      LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
+      --  Entity for Long_Long_Integer'Base
+
+      Check : constant Overflow_Check_Type := Overflow_Check_Mode (Empty);
+      --  Current checking mode
+
+      procedure Set_True;
+      procedure Set_False;
+      --  These procedures rewrite N with an occurrence of Standard_True or
+      --  Standard_False, and then makes a call to Warn_On_Known_Condition.
+
+      ---------------
+      -- Set_False --
+      ---------------
+
+      procedure Set_False is
+      begin
+         Rewrite (N, New_Occurrence_Of (Standard_False, Loc));
+         Warn_On_Known_Condition (N);
+      end Set_False;
+
+      --------------
+      -- Set_True --
+      --------------
+
+      procedure Set_True is
+      begin
+         Rewrite (N, New_Occurrence_Of (Standard_True, Loc));
+         Warn_On_Known_Condition (N);
+      end Set_True;
+
+   --  Start of processing for Expand_Compare_Minimize_Eliminate_Overflow
+
+   begin
+      --  Nothing to do unless we have a comparison operator with operands
+      --  that are signed integer types, and we are operating in either
+      --  MINIMIZED or ELIMINATED overflow checking mode.
+
+      if Nkind (N) not in N_Op_Compare
+        or else Check not in Minimized_Or_Eliminated
+        or else not Is_Signed_Integer_Type (Etype (Left_Opnd (N)))
+      then
+         return;
+      end if;
+
+      --  OK, this is the case we are interested in. First step is to process
+      --  our operands using the Minimize_Eliminate circuitry which applies
+      --  this processing to the two operand subtrees.
+
+      Minimize_Eliminate_Overflow_Checks (Left_Opnd (N),  Llo, Lhi);
+      Minimize_Eliminate_Overflow_Checks (Right_Opnd (N), Rlo, Rhi);
+
+      --  See if the range information decides the result of the comparison
+
+      case N_Op_Compare (Nkind (N)) is
+         when N_Op_Eq =>
+            if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
+               Set_True;
+            elsif Llo > Rhi or else Rlo > Lhi then
+               Set_False;
+            end if;
+
+         when N_Op_Ge =>
+            if Llo >= Rhi then
+               Set_True;
+            elsif Lhi < Rlo then
+               Set_False;
+            end if;
+
+         when N_Op_Gt =>
+            if Llo > Rhi then
+               Set_True;
+            elsif Lhi <= Rlo then
+               Set_False;
+            end if;
+
+         when N_Op_Le =>
+            if Llo > Rhi then
+               Set_False;
+            elsif Lhi <= Rlo then
+               Set_True;
+            end if;
+
+         when N_Op_Lt =>
+            if Llo >= Rhi then
+               Set_True;
+            elsif Lhi < Rlo then
+               Set_False;
+            end if;
+
+         when N_Op_Ne =>
+            if Llo = Lhi and then Rlo = Rhi and then Llo = Rlo then
+               Set_True;
+            elsif Llo > Rhi or else Rlo > Lhi then
+               Set_False;
+            end if;
+      end case;
+
+      --  All done if we did the rewrite
+
+      if Nkind (N) not in N_Op_Compare then
+         return;
+      end if;
+
+      --  Otherwise, time to do the comparison
+
+      declare
+         Ltype : constant Entity_Id := Etype (Left_Opnd (N));
+         Rtype : constant Entity_Id := Etype (Right_Opnd (N));
+
+      begin
+         --  If the two operands have the same signed integer type we are
+         --  all set, nothing more to do. This is the case where either
+         --  both operands were unchanged, or we rewrote both of them to
+         --  be Long_Long_Integer.
+
+         --  Note: Entity for the comparison may be wrong, but it's not worth
+         --  the effort to change it, since the back end does not use it.
+
+         if Is_Signed_Integer_Type (Ltype)
+           and then Base_Type (Ltype) = Base_Type (Rtype)
+         then
+            return;
+
+         --  Here if bignums are involved (can only happen in ELIMINATED mode)
+
+         elsif Is_RTE (Ltype, RE_Bignum) or else Is_RTE (Rtype, RE_Bignum) then
+            declare
+               Left  : Node_Id := Left_Opnd (N);
+               Right : Node_Id := Right_Opnd (N);
+               --  Bignum references for left and right operands
+
+            begin
+               if not Is_RTE (Ltype, RE_Bignum) then
+                  Left := Convert_To_Bignum (Left);
+               elsif not Is_RTE (Rtype, RE_Bignum) then
+                  Right := Convert_To_Bignum (Right);
+               end if;
+
+               --  We need a sequence that looks like
+
+               --    Bnn : Boolean;
+
+               --    declare
+               --       M : Mark_Id := SS_Mark;
+               --    begin
+               --       Bnn := Big_xx (Left, Right); (xx = EQ, NT etc)
+               --       SS_Release (M);
+               --    end;
+
+               --  This block is inserted (using Insert_Actions), and then the
+               --  node is replaced with a reference to Bnn.
+
+               declare
+                  Blk : constant Node_Id  := Make_Bignum_Block (Loc);
+                  Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N);
+                  Ent : RE_Id;
+
+               begin
+                  case N_Op_Compare (Nkind (N)) is
+                     when N_Op_Eq => Ent := RE_Big_EQ;
+                     when N_Op_Ge => Ent := RE_Big_GE;
+                     when N_Op_Gt => Ent := RE_Big_GT;
+                     when N_Op_Le => Ent := RE_Big_LE;
+                     when N_Op_Lt => Ent := RE_Big_LT;
+                     when N_Op_Ne => Ent := RE_Big_NE;
+                  end case;
+
+                  --  Insert assignment to Bnn
+
+                  Insert_Before
+                    (First (Statements (Handled_Statement_Sequence (Blk))),
+                     Make_Assignment_Statement (Loc,
+                       Name       => New_Occurrence_Of (Bnn, Loc),
+                       Expression =>
+                         Make_Function_Call (Loc,
+                           Name                   =>
+                             New_Occurrence_Of (RTE (Ent), Loc),
+                           Parameter_Associations => New_List (Left, Right))));
+
+                  --  Insert actions (declaration of Bnn and block)
+
+                  Insert_Actions (N, New_List (
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Bnn,
+                      Object_Definition   =>
+                        New_Occurrence_Of (Standard_Boolean, Loc)),
+                    Blk));
+
+                  --  Rewrite node with reference to Bnn
+
+                  Rewrite (N, New_Occurrence_Of (Bnn, Loc));
+                  Analyze_And_Resolve (N);
+               end;
+            end;
+
+         --  No bignums involved, but types are different, so we must have
+         --  rewritten one of the operands as a Long_Long_Integer but not
+         --  the other one.
+
+         --  If left operand is Long_Long_Integer, convert right operand
+         --  and we are done (with a comparison of two Long_Long_Integers).
+
+         elsif Ltype = LLIB then
+            Convert_To_And_Rewrite (LLIB, Right_Opnd (N));
+            Analyze_And_Resolve (Right_Opnd (N), LLIB, Suppress => All_Checks);
+            return;
+
+         --  If right operand is Long_Long_Integer, convert left operand
+         --  and we are done (with a comparison of two Long_Long_Integers).
+
+         --  This is the only remaining possibility
+
+         else pragma Assert (Rtype = LLIB);
+            Convert_To_And_Rewrite (LLIB, Left_Opnd (N));
+            Analyze_And_Resolve (Left_Opnd (N), LLIB, Suppress => All_Checks);
+            return;
+         end if;
+      end;
+   end Expand_Compare_Minimize_Eliminate_Overflow;
+
    -------------------------------
    -- Expand_Composite_Equality --
    -------------------------------
@@ -6367,6 +6602,8 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  Deal with private types
+
       if Ekind (Typl) = E_Private_Type then
          Typl := Underlying_Type (Typl);
       elsif Ekind (Typl) = E_Private_Subtype then
@@ -6385,6 +6622,15 @@ package body Exp_Ch4 is
 
       Typl := Base_Type (Typl);
 
+      --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
+      --  results in not having a comparison operation any more, we are done.
+
+      Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+      if Nkind (N) /= N_Op_Eq then
+         return;
+      end if;
+
       --  Boolean types (requiring handling of non-standard case)
 
       if Is_Boolean_Type (Typl) then
@@ -6955,11 +7201,24 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
+      --  results in not having a comparison operation any more, we are done.
+
+      Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+      if Nkind (N) /= N_Op_Ge then
+         return;
+      end if;
+
+      --  Array type case
+
       if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
 
+      --  Deal with boolean operands
+
       if Is_Boolean_Type (Typ1) then
          Adjust_Condition (Op1);
          Adjust_Condition (Op2);
@@ -6992,11 +7251,24 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
+      --  results in not having a comparison operation any more, we are done.
+
+      Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+      if Nkind (N) /= N_Op_Gt then
+         return;
+      end if;
+
+      --  Deal with array type operands
+
       if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
 
+      --  Deal with boolean type operands
+
       if Is_Boolean_Type (Typ1) then
          Adjust_Condition (Op1);
          Adjust_Condition (Op2);
@@ -7029,11 +7301,24 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
+      --  results in not having a comparison operation any more, we are done.
+
+      Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+      if Nkind (N) /= N_Op_Le then
+         return;
+      end if;
+
+      --  Deal with array type operands
+
       if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
 
+      --  Deal with Boolean type operands
+
       if Is_Boolean_Type (Typ1) then
          Adjust_Condition (Op1);
          Adjust_Condition (Op2);
@@ -7066,11 +7351,24 @@ package body Exp_Ch4 is
    begin
       Binary_Op_Validity_Checks (N);
 
+      --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
+      --  results in not having a comparison operation any more, we are done.
+
+      Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+      if Nkind (N) /= N_Op_Lt then
+         return;
+      end if;
+
+      --  Deal with array type operands
+
       if Is_Array_Type (Typ1) then
          Expand_Array_Comparison (N);
          return;
       end if;
 
+      --  Deal with Boolean type operands
+
       if Is_Boolean_Type (Typ1) then
          Adjust_Condition (Op1);
          Adjust_Condition (Op2);
@@ -7447,6 +7745,15 @@ package body Exp_Ch4 is
       then
          Binary_Op_Validity_Checks (N);
 
+         --  Deal with overflow checks in MINIMIZED/ELIMINATED mode and if
+         --  that results in not having a /= opertion any more, we are done.
+
+         Expand_Compare_Minimize_Eliminate_Overflow (N);
+
+         if Nkind (N) /= N_Op_Ne then
+            return;
+         end if;
+
          --  Boolean types (requiring handling of non-standard case)
 
          if Is_Boolean_Type (Typ) then