===================================================================
@@ -19734,16 +19734,29 @@
Lo := Low_Bound (R);
Hi := High_Bound (R);
+ -- Validity checks on the range of a quantified expression are
+ -- delayed until the construct is transformed into a loop.
+
+ if Nkind (Parent (R)) = N_Loop_Parameter_Specification
+ and then Nkind (Parent (Parent (R))) = N_Quantified_Expression
+ then
+ null;
+
-- We need to ensure validity of the bounds here, because if we
-- go ahead and do the expansion, then the expanded code will get
-- analyzed with range checks suppressed and we miss the check.
- -- Validity checks on the range of a quantified expression are
- -- delayed until the construct is transformed into a loop.
- if Nkind (Parent (R)) /= N_Loop_Parameter_Specification
- or else Nkind (Parent (Parent (R))) /= N_Quantified_Expression
- then
- Validity_Check_Range (R);
+ -- WARNING: The capture of the range bounds with xxx_FIRST/_LAST and
+ -- the temporaries generated by routine Remove_Side_Effects by means
+ -- of validity checks must use the same names. When a range appears
+ -- in the parent of a generic, the range is processed with checks
+ -- disabled as part of the generic context and with checks enabled
+ -- for code generation purposes. This leads to link issues as the
+ -- generic contains references to xxx_FIRST/_LAST, but the inlined
+ -- template sees the temporaries generated by Remove_Side_Effects.
+
+ else
+ Validity_Check_Range (R, Subtyp);
end if;
-- If there were errors in the declaration, try and patch up some
@@ -19784,16 +19797,16 @@
if Nkind (Lo) = N_String_Literal then
Rewrite (Lo,
Make_Attribute_Reference (Sloc (Lo),
- Attribute_Name => Name_First,
- Prefix => New_Occurrence_Of (T, Sloc (Lo))));
+ Prefix => New_Occurrence_Of (T, Sloc (Lo)),
+ Attribute_Name => Name_First));
Analyze_And_Resolve (Lo);
end if;
if Nkind (Hi) = N_String_Literal then
Rewrite (Hi,
Make_Attribute_Reference (Sloc (Hi),
- Attribute_Name => Name_First,
- Prefix => New_Occurrence_Of (T, Sloc (Hi))));
+ Prefix => New_Occurrence_Of (T, Sloc (Hi)),
+ Attribute_Name => Name_First));
Analyze_And_Resolve (Hi);
end if;
===================================================================
@@ -1922,14 +1922,24 @@
---------------------------------
function Duplicate_Subexpr_No_Checks
- (Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id
+ (Exp : Node_Id;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
begin
- Remove_Side_Effects (Exp, Name_Req, Renaming_Req);
+ Remove_Side_Effects
+ (Exp => Exp,
+ Name_Req => Name_Req,
+ Renaming_Req => Renaming_Req,
+ Related_Id => Related_Id,
+ Is_Low_Bound => Is_Low_Bound,
+ Is_High_Bound => Is_High_Bound);
+
New_Exp := New_Copy_Tree (Exp);
Remove_Checks (New_Exp);
return New_Exp;
@@ -7188,11 +7198,53 @@
-------------------------
procedure Remove_Side_Effects
- (Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False;
- Variable_Ref : Boolean := False)
+ (Exp : Node_Id;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False;
+ Variable_Ref : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False)
is
+ function Build_Temporary
+ (Loc : Source_Ptr;
+ Id : Character;
+ Related_Nod : Node_Id := Empty) return Entity_Id;
+ -- Create an external symbol of the form xxx_FIRST/_LAST if Related_Id
+ -- is present, otherwise it generates an internal temporary.
+
+ ---------------------
+ -- Build_Temporary --
+ ---------------------
+
+ function Build_Temporary
+ (Loc : Source_Ptr;
+ Id : Character;
+ Related_Nod : Node_Id := Empty) return Entity_Id
+ is
+ Temp_Nam : Name_Id;
+
+ begin
+ -- The context requires an external symbol
+
+ if Present (Related_Id) then
+ if Is_Low_Bound then
+ Temp_Nam := New_External_Name (Chars (Related_Id), "_FIRST");
+ else pragma Assert (Is_High_Bound);
+ Temp_Nam := New_External_Name (Chars (Related_Id), "_LAST");
+ end if;
+
+ return Make_Defining_Identifier (Loc, Temp_Nam);
+
+ -- Otherwise generate an internal temporary
+
+ else
+ return Make_Temporary (Loc, Id, Related_Nod);
+ end if;
+ end Build_Temporary;
+
+ -- Local variables
+
Loc : constant Source_Ptr := Sloc (Exp);
Exp_Type : constant Entity_Id := Etype (Exp);
Svg_Suppress : constant Suppress_Record := Scope_Suppress;
@@ -7203,6 +7255,8 @@
Ref_Type : Entity_Id;
Res : Node_Id;
+ -- Start of processing for Remove_Side_Effects
+
begin
-- Handle cases in which there is nothing to do. In GNATprove mode,
-- removal of side effects is useful for the light expansion of
@@ -7260,7 +7314,7 @@
or else (not Name_Req
and then Is_Volatile_Reference (Exp)))
then
- Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
Res := New_Occurrence_Of (Def_Id, Loc);
@@ -7309,7 +7363,7 @@
elsif Nkind (Exp) = N_Explicit_Dereference
and then not Is_Volatile_Reference (Exp)
then
- Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
Res :=
Make_Explicit_Dereference (Loc, New_Occurrence_Of (Def_Id, Loc));
@@ -7351,8 +7405,8 @@
-- Use a renaming to capture the expression, rather than create
-- a controlled temporary.
- Def_Id := Make_Temporary (Loc, 'R', Exp);
- Res := New_Occurrence_Of (Def_Id, Loc);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
+ Res := New_Occurrence_Of (Def_Id, Loc);
Insert_Action (Exp,
Make_Object_Renaming_Declaration (Loc,
@@ -7361,9 +7415,9 @@
Name => Relocate_Node (Exp)));
else
- Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
Set_Etype (Def_Id, Exp_Type);
- Res := New_Occurrence_Of (Def_Id, Loc);
+ Res := New_Occurrence_Of (Def_Id, Loc);
E :=
Make_Object_Declaration (Loc,
@@ -7397,7 +7451,7 @@
and then (Name_Req or else not Treat_As_Volatile (Exp_Type))
then
- Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
if Nkind (Exp) = N_Selected_Component
and then Nkind (Prefix (Exp)) = N_Function_Call
@@ -7490,7 +7544,7 @@
end;
end if;
- Def_Id := Make_Temporary (Loc, 'R', Exp);
+ Def_Id := Build_Temporary (Loc, 'R', Exp);
-- The regular expansion of functions with side effects involves the
-- generation of an access type to capture the return value found on
===================================================================
@@ -372,14 +372,23 @@
-- following functions allow this behavior to be modified.
function Duplicate_Subexpr_No_Checks
- (Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False) return Node_Id;
- -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks
- -- is called on the result, so that the duplicated expression does not
- -- include checks. This is appropriate for use when Exp, the original
- -- expression is unconditionally elaborated before the duplicated
- -- expression, so that there is no need to repeat any checks.
+ (Exp : Node_Id;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False) return Node_Id;
+ -- Identical in effect to Duplicate_Subexpr, except that Remove_Checks is
+ -- called on the result, so that the duplicated expression does not include
+ -- checks. This is appropriate for use when Exp, the original expression is
+ -- unconditionally elaborated before the duplicated expression, so that
+ -- there is no need to repeat any checks.
+ --
+ -- Related_Id denotes the entity of the context where Expr appears. Flags
+ -- Is_Low_Bound and Is_High_Bound specify whether the expression to check
+ -- is the low or the high bound of a range. These three optional arguments
+ -- signal Remove_Side_Effects to create an external symbol of the form
+ -- Chars (Related_Id)_FIRST/_LAST.
function Duplicate_Subexpr_Move_Checks
(Exp : Node_Id;
@@ -823,10 +832,13 @@
-- associated with Var, and if found, remove and return that call node.
procedure Remove_Side_Effects
- (Exp : Node_Id;
- Name_Req : Boolean := False;
- Renaming_Req : Boolean := False;
- Variable_Ref : Boolean := False);
+ (Exp : Node_Id;
+ Name_Req : Boolean := False;
+ Renaming_Req : Boolean := False;
+ Variable_Ref : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False);
-- Given the node for a subexpression, this function replaces the node if
-- necessary by an equivalent subexpression that is guaranteed to be side
-- effect free. This is done by extracting any actions that could cause
@@ -840,6 +852,13 @@
-- side effect (used in implementing Force_Evaluation). Note: after call to
-- Remove_Side_Effects, it is safe to call New_Copy_Tree to obtain a copy
-- of the resulting expression.
+ --
+ -- Related_Id denotes the entity of the context where Expr appears. Flags
+ -- Is_Low_Bound and Is_High_Bound specify whether the expression to check
+ -- is the low or the high bound of a range. These three optional arguments
+ -- signal Remove_Side_Effects to create an external symbol of the form
+ -- Chars (Related_Id)_FIRST/_LAST. If Related_Id is set, the exactly one
+ -- of the Is_xxx_Bound flags must be set.
function Represented_As_Scalar (T : Entity_Id) return Boolean;
-- Returns True iff the implementation of this type in code generation
===================================================================
@@ -5627,7 +5627,13 @@
-- Ensure_Valid --
------------------
- procedure Ensure_Valid (Expr : Node_Id; Holes_OK : Boolean := False) is
+ procedure Ensure_Valid
+ (Expr : Node_Id;
+ Holes_OK : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False)
+ is
Typ : constant Entity_Id := Etype (Expr);
begin
@@ -5793,7 +5799,7 @@
-- If we fall through, a validity check is required
- Insert_Valid_Check (Expr);
+ Insert_Valid_Check (Expr, Related_Id, Is_Low_Bound, Is_High_Bound);
if Is_Entity_Name (Expr)
and then Safe_To_Capture_Value (Expr, Entity (Expr))
@@ -6996,14 +7002,19 @@
-- Insert_Valid_Check --
------------------------
- procedure Insert_Valid_Check (Expr : Node_Id) is
+ procedure Insert_Valid_Check
+ (Expr : Node_Id;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False)
+ is
Loc : constant Source_Ptr := Sloc (Expr);
Typ : constant Entity_Id := Etype (Expr);
Exp : Node_Id;
begin
- -- Do not insert if checks off, or if not checking validity or
- -- if expression is known to be valid
+ -- Do not insert if checks off, or if not checking validity or if
+ -- expression is known to be valid.
if not Validity_Checks_On
or else Range_Or_Validity_Checks_Suppressed (Expr)
@@ -7073,7 +7084,13 @@
-- Build the prefix for the 'Valid call
- PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => False);
+ PV :=
+ Duplicate_Subexpr_No_Checks
+ (Exp => Exp,
+ Name_Req => False,
+ Related_Id => Related_Id,
+ Is_Low_Bound => Is_Low_Bound,
+ Is_High_Bound => Is_High_Bound);
-- A rather specialized test. If PV is an analyzed expression which
-- is an indexed component of a packed array that has not been
@@ -7098,14 +7115,14 @@
-- a name, and we don't care in this context!
CE :=
- Make_Raise_Constraint_Error (Loc,
- Condition =>
- Make_Op_Not (Loc,
- Right_Opnd =>
- Make_Attribute_Reference (Loc,
- Prefix => PV,
- Attribute_Name => Name_Valid)),
- Reason => CE_Invalid_Data);
+ Make_Raise_Constraint_Error (Loc,
+ Condition =>
+ Make_Op_Not (Loc,
+ Right_Opnd =>
+ Make_Attribute_Reference (Loc,
+ Prefix => PV,
+ Attribute_Name => Name_Valid)),
+ Reason => CE_Invalid_Data);
-- Insert the validity check. Note that we do this with validity
-- checks turned off, to avoid recursion, we do not want validity
@@ -10113,12 +10130,22 @@
-- Validity_Check_Range --
--------------------------
- procedure Validity_Check_Range (N : Node_Id) is
+ procedure Validity_Check_Range
+ (N : Node_Id;
+ Related_Id : Entity_Id := Empty)
+ is
begin
if Validity_Checks_On and Validity_Check_Operands then
if Nkind (N) = N_Range then
- Ensure_Valid (Low_Bound (N));
- Ensure_Valid (High_Bound (N));
+ Ensure_Valid
+ (Expr => Low_Bound (N),
+ Related_Id => Related_Id,
+ Is_Low_Bound => True);
+
+ Ensure_Valid
+ (Expr => High_Bound (N),
+ Related_Id => Related_Id,
+ Is_High_Bound => True);
end if;
end if;
end Validity_Check_Range;
===================================================================
@@ -849,7 +849,12 @@
-- 13.9.1(9-11)) such assignments are not permitted to result in erroneous
-- behavior in the case of invalid subscript values.
- procedure Ensure_Valid (Expr : Node_Id; Holes_OK : Boolean := False);
+ procedure Ensure_Valid
+ (Expr : Node_Id;
+ Holes_OK : Boolean := False;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False);
-- Ensure that Expr represents a valid value of its type. If this type
-- is not a scalar type, then the call has no effect, since validity
-- is only an issue for scalar types. The effect of this call is to
@@ -865,6 +870,12 @@
-- will make a separate check for this case anyway). If Holes_OK is False,
-- then this case is checked, and code is inserted to ensure that Expr is
-- valid, raising Constraint_Error if the value is not valid.
+ --
+ -- Related_Id denotes the entity of the context where Expr appears. Flags
+ -- Is_Low_Bound and Is_High_Bound specify whether the expression to check
+ -- is the low or the high bound of a range. These three optional arguments
+ -- signal Remove_Side_Effects to create an external symbol of the form
+ -- Chars (Related_Id)_FIRST/_LAST.
function Expr_Known_Valid (Expr : Node_Id) return Boolean;
-- This function tests it the value of Expr is known to be valid in the
@@ -876,10 +887,20 @@
-- it can be determined that the value is Valid. Otherwise False is
-- returned.
- procedure Insert_Valid_Check (Expr : Node_Id);
- -- Inserts code that will check for the value of Expr being valid, in
- -- the sense of the 'Valid attribute returning True. Constraint_Error
- -- will be raised if the value is not valid.
+ procedure Insert_Valid_Check
+ (Expr : Node_Id;
+ Related_Id : Entity_Id := Empty;
+ Is_Low_Bound : Boolean := False;
+ Is_High_Bound : Boolean := False);
+ -- Inserts code that will check for the value of Expr being valid, in the
+ -- sense of the 'Valid attribute returning True. Constraint_Error will be
+ -- raised if the value is not valid.
+ --
+ -- Related_Id denotes the entity of the context where Expr appears. Flags
+ -- Is_Low_Bound and Is_High_Bound specify whether the expression to check
+ -- is the low or the high bound of a range. These three optional arguments
+ -- signal Remove_Side_Effects to create an external symbol of the form
+ -- Chars (Related_Id)_FIRST/_LAST.
procedure Null_Exclusion_Static_Checks (N : Node_Id);
-- Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
@@ -889,9 +910,12 @@
-- conditionally (on the right side of And Then/Or Else. This call
-- removes only embedded checks (Do_Range_Check, Do_Overflow_Check).
- procedure Validity_Check_Range (N : Node_Id);
- -- If N is an N_Range node, then Ensure_Valid is called on its bounds,
- -- if validity checking of operands is enabled.
+ procedure Validity_Check_Range
+ (N : Node_Id;
+ Related_Id : Entity_Id := Empty);
+ -- If N is an N_Range node, then Ensure_Valid is called on its bounds, if
+ -- validity checking of operands is enabled. Related_Id denotes the entity
+ -- of the context where N appears.
-----------------------------
-- Handling of Check Names --