2010-10-26 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 165980



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@165983 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 33 insertions, 7 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 9873eee4a67..68452392994 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -997,10 +997,15 @@ package body Checks is
       Desig_Typ : Entity_Id;
 
    begin
+      --  No checks inside a generic (check the instantiations)
+
       if Inside_A_Generic then
          return;
+      end if;
 
-      elsif Is_Scalar_Type (Typ) then
+      --  Apply required constaint checks
+
+      if Is_Scalar_Type (Typ) then
          Apply_Scalar_Range_Check (N, Typ);
 
       elsif Is_Array_Type (Typ) then
@@ -1559,8 +1564,8 @@ package body Checks is
       Truncate  : constant Boolean := Float_Truncate (Par);
       Max_Bound : constant Uint :=
                     UI_Expon
-                      (Machine_Radix (Expr_Type),
-                       Machine_Mantissa (Expr_Type) - 1) - 1;
+                      (Machine_Radix_Value (Expr_Type),
+                       Machine_Mantissa_Value (Expr_Type) - 1) - 1;
 
       --  Largest bound, so bound plus or minus half is a machine number of F
 
@@ -1748,6 +1753,18 @@ package body Checks is
         (Ck_Node, Target_Typ, Source_Typ, Do_Static => False);
    end Apply_Length_Check;
 
+   ---------------------------
+   -- Apply_Predicate_Check --
+   ---------------------------
+
+   procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
+   begin
+      if Present (Predicate_Function (Typ)) then
+         Insert_Action (N,
+           Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+      end if;
+   end Apply_Predicate_Check;
+
    -----------------------
    -- Apply_Range_Check --
    -----------------------
@@ -2402,14 +2419,14 @@ package body Checks is
                      --  one of the stored discriminants, this will provide the
                      --  required consistency check.
 
-                     Append_Elmt (
-                        Make_Selected_Component (Loc,
-                          Prefix =>
+                     Append_Elmt
+                       (Make_Selected_Component (Loc,
+                          Prefix        =>
                             Duplicate_Subexpr_No_Checks
                               (Expr, Name_Req => True),
                           Selector_Name =>
                             Make_Identifier (Loc, Chars (Discr))),
-                                New_Constraints);
+                        New_Constraints);
 
                   else
                      --  Discriminant of more remote ancestor ???
@@ -3732,6 +3749,15 @@ package body Checks is
          return;
       end if;
 
+      --  Do not set range check flag if parent is assignment statement or
+      --  object declaration with Suppress_Assignment_Checks flag set
+
+      if Nkind_In (Parent (N), N_Assignment_Statement, N_Object_Declaration)
+        and then Suppress_Assignment_Checks (Parent (N))
+      then
+         return;
+      end if;
+
       --  Check for various cases where we should suppress the range check
 
       --  No check if range checks suppressed for type of node