===================================================================
@@ -867,6 +867,15 @@
-- Start of processing for Expand_Allocator_Expression
begin
+ -- Handle call to C++ constructor
+
+ if Is_CPP_Constructor_Call (Exp) then
+ Make_CPP_Constructor_Call_In_Allocator
+ (Allocator => N,
+ Function_Call => Exp);
+ return;
+ end if;
+
-- In the case of an Ada 2012 allocator whose initial value comes from a
-- function call, pass "the accessibility level determined by the point
-- of call" (AI05-0234) to the function. Conceptually, this belongs in
@@ -899,59 +908,7 @@
-- Case of tagged type or type requiring finalization
if Is_Tagged_Type (T) or else Needs_Finalization (T) then
- if Is_CPP_Constructor_Call (Exp) then
- -- Generate:
- -- Pnnn : constant ptr_T := new (T);
- -- Init (Pnnn.all,...);
-
- -- Allocate the object without an expression
-
- Node := Relocate_Node (N);
- Set_Expression (Node, New_Reference_To (Etype (Exp), Loc));
-
- -- Avoid its expansion to avoid generating a call to the default
- -- C++ constructor.
-
- Set_Analyzed (Node);
-
- Temp := Make_Temporary (Loc, 'P', N);
-
- Temp_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Temp,
- Constant_Present => True,
- Object_Definition => New_Reference_To (PtrT, Loc),
- Expression => Node);
- Insert_Action (N, Temp_Decl);
-
- Apply_Accessibility_Check (Temp);
-
- -- Locate the enclosing list and insert the C++ constructor call
-
- declare
- P : Node_Id;
-
- begin
- P := Parent (Node);
- while not Is_List_Member (P) loop
- P := Parent (P);
- end loop;
-
- Insert_List_After_And_Analyze (P,
- Build_Initialization_Call (Loc,
- Id_Ref =>
- Make_Explicit_Dereference (Loc,
- Prefix => New_Reference_To (Temp, Loc)),
- Typ => Etype (Exp),
- Constructor_Ref => Exp));
- end;
-
- Rewrite (N, New_Reference_To (Temp, Loc));
- Analyze_And_Resolve (N, PtrT);
- return;
- end if;
-
-- Ada 2005 (AI-318-02): If the initialization expression is a call
-- to a build-in-place function, then access to the allocated object
-- must be passed to the function. Currently we limit such functions
===================================================================
@@ -9121,6 +9121,96 @@
end if;
end Make_Build_In_Place_Call_In_Object_Declaration;
+ --------------------------------------------
+ -- Make_CPP_Constructor_Call_In_Allocator --
+ --------------------------------------------
+
+ procedure Make_CPP_Constructor_Call_In_Allocator
+ (Allocator : Node_Id;
+ Function_Call : Node_Id)
+ is
+ Loc : constant Source_Ptr := Sloc (Function_Call);
+ Acc_Type : constant Entity_Id := Etype (Allocator);
+ Function_Id : constant Entity_Id := Entity (Name (Function_Call));
+ Result_Subt : constant Entity_Id := Available_View (Etype (Function_Id));
+
+ New_Allocator : Node_Id;
+ Return_Obj_Access : Entity_Id;
+ Tmp_Obj : Node_Id;
+
+ begin
+ pragma Assert (Nkind (Allocator) = N_Allocator
+ and then Nkind (Function_Call) = N_Function_Call);
+ pragma Assert (Convention (Function_Id) = Convention_CPP
+ and then Is_Constructor (Function_Id));
+ pragma Assert (Is_Constrained (Underlying_Type (Result_Subt)));
+
+ -- Replace the initialized allocator of form "new T'(Func (...))" with
+ -- an uninitialized allocator of form "new T", where T is the result
+ -- subtype of the called function. The call to the function is handled
+ -- separately further below.
+
+ New_Allocator :=
+ Make_Allocator (Loc,
+ Expression => New_Reference_To (Result_Subt, Loc));
+ Set_No_Initialization (New_Allocator);
+
+ -- Copy attributes to new allocator. Note that the new allocator
+ -- logically comes from source if the original one did, so copy the
+ -- relevant flag. This ensures proper treatment of the restriction
+ -- No_Implicit_Heap_Allocations in this case.
+
+ Set_Storage_Pool (New_Allocator, Storage_Pool (Allocator));
+ Set_Procedure_To_Call (New_Allocator, Procedure_To_Call (Allocator));
+ Set_Comes_From_Source (New_Allocator, Comes_From_Source (Allocator));
+
+ Rewrite (Allocator, New_Allocator);
+
+ -- Create a new access object and initialize it to the result of the
+ -- new uninitialized allocator. Note: we do not use Allocator as the
+ -- Related_Node of Return_Obj_Access in call to Make_Temporary below
+ -- as this would create a sort of infinite "recursion".
+
+ Return_Obj_Access := Make_Temporary (Loc, 'R');
+ Set_Etype (Return_Obj_Access, Acc_Type);
+
+ -- Generate:
+ -- Rnnn : constant ptr_T := new (T);
+ -- Init (Rnn.all,...);
+
+ Tmp_Obj :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Return_Obj_Access,
+ Constant_Present => True,
+ Object_Definition => New_Reference_To (Acc_Type, Loc),
+ Expression => Relocate_Node (Allocator));
+ Insert_Action (Allocator, Tmp_Obj);
+
+ Insert_List_After_And_Analyze (Tmp_Obj,
+ Build_Initialization_Call (Loc,
+ Id_Ref =>
+ Make_Explicit_Dereference (Loc,
+ Prefix => New_Reference_To (Return_Obj_Access, Loc)),
+ Typ => Etype (Function_Id),
+ Constructor_Ref => Function_Call));
+
+ -- Finally, replace the allocator node with a reference to the result of
+ -- the function call itself (which will effectively be an access to the
+ -- object created by the allocator).
+
+ Rewrite (Allocator, New_Reference_To (Return_Obj_Access, Loc));
+
+ -- Ada 2005 (AI-251): If the type of the allocator is an interface then
+ -- generate an implicit conversion to force displacement of the "this"
+ -- pointer.
+
+ if Is_Interface (Designated_Type (Acc_Type)) then
+ Rewrite (Allocator, Convert_To (Acc_Type, Relocate_Node (Allocator)));
+ end if;
+
+ Analyze_And_Resolve (Allocator, Acc_Type);
+ end Make_CPP_Constructor_Call_In_Allocator;
+
-----------------------------------
-- Needs_BIP_Finalization_Master --
-----------------------------------
===================================================================
@@ -205,6 +205,16 @@
-- for which Is_Build_In_Place_Call is True, or an N_Qualified_Expression
-- node applied to such a function call.
+ procedure Make_CPP_Constructor_Call_In_Allocator
+ (Allocator : Node_Id;
+ Function_Call : Node_Id);
+ -- Handle a call to a CPP constructor that occurs as the expression that
+ -- initializes an allocator, by passing access to the allocated object as
+ -- an additional parameter of the constructor call. A new access object is
+ -- declared that is initialized to the result of the allocator, passed to
+ -- the constructor, and the allocator is rewritten to refer to that access
+ -- object. Function_Call must denote a call to a CPP_Constructor function.
+
function Needs_BIP_Alloc_Form (Func_Id : Entity_Id) return Boolean;
-- Ada 2005 (AI-318-02): Return True if the function needs an implicit
-- BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
When the type of an object is a CPP untagged type, the object is allocated in memory through the "new" construct, and the object initialization requires calling its C++ constructor passing defaults, the Ada compiler did not generate the call to a C++ constructor which has all parameters with defaults (and hence it covers the default C++ constructor). The following test now executes well. // c_class.h class Tester { public: Tester(unsigned int a_num = 5, char* a_className = 0); }; // c_class.cc #include "c_class.h" #include <iostream> Tester::Tester(unsigned int a_num, char* a_className) { std::cout << " ctor Tester called " << a_num << ":"; if (a_className == 0) { std::cout << "null"; } else { std::cout << a_className; } std::cout << std::endl; } -- c_class_h.ads with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; package c_class_h is package Class_Tester is type Tester is limited record null; end record; pragma Import (CPP, Tester); function New_Tester (a_num : unsigned := 5; a_className : Interfaces.C.Strings.chars_ptr := Interfaces.C.Strings.Null_Ptr) return Tester; -- c_class.h:3 pragma CPP_Constructor (New_Tester, "_ZN6TesterC1EjPc"); end; use Class_Tester; end c_class_h; project Ada2Cppc is for Languages use ("Ada", "C++"); for Main use ("main.adb"); package Naming is for Implementation_Suffix ("C++") use ".cc"; end Naming; for Source_Dirs use ("."); package Compiler is for Default_Switches ("ada") use ("-gnat05"); end Compiler; package Builder is for Default_Switches ("ada") use ("-g"); end Builder; package Ide is for Compiler_Command ("ada") use "gnatmake"; for Compiler_Command ("c") use "gcc"; end Ide; end Ada2Cppc; Command: gprbuild -q -P ada2cppc.gpr; ./main Output: ctor Tester called 5:null Tested on x86_64-pc-linux-gnu, committed on trunk 2012-10-03 Javier Miranda <miranda@adacore.com> * exp_ch4.adb (Expand_N_Allocator_Expression): Minor code reorganization and cleanup. Done to ensure proper management of the C++ constructor covering tagged and untagged types and also non-default constructors. * exp_ch6.ads, exp_ch6.adb (Make_CPP_Constructor_Call_In_Allocator): New subprogram.