* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149318
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
-- 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,
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),
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))),
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;
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;
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;
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;
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
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
-- 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;
---------------------------------
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:
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;
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
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
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
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.
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;
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
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);
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
OSDN Git Service
