[gcc r13-544] [Ada] Provide allocation subtype for allocators of a Designated_Storage_Model type

[gcc r13-544] [Ada] Provide allocation subtype for allocators of a Designated_Storage_Model type

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:867bf6f087e9566339cecce358319603ecd08248

commit r13-544-g867bf6f087e9566339cecce358319603ecd08248
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Fri Mar 25 12:56:24 2022 -0400

    [Ada] Provide allocation subtype for allocators of a Designated_Storage_Model type
    
    When an allocator is for an access type that has a
    Designated_Storage_Model aspect, and the designated type is an
    unconstrained record type with discriminants, and the subtype associated
    with the allocator is constrained, a dereference of the new access value
    can be passed to the designated type's initialization procedure. The
    post-front-end phase of the compiler needs to be able to create a
    temporary object in the host memory space to pass to the init proc,
    which requires creating such an object, but the subtype needed for the
    allocation isn't readily available at the point of the dereference.  To
    make the subtype easily accessible, we set the Actual_Designated_Subtype
    of such a dereference to the subtype of the allocated object.
    
    gcc/ada/
    
            * exp_ch4.adb (Expand_N_Allocator): For an allocator with an
            unconstrained discriminated designated type, and whose
            allocation subtype is constrained, set the
            Actual_Designated_Subtype of the dereference passed to the init
            proc of the designated type to be the allocation subtype.
            * sinfo.ads: Add documentation of new setting of
            Actual_Designated_Subtype on a dereference used as an actual
            parameter of call to an init proc associated with an allocator.
            Also add missing syntax and documentation for the GNAT language
            extension that allows an expression as a default for a concrete
            generic formal function.

Diff:
---
 gcc/ada/exp_ch4.adb | 24 ++++++++++++++++++++++++
 gcc/ada/sinfo.ads   | 28 ++++++++++++++++++++--------
 2 files changed, 44 insertions(+), 8 deletions(-)

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 74d40e5affd..aa291569f3b 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5135,6 +5135,30 @@ package body Exp_Ch4 is
                         Set_Expression (N, New_Occurrence_Of (Typ, Loc));
                      end if;
 
+                     --  When the designated subtype is unconstrained and
+                     --  the allocator specifies a constrained subtype (or
+                     --  such a subtype has been created, such as above by
+                     --  Build_Default_Subtype), associate that subtype with
+                     --  the dereference of the allocator's access value.
+                     --  This is needed by the back end for cases where
+                     --  the access type has a Designated_Storage_Model,
+                     --  to support allocation of a host object of the right
+                     --  size for passing to the initialization procedure.
+
+                     if not Is_Constrained (Dtyp)
+                       and then Is_Constrained (Typ)
+                     then
+                        declare
+                           Init_Deref : constant Node_Id :=
+                             Unqual_Conv (Init_Arg1);
+                        begin
+                           pragma Assert
+                             (Nkind (Init_Deref) = N_Explicit_Dereference);
+
+                           Set_Actual_Designated_Subtype (Init_Deref, Typ);
+                        end;
+                     end if;
+
                      Discr := First_Elmt (Discriminant_Constraint (Typ));
                      while Present (Discr) loop
                         Nod := Node (Discr);
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index ed61b1e3913..e3e06ee5f93 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -816,12 +816,15 @@ package Sinfo is
 
    --  Actual_Designated_Subtype
    --    Present in N_Free_Statement and N_Explicit_Dereference nodes. If gigi
-   --    needs to known the dynamic constrained subtype of the designated
-   --    object, this attribute is set to that type. This is done for
-   --    N_Free_Statements for access-to-classwide types and access to
-   --    unconstrained packed array types, and for N_Explicit_Dereference when
-   --    the designated type is an unconstrained packed array and the
-   --    dereference is the prefix of a 'Size attribute reference.
+   --    needs to know the dynamic constrained subtype of the designated
+   --    object, this attribute is set to that subtype. This is done for
+   --    N_Free_Statements for access-to-classwide types and access-to-
+   --    unconstrained packed array types. For N_Explicit_Dereference,
+   --    this is done in two circumstances: 1) when the designated type is
+   --    an unconstrained packed array and the dereference is the prefix of
+   --    a 'Size attribute reference, or 2) when the dereference node is
+   --    created for the expansion of an allocator with a subtype_indication
+   --    and the designated subtype is an unconstrained discriminated type.
 
    --  Address_Warning_Posted
    --    Present in N_Attribute_Definition nodes. Set to indicate that we have
@@ -7313,10 +7316,15 @@ package Sinfo is
       --  Specification
       --  Default_Name (set to Empty if no subprogram default)
       --  Box_Present
+      --  Expression (set to Empty if no expression present)
 
-      --  Note: if no subprogram default is present, then Name is set
+      --  Note: If no subprogram default is present, then Name is set
       --  to Empty, and Box_Present is False.
 
+      --  Note: The Expression field is only used for the GNAT extension
+      --  that allows a FORMAL_CONCRETE_SUBPROGRAM_DECLARATION to specify
+      --  an expression default for generic formal functions.
+
       --------------------------------------------------
       -- 12.6  Formal Abstract Subprogram Declaration --
       --------------------------------------------------
@@ -7338,13 +7346,17 @@ package Sinfo is
       -- 12.6  Subprogram Default --
       ------------------------------
 
-      --  SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <>
+      --  SUBPROGRAM_DEFAULT ::= DEFAULT_NAME | <> | (EXPRESSION)
 
       --  There is no separate node in the tree for a subprogram default.
       --  Instead the parent (N_Formal_Concrete_Subprogram_Declaration
       --  or N_Formal_Abstract_Subprogram_Declaration) node contains the
       --  default name or box indication, as needed.
 
+      --  Note: The syntax "(EXPRESSION)" is a GNAT extension, and allows
+      --  a FORMAL_CONCRETE_SUBPROGRAM_DECLARATION to specify an expression
+      --  default for formal functions, in analogy with expression_functions.
+
       ------------------------
       -- 12.6  Default Name --
       ------------------------