diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 86f304e90bba6e56e640dd0c2445e5940ccb93ad..a4e4d81f0a8f7b5df1aef7d948fa104896aaf9bc 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1493,7 +1493,7 @@ package body Exp_Aggr is
or else Has_Task (Base_Type (Ctype))
then
Append_List_To (Stmts,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Id_Ref => Indexed_Comp,
Typ => Ctype,
With_Default_Init => True));
@@ -2936,7 +2936,7 @@ package body Exp_Aggr is
if not Is_Interface (Init_Typ) then
Append_List_To (L,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Id_Ref => Ref,
Typ => Init_Typ,
In_Init_Proc => Within_Init_Proc,
@@ -2971,7 +2971,7 @@ package body Exp_Aggr is
Set_Assignment_OK (Ref);
Append_List_To (L,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Id_Ref => Ref,
Typ => Init_Typ,
In_Init_Proc => Within_Init_Proc,
@@ -3148,7 +3148,7 @@ package body Exp_Aggr is
if Is_CPP_Constructor_Call (Expression (Comp)) then
Append_List_To (L,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Id_Ref =>
Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
@@ -3217,7 +3217,7 @@ package body Exp_Aggr is
end;
Append_List_To (L,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Id_Ref => Make_Selected_Component (Loc,
Prefix => New_Copy_Tree (Target),
Selector_Name =>
@@ -3747,8 +3747,8 @@ package body Exp_Aggr is
Param := First (Parameter_Associations (Stmt));
Insert_Actions
(Stmt,
- Build_Initialization_Call
- (Sloc (N), New_Copy_Tree (Param), Etype (Param)));
+ Build_Initialization_Call (N,
+ New_Copy_Tree (Param), Etype (Param)));
end if;
Next (Stmt);
@@ -9279,13 +9279,11 @@ package body Exp_Aggr is
Present (Variant_Part (Component_List (Type_Definition (Decl))))
and then Nkind (N) /= N_Extension_Aggregate
then
-
-- Call init proc to set discriminants.
-- There should eventually be a special procedure for this ???
Ref := New_Occurrence_Of (Defining_Identifier (N), Loc);
- Insert_Actions_After (N,
- Build_Initialization_Call (Sloc (N), Ref, Typ));
+ Insert_Actions_After (N, Build_Initialization_Call (N, Ref, Typ));
end if;
end Initialize_Discriminants;
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 9109d592690588c6f492445b7e1bd18a585b6400..13a0c8e7500f79a8fe294b08d5b10ff9573c2b1a 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -699,7 +699,7 @@ package body Exp_Ch3 is
Clean_Task_Names (Comp_Type, Proc_Id);
return
Build_Initialization_Call
- (Loc => Loc,
+ (N => Nod,
Id_Ref => Comp,
Typ => Comp_Type,
In_Init_Proc => True,
@@ -1080,7 +1080,7 @@ package body Exp_Ch3 is
end if;
Comp_Init :=
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (N,
Obj_Ref, Typ, Target_Ref => Target_Ref);
end if;
end if;
@@ -2013,7 +2013,7 @@ package body Exp_Ch3 is
-- end;
function Build_Initialization_Call
- (Loc : Source_Ptr;
+ (N : Node_Id;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
@@ -2024,7 +2024,8 @@ package body Exp_Ch3 is
Constructor_Ref : Node_Id := Empty;
Init_Control_Actual : Entity_Id := Empty) return List_Id
is
- Res : constant List_Id := New_List;
+ Loc : constant Source_Ptr := Sloc (N);
+ Res : constant List_Id := New_List;
Full_Type : Entity_Id;
@@ -2322,6 +2323,24 @@ package body Exp_Ch3 is
-- Add discriminant values if discriminants are present
if Has_Discriminants (Full_Init_Type) then
+ -- If an allocated object will be constrained by the default
+ -- values for discriminants, then build a subtype with those
+ -- defaults, and change the allocated subtype to that. Note
+ -- that this happens in fewer cases in Ada 2005 (AI95-0363).
+
+ if Nkind (N) = N_Allocator
+ and then not Is_Constrained (Full_Type)
+ and then
+ Present
+ (Discriminant_Default_Value (First_Discriminant (Full_Type)))
+ and then (Ada_Version < Ada_2005
+ or else not Object_Type_Has_Constrained_Partial_View
+ (Full_Type, Current_Scope))
+ then
+ Full_Type := Build_Default_Subtype (Full_Type, N);
+ Set_Expression (N, New_Occurrence_Of (Full_Type, Loc));
+ end if;
+
Discr := First_Discriminant (Full_Init_Type);
while Present (Discr) loop
@@ -3715,7 +3734,7 @@ package body Exp_Ch3 is
if Is_CPP_Constructor_Call (Expression (Decl)) then
Actions :=
Build_Initialization_Call
- (Comp_Loc,
+ (Decl,
Id_Ref =>
Make_Selected_Component (Comp_Loc,
Prefix =>
@@ -3857,7 +3876,7 @@ package body Exp_Ch3 is
Init_Call_Stmts :=
Build_Initialization_Call
- (Comp_Loc,
+ (Decl,
Make_Selected_Component (Comp_Loc,
Prefix =>
Make_Identifier (Comp_Loc, Name_uInit),
@@ -4082,7 +4101,7 @@ package body Exp_Ch3 is
Append_List_To (Late_Stmts,
Build_Initialization_Call
- (Loc => Parent_Loc,
+ (N => Parent (Parent_Id),
Id_Ref =>
Make_Selected_Component (Parent_Loc,
Prefix => Make_Identifier
@@ -4113,7 +4132,7 @@ package body Exp_Ch3 is
elsif Has_Non_Null_Base_Init_Proc (Typ) then
Append_List_To (Late_Stmts,
- Build_Initialization_Call (Comp_Loc,
+ Build_Initialization_Call (Decl,
Make_Selected_Component (Comp_Loc,
Prefix =>
Make_Identifier (Comp_Loc, Name_uInit),
@@ -8099,7 +8118,7 @@ package body Exp_Ch3 is
Set_Assignment_OK (Id_Ref);
Insert_Actions_After (Init_After,
- Build_Initialization_Call (Loc, Id_Ref, Typ,
+ Build_Initialization_Call (N, Id_Ref, Typ,
Constructor_Ref => Expr));
-- We remove here the original call to the constructor
diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads
index 095d39394334195c8adf20f4e6a9ee5b7eb54e10..a8018d8dff30a66f153d2715b18c38b26b473cc3 100644
--- a/gcc/ada/exp_ch3.ads
+++ b/gcc/ada/exp_ch3.ads
@@ -92,7 +92,7 @@ package Exp_Ch3 is
-- derived type; no new subprograms are constructed in this case.
function Build_Initialization_Call
- (Loc : Source_Ptr;
+ (N : Node_Id;
Id_Ref : Node_Id;
Typ : Entity_Id;
In_Init_Proc : Boolean := False;
@@ -105,7 +105,7 @@ package Exp_Ch3 is
-- Builds a call to the initialization procedure for the base type of Typ,
-- passing it the object denoted by Id_Ref, plus additional parameters as
-- appropriate for the type (the _Master, for task types, for example).
- -- Loc is the source location for the constructed tree. In_Init_Proc has
+ -- N is the construct for which the call is to be built. In_Init_Proc has
-- to be set to True when the call is itself in an init proc in order to
-- enable the use of discriminals.
--
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index de75bd2fa924db53790441edfc557f8aecd6ddfe..a8a70a5759dced5440c1b584a60ef92101b23f7a 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9510,7 +9510,7 @@ package body Exp_Ch6 is
Insert_Action (Allocator, Tmp_Obj);
Insert_List_After_And_Analyze (Tmp_Obj,
- Build_Initialization_Call (Loc,
+ Build_Initialization_Call (Allocator,
Id_Ref =>
Make_Explicit_Dereference (Loc,
Prefix => New_Occurrence_Of (Return_Obj_Access, Loc)),