gcc/ada/
* checks.ads (Expander Routines): Update the description of the
Do_Range_Check mechanism.
* checks.adb (Selected_Range_Checks): Fix typo.
* exp_ch9.adb: Add with and use clause for Checks.
(Actual_Index_Expression): Generate a range check if requested.
(Entry_Index_Expression): Likewise.
* sem_attr.adb (Resolve_Attribute) <Attribute_Count>: Call
Apply_Scalar_Range_Check instead of Apply_Range_Check.
* sem_ch9.adb (Analyze_Accept_Statement): Likewise.
* sem_res.adb (Resolve_Entry): Likewise, after having set the
actual index type on the prefix of the indexed component.
(Resolve_Indexed_Component): Remove useless conditional construct.
Target_Typ : Entity_Id;
Source_Typ : Entity_Id;
Warn_Node : Node_Id) return Check_Result;
- -- Like Apply_Range_Checks, except it doesn't modify anything, just
+ -- Like Apply_Range_Check, except it does not modify anything, just
-- returns a list of nodes as described in the spec of this package
-- for the Range_Check function.
-- Expander Routines --
-----------------------
- -- Some of the earlier processing for checks results in temporarily setting
- -- the Do_Range_Check flag rather than actually generating checks. Probably
- -- we could eliminate the Do_Range_Check flag entirely and generate checks
- -- earlier, but this is a delicate area and it seems safer to implement the
- -- following routines, which are called later on in the expansion process.
- -- They check the Do_Range_Check flag and if it is set, generate the actual
- -- checks and reset the flag.
+ -- In most cases, the processing for range checks done by semantic analysis
+ -- only results in setting the Do_Range_Check flag, rather than actually
+ -- generating checks. The following routines must be called later on in the
+ -- expansion process upon seeing the Do_Range_Check flag; they generate the
+ -- actual checks and reset the flag. The remaining cases where range checks
+ -- are still directly generated during semantic analysis occur as part of
+ -- the processing of constraints in (sub)type and object declarations.
procedure Generate_Range_Check
(N : Node_Id;
-- if raised.
--
-- Note: if the expander is not active, or if we are in GNATprove mode,
- -- then we do not generate explicit range code. Instead we just turn the
+ -- then we do not generate explicit range checks. Instead we just turn the
-- Do_Range_Check flag on, since in these cases that's what we want to see
-- in the tree (GNATprove in particular depends on this flag being set). If
- -- we generate the actual range check, then we make sure the flag is off,
- -- since the code we generate takes complete care of the check.
+ -- we generate the actual range checks, then we make sure the flag is off
+ -- afterward, since the code we generate takes complete care of the checks.
--
-- Historical note: We used to just pass on the Do_Range_Check flag to the
-- back end to generate the check, but now in code-generation mode we never
------------------------------------------------------------------------------
with Atree; use Atree;
+with Checks; use Checks;
with Einfo; use Einfo;
with Elists; use Elists;
with Errout; use Errout;
if Present (Index) then
S := Entry_Index_Type (Ent);
+ -- First make sure the index is in range if requested. The index type
+ -- has been directly set on the prefix, see Resolve_Entry.
+
+ if Do_Range_Check (Index) then
+ Generate_Range_Check
+ (Index, Etype (Prefix (Parent (Index))), CE_Range_Check_Failed);
+ end if;
+
Expr :=
Make_Op_Add (Sloc,
Left_Opnd => Num,
if Present (Index) then
S := Entry_Index_Type (Ent);
+ -- First make sure the index is in range if requested. The index type
+ -- is the pristine Entry_Index_Type of the entry.
+
+ if Do_Range_Check (Index) then
+ Generate_Range_Check (Index, S, CE_Range_Check_Failed);
+ end if;
+
Expr :=
Make_Op_Add (Sloc,
Left_Opnd => Num,
Fam : constant Entity_Id := Entity (Prefix (P));
begin
Resolve (Indx, Entry_Index_Type (Fam));
- Apply_Range_Check (Indx, Entry_Index_Type (Fam));
+ Apply_Scalar_Range_Check (Indx, Entry_Index_Type (Fam));
end;
end if;
end loop;
end;
- if Ekind (E) = E_Entry_Family then
+ if Ekind (Entry_Nam) = E_Entry_Family then
if No (Index) then
Error_Msg_N ("missing entry index in accept for entry family", N);
else
- Analyze_And_Resolve (Index, Entry_Index_Type (E));
- Apply_Range_Check (Index, Entry_Index_Type (E));
+ Analyze_And_Resolve (Index, Entry_Index_Type (Entry_Nam));
+ Apply_Scalar_Range_Check (Index, Entry_Index_Type (Entry_Nam));
end if;
elsif Present (Index) then
-- to the discriminant of the same name in the target task. If the
-- entry name is the target of a requeue statement and the entry is
-- in the current protected object, the bound to be used is the
- -- discriminal of the object (see Apply_Range_Checks for details of
+ -- discriminal of the object (see Apply_Range_Check for details of
-- the transformation).
-----------------------------
Nam := Entity (Selector_Name (Prefix (Entry_Name)));
Resolve (Prefix (Prefix (Entry_Name)));
Resolve_Implicit_Dereference (Prefix (Prefix (Entry_Name)));
+
+ -- We do not resolve the prefix because an Entry_Family has no type,
+ -- although it has the semantics of an array since it can be indexed.
+ -- In order to perform the associated range check, we would need to
+ -- build an array type on the fly and set it on the prefix, but this
+ -- would be wasteful since only the index type matters. Therefore we
+ -- attach this index type directly, so that Actual_Index_Expression
+ -- can pick it up later in order to generate the range check.
+
+ Set_Etype (Prefix (Entry_Name), Actual_Index_Type (Nam));
+
Index := First (Expressions (Entry_Name));
Resolve (Index, Entry_Index_Type (Nam));
if Nkind (Index) = N_Parameter_Association then
Error_Msg_N ("expect expression for entry index", Index);
else
- Apply_Range_Check (Index, Actual_Index_Type (Nam));
+ Apply_Scalar_Range_Check (Index, Etype (Prefix (Entry_Name)));
end if;
end if;
end Resolve_Entry;
Resolve (Expr, Standard_Positive);
else
- while Present (Index) and Present (Expr) loop
+ while Present (Index) and then Present (Expr) loop
Resolve (Expr, Etype (Index));
Check_Unset_Reference (Expr);
- if Is_Scalar_Type (Etype (Expr)) then
- Apply_Scalar_Range_Check (Expr, Etype (Index));
- else
- Apply_Range_Check (Expr, Get_Actual_Subtype (Index));
- end if;
+ Apply_Scalar_Range_Check (Expr, Etype (Index));
Next_Index (Index);
Next (Expr);
projects / platform / upstream / gcc.git / commitdiff