diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2020-04-24 22:05:35 +0200 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-18 05:08:35 -0400 |
commit | 4bfab79a72afbe0f6232668fdfa4b56a6aaea2e6 (patch) | |
tree | 0eb7817062f22f81cf24f5c5c5e18a4a7b35f83e /gcc/ada | |
parent | b93d80bc8fc58c4ef746a8ddc699167c3ededfb9 (diff) | |
download | gcc-4bfab79a72afbe0f6232668fdfa4b56a6aaea2e6.zip gcc-4bfab79a72afbe0f6232668fdfa4b56a6aaea2e6.tar.gz gcc-4bfab79a72afbe0f6232668fdfa4b56a6aaea2e6.tar.bz2 |
[Ada] Small cleanup in constraint checking code for allocators
2020-06-18 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_Allocator_Expression): Apply constraint
and predicate checks for the qualified expression on entry,
followed by constraint and predicate checks for the allocator
itself, and return early if this results in a static error.
(Expand_N_Allocator): Do not do the same here. Instead apply
constraint and predicate checks for arrays in the subtype
indication case.
* exp_ch5.adb (Expand_N_Assignment_Statement): Do not apply
range checks to allocators here.
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/exp_ch4.adb | 101 | ||||
-rw-r--r-- | gcc/ada/exp_ch5.adb | 20 |
2 files changed, 58 insertions, 63 deletions
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 2735a48..d421a59 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -99,7 +99,7 @@ package body Exp_Ch4 is procedure Expand_Allocator_Expression (N : Node_Id); -- Subsidiary to Expand_N_Allocator, for the case when the expression - -- is a qualified expression or an aggregate. + -- is a qualified expression. procedure Expand_Array_Comparison (N : Node_Id); -- This routine handles expansion of the comparison operators (N_Op_Lt, @@ -781,10 +781,10 @@ package body Exp_Ch4 is -- Local variables - Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp); Indic : constant Node_Id := Subtype_Mark (Expression (N)); T : constant Entity_Id := Entity (Indic); Adj_Call : Node_Id; + Aggr_In_Place : Boolean; Node : Node_Id; Tag_Assign : Node_Id; Temp : Entity_Id; @@ -808,6 +808,44 @@ package body Exp_Ch4 is return; end if; + -- If we have: + -- type A is access T1; + -- X : A := new T2'(...); + -- T1 and T2 can be different subtypes, and we might need to check + -- both constraints. First check against the type of the qualified + -- expression. + + Apply_Constraint_Check (Exp, T, No_Sliding => True); + + Apply_Predicate_Check (Exp, T); + + if Do_Range_Check (Exp) then + Generate_Range_Check (Exp, T, 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 + -- not allow sliding, but this check does (a relaxation from Ada 83). + + if Is_Constrained (DesigT) + and then not Subtypes_Statically_Match (T, DesigT) + then + Apply_Constraint_Check (Exp, DesigT, No_Sliding => False); + + Apply_Predicate_Check (Exp, DesigT); + + if Do_Range_Check (Exp) then + Generate_Range_Check (Exp, DesigT, CE_Range_Check_Failed); + end if; + end if; + + if Nkind (Exp) = N_Raise_Constraint_Error then + Rewrite (N, New_Copy (Exp)); + Set_Etype (N, PtrT); + return; + end if; + -- In the case of an Ada 2012 allocator whose initial value comes from a -- function call, pass "the accessibility level determined by the point -- of call" (AI05-0234) to the function. Conceptually, this belongs in @@ -837,6 +875,8 @@ package body Exp_Ch4 is end; end if; + Aggr_In_Place := Is_Delayed_Aggregate (Exp); + -- Case of tagged type or type requiring finalization if Is_Tagged_Type (T) or else Needs_Finalization (T) then @@ -1218,35 +1258,6 @@ package body Exp_Ch4 is else Build_Allocate_Deallocate_Proc (N, True); - -- If we have: - -- type A is access T1; - -- X : A := new T2'(...); - -- T1 and T2 can be different subtypes, and we might need to check - -- both constraints. First check against the type of the qualified - -- expression. - - Apply_Constraint_Check (Exp, T, No_Sliding => True); - - if Do_Range_Check (Exp) then - 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 - -- not allow sliding, but this check does (a relaxation from Ada 83). - - if Is_Constrained (DesigT) - and then not Subtypes_Statically_Match (T, DesigT) - then - Apply_Constraint_Check - (Exp, DesigT, No_Sliding => False); - - if Do_Range_Check (Exp) then - 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 -- expression with a constrained subtype in order to compute the -- proper size for the allocator. @@ -4796,20 +4807,9 @@ package body Exp_Ch4 is New_Occurrence_Of (RTE (RE_Check_Standard_Allocator), Loc))); end if; - -- Handle case of qualified expression (other than optimization above). - -- First apply constraint checks, because the bounds or discriminants - -- in the aggregate might not match the subtype mark in the allocator. + -- Handle case of qualified expression (other than optimization above) if Nkind (Expression (N)) = N_Qualified_Expression then - declare - Exp : constant Node_Id := Expression (Expression (N)); - Typ : constant Entity_Id := Etype (Expression (N)); - - begin - Apply_Constraint_Check (Exp, Typ); - Apply_Predicate_Check (Exp, Typ); - end; - Expand_Allocator_Expression (N); return; end if; @@ -4842,6 +4842,21 @@ package body Exp_Ch4 is Temp_Type : Entity_Id; begin + -- Apply constraint checks against designated subtype (RM 4.8(10/2)). + -- Discriminant checks will be generated by the expansion below. + + if Is_Array_Type (Dtyp) then + Apply_Constraint_Check (Expression (N), Dtyp, No_Sliding => True); + + Apply_Predicate_Check (Expression (N), Dtyp); + + if Nkind (Expression (N)) = N_Raise_Constraint_Error then + Rewrite (N, New_Copy (Expression (N))); + Set_Etype (N, PtrT); + return; + end if; + end if; + if No_Initialization (N) then -- Even though this might be a simple allocation, create a custom diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index fd51dfa..db2ab18 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2447,26 +2447,6 @@ package body Exp_Ch5 is if Is_Constrained (Etype (Lhs)) then Apply_Length_Check (Rhs, Etype (Lhs)); end if; - - if Nkind (Rhs) = N_Allocator then - declare - Target_Typ : constant Entity_Id := Etype (Expression (Rhs)); - C_Es : Check_Result; - - begin - C_Es := - Get_Range_Checks - (Lhs, - Target_Typ, - Etype (Designated_Type (Etype (Lhs)))); - - Insert_Range_Checks - (C_Es, - N, - Target_Typ, - Sloc (Lhs)); - end; - end if; end if; -- Apply range check for access type case |