[multiple changes]
2014-10-23 Hristian Kirtchev <kirtchev@adacore.com> * checks.adb (Ensure_Valid): Update the subprogram profile. Propagate the contex attributes to Insert_Valid_Check. (Insert_Valid_Check): Update the subprogram profile. Propagate the attributes of the context to Duplicate_Subexpr_No_Checks. (Validity_Check_Range): Update the subprogram profile. Propagate the context attribute to Ensure_Valid. * checks.ads (Ensure_Valid): Update the subprogram profile along with the comment on usage. (Insert_Valid_Check): Update the subprogram profile along with the comment on usage. (Validity_Check_Range): Update the subprogram profile along with the comment on usage. * exp_util.adb (Build_Temporary): New routine. (Duplicate_Subexpr_No_Checks): Update the subprogram profile. Propagate the attributes of the context to Remove_Side_Effects. (Remove_Side_Effects): Update the subprogram profile. Update all calls to Make_Temporary to invoke Build_Temporary. * exp_util.ads (Duplicate_Subexpr_No_Checks): Update the subprogram profile along with the comment on usage. (Remove_Side_Effects): Update the subprogram profile along with the comment on usage. * sem_ch3.adb (Process_Range_Expr_In_Decl): Pass the subtype to the validity check machinery. Explain the reason for this propagation. 2014-10-23 Robert Dewar <dewar@adacore.com> * a-strsea.adb: Minor reformatting. From-SVN: r216581
This commit is contained in:
Arnaud Charlet
parent
3fdb58e2eb
commit
2934b84ad8
@ -1,3 +1,34 @@
|
||||
2014-10-23 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* checks.adb (Ensure_Valid): Update the subprogram
|
||||
profile. Propagate the contex attributes to Insert_Valid_Check.
|
||||
(Insert_Valid_Check): Update the subprogram profile. Propagate
|
||||
the attributes of the context to Duplicate_Subexpr_No_Checks.
|
||||
(Validity_Check_Range): Update the subprogram profile. Propagate
|
||||
the context attribute to Ensure_Valid.
|
||||
* checks.ads (Ensure_Valid): Update the subprogram profile
|
||||
along with the comment on usage.
|
||||
(Insert_Valid_Check): Update the subprogram profile along with the
|
||||
comment on usage.
|
||||
(Validity_Check_Range): Update the subprogram profile along with
|
||||
the comment on usage.
|
||||
* exp_util.adb (Build_Temporary): New routine.
|
||||
(Duplicate_Subexpr_No_Checks): Update the subprogram
|
||||
profile. Propagate the attributes of the context to Remove_Side_Effects.
|
||||
(Remove_Side_Effects): Update the subprogram profile. Update all calls
|
||||
to Make_Temporary to invoke Build_Temporary.
|
||||
* exp_util.ads (Duplicate_Subexpr_No_Checks): Update
|
||||
the subprogram profile along with the comment on usage.
|
||||
(Remove_Side_Effects): Update the subprogram profile along with
|
||||
the comment on usage.
|
||||
* sem_ch3.adb (Process_Range_Expr_In_Decl): Pass the subtype
|
||||
to the validity check machinery. Explain the reason for this
|
||||
propagation.
|
||||
|
||||
2014-10-23 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* a-strsea.adb: Minor reformatting.
|
||||
|
||||
2014-10-23 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* bcheck.adb (Check_Consistent_SSO_Default): Exclude internal
|
||||
|
||||
@ -241,14 +241,6 @@ package body Ada.Strings.Search is
|
||||
First : out Positive;
|
||||
Last : out Natural)
|
||||
is
|
||||
|
||||
-- RM 2005 A.4.3 (68/1)) specifies that an exception must be raised if
|
||||
-- Source'First is not positive and is assigned to First. Formulation
|
||||
-- is slightly different in RM 2012, but the intent seems similar, so
|
||||
-- we enable range checks for this routine.
|
||||
|
||||
pragma Unsuppress (Range_Check);
|
||||
|
||||
begin
|
||||
for J in Source'Range loop
|
||||
if Belongs (Source (J), Set, Test) then
|
||||
@ -271,8 +263,18 @@ package body Ada.Strings.Search is
|
||||
|
||||
-- Here if no token found
|
||||
|
||||
First := Source'First;
|
||||
Last := 0;
|
||||
-- RM 2005 A.4.3 (68/1)) specifies that an exception must be raised if
|
||||
-- Source'First is not positive and is assigned to First. Formulation
|
||||
-- is slightly different in RM 2012, but the intent seems similar, so
|
||||
-- we check explicitly for that condition.
|
||||
|
||||
if Source'First not in Positive then
|
||||
raise Constraint_Error;
|
||||
|
||||
else
|
||||
First := Source'First;
|
||||
Last := 0;
|
||||
end if;
|
||||
end Find_Token;
|
||||
|
||||
-----------
|
||||
|
||||
@ -5627,7 +5627,13 @@ package body Checks is
|
||||
-- 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 @@ package body Checks is
|
||||
|
||||
-- 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 @@ package body Checks is
|
||||
-- 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 @@ package body Checks is
|
||||
|
||||
-- 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 @@ package body Checks is
|
||||
-- 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 @@ package body Checks is
|
||||
-- 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 @@ package Checks is
|
||||
-- 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 @@ package Checks is
|
||||
-- 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 @@ package Checks is
|
||||
-- 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 @@ package Checks is
|
||||
-- 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 --
|
||||
|
||||
@ -1922,14 +1922,24 @@ package body Exp_Util is
|
||||
---------------------------------
|
||||
|
||||
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 @@ package body Exp_Util is
|
||||
-------------------------
|
||||
|
||||
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 @@ package body Exp_Util is
|
||||
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 @@ package body Exp_Util is
|
||||
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 @@ package body Exp_Util is
|
||||
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 @@ package body Exp_Util is
|
||||
-- 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 @@ package body Exp_Util is
|
||||
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 @@ package body Exp_Util is
|
||||
|
||||
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 @@ package body Exp_Util is
|
||||
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 @@ package Exp_Util is
|
||||
-- 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 @@ package Exp_Util is
|
||||
-- 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 @@ package Exp_Util is
|
||||
-- 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
|
||||
|
||||
@ -19734,16 +19734,29 @@ package body Sem_Ch3 is
|
||||
Lo := Low_Bound (R);
|
||||
Hi := High_Bound (R);
|
||||
|
||||
-- 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
|
||||
if Nkind (Parent (R)) = N_Loop_Parameter_Specification
|
||||
and then Nkind (Parent (Parent (R))) = N_Quantified_Expression
|
||||
then
|
||||
Validity_Check_Range (R);
|
||||
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.
|
||||
|
||||
-- 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 @@ package body Sem_Ch3 is
|
||||
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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user