ada: Constraint check on tagged build-in-place object decls

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.

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index d884e755d66b536ec5bc19ba59daefa29410096c..cf2238e9ee19ea0644b7b9aecbc70827012ecbab 100644 (file)
--- 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 f85d977d0d805e08034bf1e00cfab924b39c7f7f..84847377bf3372352775fb34062ca68fe89b3c9b 100644 (file)
--- 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 db892d0a5befea45c5e6f46a78d3f0f9f74a672a..4ed0598bcec9c2aa00745b5098894de2474019b9 100644 (file)
--- 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