mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-19 01:50:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

checks.adb (Generate_Range_Check): Replace type conversions with unchecked conversions to support the case of...

Browse Source 
2009-07-07  Gary Dismukes  <dismukes@adacore.com>

	* checks.adb (Generate_Range_Check): Replace type conversions with
	unchecked conversions to support the case of performing range checks
	on Enum'Val (permits integer values to be converted to enumeration).

	* exp_attr.adb (Expand_N_Attribute_Reference, cases Attribute_Pred,
	Attribute_Succ): Set Do_Range_Check to False before calling
	Expand_Pred_Succ, to prevent gigi from generating any range checks.
	(Expand_N_Attribute_Reference, case Attribute_Val):
	Generate a range check when needed (and set Do_Range_Check to False).

	* exp_ch3.adb (Expand_N_Object_Declaration): Generate a range check on
	scalar object initialization if needed.

	* exp_ch4.adb (Expand_Allocator_Expression): Generate range checks
	when needed on scalar allocators.
	(Expand_N_Qualified_Expression): Generate range check when needed.
	(Expand_N_Slice): Remove call to Enable_Range_Check on slice ranges.
	Checks on slice ranges handled in Resolve_Slice.

	* exp_ch5.adb (Expand_N_Assignment_Statement): Generate a range check,
	when needed, for all scalar assignments, not just discrete.
	(Expand_Simple_Function_Return): Resolve the conversion created for a
	scalar function return so that the conversion will get expanded to
	generate a possible constraint check.

	* exp_ch6.adb (Expand_Actuals): Call Add_Call_By_Copy_Code for out and
	in out scalar actuals when subtypes don't match, to ensure generation
	of return checks (and set Do_Range_Check to False).
	(Expand_Call): Uncomment code to perform range checks, but make it apply
	only to in and in out parameters (checks on parameter returns are
	handled in Expand_Actuals). If a scalar actual for a call to a derived
	subprogram is marked as needing a range check, peform it here (and set
	Do_Range_Check to False).

	* sem_aggr.adb (Resolve_*_Aggregate.Resolve_Aggr_Expr): Generate a
	range check on scalar component associations when needed.

	* sem_eval.adb (In_Subrange_Of): Return False when the first type has
	infinities but the second type does not, as these aren't compatible
	floating-point types.

	* sem_res.adb (Resolve_Slice): In the case where the prefix of the
	slice is itself a slice, pick up the Etype of the prefix. This handles
	the case where the prefix was an Image attribute expanded to a slice,
	and ensures that we get the subtype with the slice constraint rather
	than the unconstrained subbtype of the 'Image.

From-SVN: r149318
This commit is contained in:
Gary Dismukes 2009-07-07 10:52:14 +00:00 committed by Arnaud Charlet
parent e0ba1bfd64
commit d79e621af2
10 changed files with 179 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
gcc/ada/ChangeLog
View File

@ -1,3 +1,52 @@
2009-07-07 Gary Dismukes <dismukes@adacore.com>
* checks.adb (Generate_Range_Check): Replace type conversions with
unchecked conversions to support the case of performing range checks
on Enum'Val (permits integer values to be converted to enumeration).
* exp_attr.adb (Expand_N_Attribute_Reference, cases Attribute_Pred,
Attribute_Succ): Set Do_Range_Check to False before calling
Expand_Pred_Succ, to prevent gigi from generating any range checks.
(Expand_N_Attribute_Reference, case Attribute_Val):
Generate a range check when needed (and set Do_Range_Check to False).
* exp_ch3.adb (Expand_N_Object_Declaration): Generate a range check on
scalar object initialization if needed.
* exp_ch4.adb (Expand_Allocator_Expression): Generate range checks
when needed on scalar allocators.
(Expand_N_Qualified_Expression): Generate range check when needed.
(Expand_N_Slice): Remove call to Enable_Range_Check on slice ranges.
Checks on slice ranges handled in Resolve_Slice.
* exp_ch5.adb (Expand_N_Assignment_Statement): Generate a range check,
when needed, for all scalar assignments, not just discrete.
(Expand_Simple_Function_Return): Resolve the conversion created for a
scalar function return so that the conversion will get expanded to
generate a possible constraint check.
* exp_ch6.adb (Expand_Actuals): Call Add_Call_By_Copy_Code for out and
in out scalar actuals when subtypes don't match, to ensure generation
of return checks (and set Do_Range_Check to False).
(Expand_Call): Uncomment code to perform range checks, but make it apply
only to in and in out parameters (checks on parameter returns are
handled in Expand_Actuals). If a scalar actual for a call to a derived
subprogram is marked as needing a range check, peform it here (and set
Do_Range_Check to False).
* sem_aggr.adb (Resolve_*_Aggregate.Resolve_Aggr_Expr): Generate a
range check on scalar component associations when needed.
* sem_eval.adb (In_Subrange_Of): Return False when the first type has
infinities but the second type does not, as these aren't compatible
floating-point types.
* sem_res.adb (Resolve_Slice): In the case where the prefix of the
slice is itself a slice, pick up the Etype of the prefix. This handles
the case where the prefix was an Image attribute expanded to a slice,
and ensures that we get the subtype with the slice constraint rather
than the unconstrained subbtype of the 'Image.
2009-07-07 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Analyze_Conditional_Expression): handle properly

12
gcc/ada/checks.adb
View File

@ -4682,6 +4682,12 @@ package body Checks is
-- The conversions will always work and need no check
-- Unchecked_Convert_To is used instead of Convert_To to handle the case
-- of converting from an enumeration value to an integer type, such as
-- occurs for the case of generating a range check on Enum'Val(Exp)
-- (which used to be handled by gigi). This is OK, since the conversion
-- itself does not require a check.
elsif In_Subrange_Of (Target_Type, Source_Base_Type) then
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
@ -4692,14 +4698,14 @@ package body Checks is
Right_Opnd =>
Make_Range (Loc,
Low_Bound =>
Convert_To (Source_Base_Type,
Unchecked_Convert_To (Source_Base_Type,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Target_Type, Loc),
Attribute_Name => Name_First)),
High_Bound =>
Convert_To (Source_Base_Type,
Unchecked_Convert_To (Source_Base_Type,
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (Target_Type, Loc),
@ -4891,7 +4897,7 @@ package body Checks is
New_Occurrence_Of (Target_Base_Type, Loc),
Constant_Present => True,
Expression =>
Make_Type_Conversion (Loc,
Make_Unchecked_Type_Conversion (Loc,
Subtype_Mark =>
New_Occurrence_Of (Target_Base_Type, Loc),
Expression => Duplicate_Subexpr (N))),

25
gcc/ada/exp_attr.adb
View File

@ -3388,10 +3388,13 @@ package body Exp_Attr is
elsif Is_Modular_Integer_Type (Ptyp) then
null;
-- For other types, if range checking is enabled, we must generate
-- a check if overflow checking is enabled.
-- For other types, if argument is marked as needing a range check or
-- overflow checking is enabled, we must generate a check.
elsif not Overflow_Checks_Suppressed (Ptyp) then
elsif not Overflow_Checks_Suppressed (Ptyp)
or else Do_Range_Check (First (Exprs))
then
Set_Do_Range_Check (First (Exprs), False);
Expand_Pred_Succ (N);
end if;
end Pred;
@ -4319,10 +4322,13 @@ package body Exp_Attr is
elsif Is_Modular_Integer_Type (Ptyp) then
null;
-- For other types, if range checking is enabled, we must generate
-- a check if overflow checking is enabled.
-- For other types, if argument is marked as needing a range check or
-- overflow checking is enabled, we must generate a check.
elsif not Overflow_Checks_Suppressed (Ptyp) then
elsif not Overflow_Checks_Suppressed (Ptyp)
or else Do_Range_Check (First (Exprs))
then
Set_Do_Range_Check (First (Exprs), False);
Expand_Pred_Succ (N);
end if;
end Succ;
@ -4629,6 +4635,13 @@ package body Exp_Attr is
end if;
Analyze_And_Resolve (N, Typ);
-- If the argument is marked as requiring a range check then generate
-- it here.
elsif Do_Range_Check (First (Exprs)) then
Set_Do_Range_Check (First (Exprs), False);
Generate_Range_Check (First (Exprs), Etyp, CE_Range_Check_Failed);
end if;
end Val;

8
gcc/ada/exp_ch3.adb
View File

@ -4515,6 +4515,14 @@ package body Exp_Ch3 is
null;
else
Apply_Constraint_Check (Expr, Typ);
-- If the expression has been marked as requiring a range
-- generate it now and reset the flag.
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);
Generate_Range_Check (Expr, Typ, CE_Range_Check_Failed);
end if;
end if;
end if;

41
gcc/ada/exp_ch4.adb
View File

@ -1038,6 +1038,11 @@ package body Exp_Ch4 is
Apply_Constraint_Check (Exp, T, No_Sliding => True);
if Do_Range_Check (Exp) then
Set_Do_Range_Check (Exp, False);
Generate_Range_Check (Exp, DesigT, CE_Range_Check_Failed);
end if;
-- A check is also needed in cases where the designated subtype is
-- constrained and differs from the subtype given in the qualified
-- expression. Note that the check on the qualified expression does
@ -1048,6 +1053,11 @@ package body Exp_Ch4 is
then
Apply_Constraint_Check
(Exp, DesigT, No_Sliding => False);
if Do_Range_Check (Exp) then
Set_Do_Range_Check (Exp, False);
Generate_Range_Check (Exp, DesigT, CE_Range_Check_Failed);
end if;
end if;
-- For an access to unconstrained packed array, GIGI needs to see an
@ -7073,6 +7083,11 @@ package body Exp_Ch4 is
-- Apply possible constraint check
Apply_Constraint_Check (Operand, Target_Type, No_Sliding => True);
if Do_Range_Check (Operand) then
Set_Do_Range_Check (Operand, False);
Generate_Range_Check (Operand, Target_Type, CE_Range_Check_Failed);
end if;
end Expand_N_Qualified_Expression;
---------------------------------
@ -7429,32 +7444,6 @@ package body Exp_Ch4 is
Make_Build_In_Place_Call_In_Anonymous_Context (Pfx);
end if;
-- Range checks are potentially also needed for cases involving a slice
-- indexed by a subtype indication, but Do_Range_Check can currently
-- only be set for expressions ???
if not Index_Checks_Suppressed (Ptp)
and then (not Is_Entity_Name (Pfx)
or else not Index_Checks_Suppressed (Entity (Pfx)))
and then Nkind (Discrete_Range (N)) /= N_Subtype_Indication
-- Do not enable range check to nodes associated with the frontend
-- expansion of the dispatch table. We first check if Ada.Tags is
-- already loaded to avoid the addition of an undesired dependence
-- on such run-time unit.
and then
(not Tagged_Type_Expansion
or else not
(RTU_Loaded (Ada_Tags)
and then Nkind (Prefix (N)) = N_Selected_Component
and then Present (Entity (Selector_Name (Prefix (N))))
and then Entity (Selector_Name (Prefix (N))) =
RTE_Record_Component (RE_Prims_Ptr)))
then
Enable_Range_Check (Discrete_Range (N));
end if;
-- The remaining case to be handled is packed slices. We can leave
-- packed slices as they are in the following situations:

13
gcc/ada/exp_ch5.adb
View File

@ -1530,12 +1530,9 @@ package body Exp_Ch5 is
end;
end if;
-- First deal with generation of range check if required. For now we do
-- this only for discrete types.
-- First deal with generation of range check if required
if Do_Range_Check (Rhs)
and then Is_Discrete_Type (Typ)
then
if Do_Range_Check (Rhs) then
Set_Do_Range_Check (Rhs, False);
Generate_Range_Check (Rhs, Typ, CE_Range_Check_Failed);
end if;
@ -3853,7 +3850,11 @@ package body Exp_Ch5 is
if Is_Scalar_Type (Exptyp) then
Rewrite (Exp, Convert_To (R_Type, Exp));
Analyze (Exp);
-- The expression is resolved to ensure that the conversion gets
-- expanded to generate a possible constraint check.
Analyze_And_Resolve (Exp, R_Type);
end if;
-- Deal with returning variable length objects and controlled types

42
gcc/ada/exp_ch6.adb
View File

@ -1589,6 +1589,25 @@ package body Exp_Ch6 is
and then Has_Volatile_Components (Entity (Prefix (Actual)))
then
Add_Call_By_Copy_Code;
-- Add call-by-copy code for the case of scalar out parameters
-- when it is not known at compile time that the subtype of the
-- formal is a subrange of the subtype of the actual, in order
-- to get return range checks on such actuals. (Maybe this case
-- should be handled earlier in the if statement???)
elsif Is_Scalar_Type (E_Formal)
and then not In_Subrange_Of (E_Formal, Etype (Actual))
then
-- Perhaps the setting back to False should be done within
-- Add_Call_By_Copy_Code, since it could get set on other
-- cases occurring above???
if Do_Range_Check (Actual) then
Set_Do_Range_Check (Actual, False);
end if;
Add_Call_By_Copy_Code;
end if;
-- Processing for IN parameters
@ -2028,13 +2047,15 @@ package body Exp_Ch6 is
Param_Count := 1;
while Present (Formal) loop
-- Generate range check if required (not activated yet ???)
-- Generate range check if required
-- if Do_Range_Check (Actual) then
-- Set_Do_Range_Check (Actual, False);
-- Generate_Range_Check
-- (Actual, Etype (Formal), CE_Range_Check_Failed);
-- end if;
if Do_Range_Check (Actual)
and then Ekind (Formal) /= E_Out_Parameter
then
Set_Do_Range_Check (Actual, False);
Generate_Range_Check
(Actual, Etype (Formal), CE_Range_Check_Failed);
end if;
-- Prepare to examine current entry
@ -2711,6 +2732,15 @@ package body Exp_Ch6 is
Convert (Actual, Parent_Typ);
Enable_Range_Check (Actual);
-- If the actual has been marked as requiring a range
-- check, then generate it here.
if Do_Range_Check (Actual) then
Set_Do_Range_Check (Actual, False);
Generate_Range_Check
(Actual, Etype (Formal), CE_Range_Check_Failed);
end if;
-- For access types, the parent formal type and actual type
-- differ.

16
gcc/ada/sem_aggr.adb
View File

@ -1473,6 +1473,14 @@ package body Sem_Aggr is
Set_Raises_Constraint_Error (N);
end if;
-- If the expression has been marked as requiring a range check,
-- then generate it here.
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);
Generate_Range_Check (Expr, Component_Typ, CE_Range_Check_Failed);
end if;
return Resolution_OK;
end Resolve_Aggr_Expr;
@ -2801,6 +2809,14 @@ package body Sem_Aggr is
Set_Raises_Constraint_Error (N);
end if;
-- If the expression has been marked as requiring a range check,
-- then generate it here.
if Do_Range_Check (Expr) then
Set_Do_Range_Check (Expr, False);
Generate_Range_Check (Expr, Expr_Type, CE_Range_Check_Failed);
end if;
if Relocate then
Add_Association (New_C, Relocate_Node (Expr), New_Assoc_List);
else

10
gcc/ada/sem_eval.adb
View File

@ -3738,6 +3738,16 @@ package body Sem_Eval is
elsif not Is_Scalar_Type (T1) or else not Is_Scalar_Type (T1) then
return False;
-- If T1 has infinities but T2 doesn't have infinities, then T1 is
-- definitely not compatible with T2.
elsif Is_Floating_Point_Type (T1)
and then Has_Infinities (T1)
and then Is_Floating_Point_Type (T2)
and then not Has_Infinities (T2)
then
return False;
else
L1 := Type_Low_Bound (T1);
H1 := Type_High_Bound (T1);

10
gcc/ada/sem_res.adb
View File

@ -7887,6 +7887,16 @@ package body Sem_Res is
Insert_Action (N, Act_Decl);
Array_Type := Defining_Identifier (Act_Decl);
end;
-- Maybe this should just be "else", instead of checking for the
-- specific case of slice??? This is needed for the case where
-- the prefix is an Image attribute, which gets expanded to a
-- slice, and so has a constrained subtype which we want to use
-- for the slice range check applied below (the range check won't
-- get done if the unconstrained subtype of the 'Image is used).
elsif Nkind (Name) = N_Slice then
Array_Type := Etype (Name);
end if;
-- If name was overloaded, set slice type correctly now