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
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
(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 --
-----------------------
-- 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 ???
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
----------------------------------
procedure Install_Null_Excluding_Check (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
+ Loc : constant Source_Ptr := Sloc (Parent (N));
Typ : constant Entity_Id := Etype (N);
function Safe_To_Capture_In_Parameter_Value return Boolean;