[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.

2 files changed, 44 insertions, 8 deletions

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 74d40e5..aa29156 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 ed61b1e..e3e06ee 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 --
       ------------------------