interfaceのマニュアル実装

Ada 
with Ada.Text_IO;              use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with System.Address_Image;
procedure Hello is
   package P is
      type Intf is interface;
      procedure Ex1 (Obj : access Intf) is abstract;
      type Intf_Access is access all Intf'Class;
      --pragma Cpp_Class(Intf);
      --pragma Cpp_Virtual(Ex1);
   end P;
   type Manual;
   type VMT is record
      Ex1 : access procedure (Obj : access Manual);
   end record;
   type VMT_Access is access constant VMT;
   type Manual is record
      VMT  : VMT_Access;
      Data : Integer;
   end record;
   procedure Ex1 (Obj : access Manual) is
   begin
      Put_Line (System.Address_Image (Obj.all'Address));
      Put_Line (Obj.Data'Img);
   end Ex1;
   type Manual_Access is access all Manual;
   MyVMT : aliased constant VMT := (Ex1 => Ex1'Access);
   Obj   : aliased Manual       := (VMT => MyVMT'Access, Data => 100);
   function "+" is new Ada.Unchecked_Conversion (Manual_Access, P.Intf_Access);
   X : P.Intf_Access := +Obj'Access;
   pragma Assertion_Policy (Ignore);
begin
   Put_Line (System.Address_Image (Obj'Address));
   X.Ex1;
end Hello;
0257FEB8
0257FEB8
 100

これができるということはCOM互換ということで、よしよし。
注意点。

  • Cpp_Classとかは別に要らん。
  • 引数をaccessではなくinとかにしてるともし値渡しとなったら無駄にハマるので素直にaccessにする。
  • 呼びだし時点でAssertion_PolicyをIgnoreにしとかないとTagがチェックされてAssertion_Failureくらう。

gnatpp便利だ。対応して無い構文があるのが惜しい。