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
if Present (Lhs)
and then (Present (Param_Entity (Lhs))
- or else (Ada_Version < Ada_05
+ or else (Ada_Version < Ada_2005
and then not Is_Constrained (T_Typ)
and then Is_Aliased_View (Lhs)
and then not Is_Aliased_Unconstrained_Component)
- or else (Ada_Version >= Ada_05
+ or else (Ada_Version >= Ada_2005
and then not Is_Constrained (T_Typ)
and then Denotes_Explicit_Dereference (Lhs)
and then Nkind (Original_Node (Lhs)) /=
-- Ada 2005: nothing to do if the type is one for which there is a
-- partial view that is constrained.
- elsif Ada_Version >= Ada_05
+ elsif Ada_Version >= Ada_2005
and then Has_Constrained_Partial_View (Base_Type (T_Typ))
then
return;
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
end if;
end if;
- -- If this is a boolean expression, only its elementary consituents need
+ -- If this is a boolean expression, only its elementary operands need
-- checking: if they are valid, a boolean or short-circuit operation
-- with them will be valid as well.
if Base_Type (Typ) = Standard_Boolean
and then
- (Nkind (Expr) in N_Op or else Nkind (Expr) in N_Short_Circuit)
+ (Nkind (Expr) in N_Op or else Nkind (Expr) in N_Short_Circuit)
then
return;
end if;
----------------------------------
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;