Patchwork [Ada] Ada/C++ missing call to constructor with defaults

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 2, 2012, 12:29 p.m.
Message ID <20121002122950.GA20376@adacore.com>
Download mbox | patch
Permalink /patch/188480/
State New
Headers show

Comments

Arnaud Charlet - Oct. 2, 2012, 12:29 p.m.
When the type of an object is a CPP type and the object initialization
requires calling its default C++ constructor, 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 must now compile and execute well.

// c_class.h
class Tester {
  public:
    Tester(unsigned int a_num = 5, char* a_className = 0);
    virtual int dummy();
};

// 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";
  }

  std::cout << std::endl;
}

int Tester::dummy() {
}

--  c_class_h.ads
pragma Ada_2005;
pragma Style_Checks (Off);

with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings;

package c_class_h is

   package Class_Tester is
      type Tester is tagged 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;
      pragma CPP_Constructor (New_Tester, "_ZN6TesterC1EjPc");

      function dummy (this : access Tester) return int;
      pragma Import (CPP, dummy, "_ZN6Tester5dummyEv");
   end;
   use Class_Tester;
end c_class_h;


--  main.adb
with c_class_h; use c_class_h;
procedure Main is
   use Class_Tester;

   Obj : Tester;                 --  Test
   pragma Unreferenced (Obj);
begin
   null;
end main;


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 (".");
   for Object_Dir use "obj";

   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:
  mkdir obj
  gprclean -q -P ada2cppc.gpr
  gprbuild -q -P ada2cppc.gpr
  obj/main

Output:
 ctor Tester called 5:null

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-02  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Set_CPP_Constructors): Handle constructor with default
	parameters that covers the default constructor.

Patch

Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 191972)
+++ exp_disp.adb	(working copy)
@@ -8537,6 +8537,10 @@ 
       Body_Stmts            : List_Id;
       Init_Tags_List        : List_Id;
 
+      Covers_Default_Constructor : Entity_Id := Empty;
+
+   --  Start of processing for Set_CPP_Constructor
+
    begin
       pragma Assert (Is_CPP_Class (Typ));
 
@@ -8622,7 +8626,9 @@ 
                       Defining_Identifier =>
                         Make_Defining_Identifier (Loc,
                           Chars (Defining_Identifier (P))),
-                      Parameter_Type => New_Copy_Tree (Parameter_Type (P))));
+                      Parameter_Type      =>
+                        New_Copy_Tree (Parameter_Type (P)),
+                      Expression          => New_Copy_Tree (Expression (P))));
                   Next (P);
                end loop;
             end if;
@@ -8713,6 +8719,17 @@ 
 
             Discard_Node (Wrapper_Body_Node);
             Set_Init_Proc (Typ, Wrapper_Id);
+
+            --  If this constructor has parameters and all its parameters
+            --  have defaults then it covers the default constructor. The
+            --  semantic analyzer ensures that only one constructor with
+            --  defaults covers the default constructor.
+
+            if Present (Parameter_Specifications (Parent (E)))
+              and then Needs_No_Actuals (E)
+            then
+               Covers_Default_Constructor := Wrapper_Id;
+            end if;
          end if;
 
          Next_Entity (E);
@@ -8725,6 +8742,46 @@ 
          Set_Is_Abstract_Type (Typ);
       end if;
 
+      --  Handle constructor that has all its parameters with defaults and
+      --  hence it covers the default constructor. We generate a wrapper IP
+      --  which calls the covering constructor.
+
+      if Present (Covers_Default_Constructor) then
+         Loc := Sloc (Covers_Default_Constructor);
+
+         Body_Stmts := New_List (
+           Make_Procedure_Call_Statement (Loc,
+             Name                   =>
+               New_Reference_To (Covers_Default_Constructor, Loc),
+             Parameter_Associations => New_List (
+               Make_Identifier (Loc, Name_uInit))));
+
+         Wrapper_Id :=
+           Make_Defining_Identifier (Loc, Make_Init_Proc_Name (Typ));
+
+         Wrapper_Body_Node :=
+           Make_Subprogram_Body (Loc,
+             Specification              =>
+               Make_Procedure_Specification (Loc,
+                 Defining_Unit_Name       => Wrapper_Id,
+                 Parameter_Specifications => New_List (
+                   Make_Parameter_Specification (Loc,
+                     Defining_Identifier =>
+                       Make_Defining_Identifier (Loc, Name_uInit),
+                     Parameter_Type      =>
+                       New_Reference_To (Typ, Loc)))),
+
+             Declarations               => No_List,
+
+             Handled_Statement_Sequence =>
+               Make_Handled_Sequence_Of_Statements (Loc,
+                 Statements         => Body_Stmts,
+                 Exception_Handlers => No_List));
+
+         Discard_Node (Wrapper_Body_Node);
+         Set_Init_Proc (Typ, Wrapper_Id);
+      end if;
+
       --  If the CPP type has constructors then it must import also the default
       --  C++ constructor. It is required for default initialization of objects
       --  of the type. It is also required to elaborate objects of Ada types