From: Bob Duff <d...@adacore.com>
In the case of "X : T := F (...);", where T is a constrained
discriminated tagged subtype, perform a constraint check
after F returns. The result of F is allocated by the callee
on the secondary stack in this case.
Note that there are still missing checks for some build-in-place
calls.
gcc/ada/ChangeLog:
* exp_ch6.adb: Remove a couple of "???" suggesting something that
we will likely never do.
(Make_Build_In_Place_Call_In_Object_Declaration):
When a constraint check is needed, do the check.
Do it at the call site for now.
The check is still missing in the untagged case,
because the caller allocates in that case.
* sem_ch8.adb (Analyze_Object_Renaming):
Remove obsolete transformation of a renaming into
an object declaration. Given that we also (sometimes) tranform
object declarations into renamings, this transformation was
adding complexity; the new code in
Make_Build_In_Place_Call_In_Object_Declaration above
would need to explicitly avoid the run-time check in the case of
renamings, because renamings are supposed to ignore the nominal
subtype. Anyway, it is no longer needed.
* exp_ch3.adb (Expand_N_Object_Declaration): Rewrite comment;
it IS clear how to do it, but we haven't done it right yet.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 5 +++--
gcc/ada/exp_ch6.adb | 41 +++++++++++++++++++++++++++--------------
gcc/ada/sem_ch8.adb | 23 -----------------------
3 files changed, 30 insertions(+), 39 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d884e755d66..cf2238e9ee1 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -8741,8 +8741,9 @@ package body Exp_Ch3 is
-- be illegal in some cases (such as converting access-
-- to-unconstrained to access-to-constrained), but the
-- the unchecked conversion will presumably fail to work
- -- right in just such cases. It's not clear at all how to
- -- handle this.
+ -- right in just such cases. In order to handle this
+ -- properly, in the Caller_Allocation case, the callee
+ -- needs to do the constraint check.
Alloc_Stmt :=
Make_If_Statement (Loc,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f85d977d0d8..84847377bf3 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -158,7 +158,7 @@ package body Exp_Ch6 is
Alloc_Form_Exp : Node_Id := Empty;
Pool_Exp : Node_Id := Empty);
-- Ada 2005 (AI-318-02): If the result type of a build-in-place call needs
- -- them, add the actuals parameters BIP_Alloc_Form and BIP_Storage_Pool.
+ -- them, add the actual parameters BIP_Alloc_Form and BIP_Storage_Pool.
-- If Alloc_Form_Exp is present, then pass it for the first parameter,
-- otherwise pass a literal corresponding to the Alloc_Form parameter
-- (which must not be Unspecified in that case). If Pool_Exp is present,
@@ -442,9 +442,7 @@ package body Exp_Ch6 is
return;
end if;
- -- Locate the implicit allocation form parameter in the called function.
- -- Maybe it would be better for each implicit formal of a build-in-place
- -- function to have a flag or a Uint attribute to identify it. ???
+ -- Locate the implicit allocation form parameter in the called function
Alloc_Form_Formal := Build_In_Place_Formal (Function_Id, BIP_Alloc_Form);
@@ -928,9 +926,6 @@ package body Exp_Ch6 is
Formal_Suffix : constant String := BIP_Formal_Suffix (Kind);
begin
- -- Maybe it would be better for each implicit formal of a build-in-place
- -- function to have a flag or a Uint attribute to identify it. ???
-
-- The return type in the function declaration may have been a limited
-- view, and the extra formals for the function were not generated at
-- that point. At the point of call the full view must be available and
@@ -8821,6 +8816,19 @@ package body Exp_Ch6 is
and then
not Has_Foreign_Convention (Return_Applies_To (Scope (Obj_Def_Id)));
+ Constraint_Check_Needed : constant Boolean :=
+ (Has_Discriminants (Obj_Typ) or else Is_Array_Type (Obj_Typ))
+ and then Is_Tagged_Type (Obj_Typ)
+ and then Is_Constrained (Obj_Typ);
+ -- We are processing a call in the context of something like
+ -- "X : T := F (...);". This is True if we need to do a constraint
+ -- check, because T has constrained bounds or discriminants,
+ -- and F is returning an unconstrained subtype.
+ -- We are currently doing the check at the call site,
+ -- which is possible only in the callee-allocates case,
+ -- which is why we have Is_Tagged_Type above.
+ -- ???The check is missing in the untagged caller-allocates case.
+
-- Start of processing for Make_Build_In_Place_Call_In_Object_Declaration
begin
@@ -8863,15 +8871,16 @@ package body Exp_Ch6 is
Subtype_Indication =>
New_Occurrence_Of (Designated_Type, Loc)));
- -- The access type and its accompanying object must be inserted after
- -- the object declaration in the constrained case, so that the function
- -- call can be passed access to the object. In the indefinite case, or
+ -- The access type and its object must be inserted after the object
+ -- declaration in the caller-allocates case, so that the function call
+ -- can be passed access to the object. In the caller-allocates case, or
-- if the object declaration is for a return object, the access type and
-- object must be inserted before the object, since the object
-- declaration is rewritten to be a renaming of a dereference of the
-- access object.
- if Definite and then not Is_OK_Return_Object then
+ if Definite and not Is_OK_Return_Object and not Constraint_Check_Needed
+ then
Insert_Action_After (Obj_Decl, Ptr_Typ_Decl);
else
Insert_Action (Obj_Decl, Ptr_Typ_Decl);
@@ -8952,7 +8961,7 @@ package body Exp_Ch6 is
-- to the (specific) result type of the function is inserted to handle
-- the case where the object is declared with a class-wide type.
- elsif Definite then
+ elsif Definite and not Constraint_Check_Needed then
Caller_Object := Unchecked_Convert_To
(Result_Subt, New_Occurrence_Of (Obj_Def_Id, Loc));
@@ -9090,8 +9099,8 @@ package body Exp_Ch6 is
-- itself the return expression of an enclosing BIP function, then mark
-- the object as having no initialization.
- if Definite and then not Is_OK_Return_Object then
-
+ if Definite and not Is_OK_Return_Object and not Constraint_Check_Needed
+ then
Set_Expression (Obj_Decl, Empty);
Set_No_Initialization (Obj_Decl);
@@ -9150,6 +9159,10 @@ package body Exp_Ch6 is
Analyze (Obj_Decl);
Replace_Renaming_Declaration_Id
(Obj_Decl, Original_Node (Obj_Decl));
+
+ if Constraint_Check_Needed then
+ Apply_Constraint_Check (Call_Deref, Obj_Typ);
+ end if;
end if;
pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id));
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index db892d0a5be..4ed0598bcec 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1149,29 +1149,6 @@ package body Sem_Ch8 is
Resolve (Nam, T);
- -- If the renamed object is a function call of a limited type,
- -- the expansion of the renaming is complicated by the presence
- -- of various temporaries and subtypes that capture constraints
- -- of the renamed object. Rewrite node as an object declaration,
- -- whose expansion is simpler. Given that the object is limited
- -- there is no copy involved and no performance hit.
-
- if Nkind (Nam) = N_Function_Call
- and then Is_Inherently_Limited_Type (Etype (Nam))
- and then not Is_Constrained (Etype (Nam))
- and then Comes_From_Source (N)
- then
- Set_Etype (Id, T);
- Mutate_Ekind (Id, E_Constant);
- Rewrite (N,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Id,
- Constant_Present => True,
- Object_Definition => New_Occurrence_Of (Etype (Nam), Loc),
- Expression => Relocate_Node (Nam)));
- return;
- end if;
-
-- Ada 2012 (AI05-149): Reject renaming of an anonymous access object
-- when renaming declaration has a named access type. The Ada 2012
-- coverage rules allow an anonymous access type in the context of
--
2.43.0
