* Tests for webassembly invoke helper

tests/test/testih.pp

@@ -0,0 +1,292 @@
+{ %CPU=wasm32 }
+{$mode objfpc}
+{$H+}
+uses typinfo, sysutils;
+
+{
+  Test for invoke helper generated by compiler in combination with CallInvokeHelper from Typinfo unit.
+  Test using COM interface
+}
+
+Type
+
+  {$M+}
+  I1 = interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    Procedure T2(a : Integer);
+    Function T3(a : Integer) : Integer;
+    procedure T4(var a : integer);
+    procedure T5(s : ansistring);
+    procedure T6(var s : ansistring);
+    procedure T7(sar : array of ansistring);
+  end;
+  
+  TT1 = Class(TInterfacedObject,I1)
+  Protected
+    Procedure T2(a : Integer);
+    Function T3(a : Integer) : Integer;
+    procedure T4(var a : integer);
+    procedure T5(s : ansistring);
+    procedure T6(var s : ansistring);
+    procedure T7(sar : array of ansistring);
+  Published
+    Procedure Test;  
+  end;
+
+  { TTestInvokeHelper }
+
+  TTestInvokeHelper = class
+  Public
+    FTest : string;
+    I : IInterface;
+    TI : PTypeInfo;
+    function GetInterfaceAsPtr: Pointer;
+    Procedure Fail(const S : String);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Ansistring);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure StartTest(const aName : string);
+    Constructor Create;
+  Published
+    Procedure DoTest2;
+    Procedure DoTest3;
+    Procedure DoTest4;
+    Procedure DoTest5;
+    Procedure DoTest6;
+    Procedure DoTest7;
+  end;
+  
+var
+  sa : Integer;  
+  ss : ansistring;
+  ssa : array of ansistring;
+  
+Procedure TT1.T2(a : Integer);
+
+begin
+  Writeln('in T2');
+  sa:=a;
+end;
+
+Function TT1.T3(a : Integer) : Integer;
+
+begin
+  Writeln('in t3');
+  result:=a;
+end;
+
+  
+Procedure TT1.Test;
+
+begin
+  Writeln('This is a test');  
+end;  
+
+procedure TT1.T4(var a : integer);
+
+begin
+  writeln('in t4');
+  sa:=a;
+  a:=321;
+end;
+
+procedure TT1.T5(s : ansistring);
+begin 
+  Writeln('In T5');
+  ss:=s;
+end;
+
+procedure TT1.T6(var s : ansistring);
+
+begin
+  ss:=s;
+  Writeln('In t6 : ',S);
+  S:='more testing';
+end;
+
+procedure TT1.T7(sar : array of ansistring);
+ 
+var
+  I : Integer;
+ 
+begin
+  writeln('T7');
+  setlength(ssa,length(sar));
+  for i:=0 to Length(sar)-1 do
+    ssa[i]:=sar[i];
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect,
+  aActual: Ansistring);
+begin
+  AssertTrue(Msg+': "'+aExpect+'" <> "'+aActual+'"',aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    Fail(' failed: '+Msg);
+end;
+
+procedure TTestInvokeHelper.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestInvokeHelper.StartTest(const aName: string);
+begin
+  FTest:=aName;
+  I:=Nil;
+end;
+
+constructor TTestInvokeHelper.Create;
+begin
+  TI:=TypeInfo(I1);
+end;
+
+
+function TTestInvokeHelper.GetInterfaceAsPtr: Pointer;
+
+var
+  IU : IInterface;
+
+begin
+  I:=Nil; // Free previous
+  I:=TT1.Create;
+  if Not Supports(I,I1,IU) then
+    Fail('No I1');
+  Result:=Pointer(IU);
+end;
+
+procedure TTestInvokeHelper.Fail(const S : String);
+
+begin
+  Writeln(FTest,' '+S);
+  Halt(1);
+end;
+  
+
+procedure TTestInvokeHelper.DoTest2;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest2');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T2',PPointer(Args));
+  AssertEquals('Value passed',A,sa);
+end;
+
+procedure TTestInvokeHelper.DoTest3;
+
+var
+  a,ra : Integer;
+  args : Array of pointer;
+
+begin
+  StartTest('DoTest3');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=@RA;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T3',PPointer(Args));
+  AssertEquals('Return result',A,Ra);
+end;
+
+procedure TTestInvokeHelper.DoTest4;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest4');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T4',PPointer(Args));
+  AssertEquals('Value passed',123,sa);
+  AssertEquals('Value returned',321,A);
+end;
+
+procedure TTestInvokeHelper.DoTest5;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest5');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T5',PPointer(Args));
+  AssertEquals('Value passed',s,ss);
+end;
+
+procedure TTestInvokeHelper.DoTest6;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest6');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T6',PPointer(Args));
+  AssertEquals('Value passed','123',ss);
+  AssertEquals('Value returned','more testing',s);
+end;
+
+procedure TTestInvokeHelper.DoTest7;
+
+var
+  sar : array of ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest7');
+  setlength(sar,3);
+  sar[0]:='123';
+  sar[1]:='456';
+  sar[2]:='789';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@Sar;
+  CallInvokeHelper(TI,GetInterfaceAsPTR,'T7',PPointer(Args));
+  AssertEquals('Length value passed',3,length(ssa));
+  AssertEquals('Value 0 passed','123',ssa[0]);
+  AssertEquals('Value 1 passed','456',ssa[1]);
+  AssertEquals('Value 2 passed','789',ssa[2]);
+end;
+  
+
+begin
+  With TTestInvokeHelper.Create do
+    try
+      DoTest2;
+      DoTest3;
+      DoTest4;
+      DoTest5;
+      DoTest6;
+      DoTest7;
+      Writeln('All OK');
+    finally
+      Free;
+    end;   
+end.

tests/test/testihn.pp

@@ -0,0 +1,295 @@
+{ %CPU=wasm32 }
+{$mode objfpc}
+{$H+}
+uses typinfo, sysutils;
+
+{
+  Test for invoke helper generated by compiler in combination with CallInvokeHelper from Typinfo unit.
+  Test using COM interface
+}
+
+Type
+
+  {$M+}
+  TNested = Class
+    Type
+      I1 = interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+        Procedure T2(a : Integer);
+        Function T3(a : Integer) : Integer;
+        procedure T4(var a : integer);
+        procedure T5(s : ansistring);
+        procedure T6(var s : ansistring);
+        procedure T7(sar : array of ansistring);
+      end;
+  end;
+    
+  TT1 = Class(TInterfacedObject,TNested.I1)
+  Protected
+    Procedure T2(a : Integer);
+    Function T3(a : Integer) : Integer;
+    procedure T4(var a : integer);
+    procedure T5(s : ansistring);
+    procedure T6(var s : ansistring);
+    procedure T7(sar : array of ansistring);
+  Published
+    Procedure Test;  
+  end;
+
+  { TTestInvokeHelper }
+
+  TTestInvokeHelper = class
+  Public
+    FTest : string;
+    I : IInterface;
+    TI : PTypeInfo;
+    function GetInterfaceAsPtr: Pointer;
+    Procedure Fail(const S : String);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Ansistring);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure StartTest(const aName : string);
+    Constructor Create;
+  Published
+    Procedure DoTest2;
+    Procedure DoTest3;
+    Procedure DoTest4;
+    Procedure DoTest5;
+    Procedure DoTest6;
+    Procedure DoTest7;
+  end;
+  
+var
+  sa : Integer;  
+  ss : ansistring;
+  ssa : array of ansistring;
+  
+Procedure TT1.T2(a : Integer);
+
+begin
+  Writeln('in T2');
+  sa:=a;
+end;
+
+Function TT1.T3(a : Integer) : Integer;
+
+begin
+  Writeln('in t3');
+  result:=a;
+end;
+
+  
+Procedure TT1.Test;
+
+begin
+  Writeln('This is a test');  
+end;  
+
+procedure TT1.T4(var a : integer);
+
+begin
+  writeln('in t4');
+  sa:=a;
+  a:=321;
+end;
+
+procedure TT1.T5(s : ansistring);
+begin 
+  Writeln('In T5');
+  ss:=s;
+end;
+
+procedure TT1.T6(var s : ansistring);
+
+begin
+  ss:=s;
+  Writeln('In t6 : ',S);
+  S:='more testing';
+end;
+
+procedure TT1.T7(sar : array of ansistring);
+ 
+var
+  I : Integer;
+ 
+begin
+  writeln('T7');
+  setlength(ssa,length(sar));
+  for i:=0 to Length(sar)-1 do
+    ssa[i]:=sar[i];
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect,
+  aActual: Ansistring);
+begin
+  AssertTrue(Msg+': "'+aExpect+'" <> "'+aActual+'"',aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    Fail(' failed: '+Msg);
+end;
+
+procedure TTestInvokeHelper.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestInvokeHelper.StartTest(const aName: string);
+begin
+  FTest:=aName;
+  I:=Nil;
+end;
+
+constructor TTestInvokeHelper.Create;
+begin
+  TI:=TypeInfo(TNested.I1);
+end;
+
+
+function TTestInvokeHelper.GetInterfaceAsPtr: Pointer;
+
+var
+  IU : IInterface;
+
+begin
+  I:=Nil; // Free previous
+  I:=TT1.Create;
+  if Not Supports(I,TNested.I1,IU) then
+    Fail('No I1');
+  Result:=Pointer(IU);
+end;
+
+procedure TTestInvokeHelper.Fail(const S : String);
+
+begin
+  Writeln(FTest,' '+S);
+  Halt(1);
+end;
+  
+
+procedure TTestInvokeHelper.DoTest2;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest2');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T2',PPointer(Args));
+  AssertEquals('Value passed',A,sa);
+end;
+
+procedure TTestInvokeHelper.DoTest3;
+
+var
+  a,ra : Integer;
+  args : Array of pointer;
+
+begin
+  StartTest('DoTest3');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=@RA;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T3',PPointer(Args));
+  AssertEquals('Return result',A,Ra);
+end;
+
+procedure TTestInvokeHelper.DoTest4;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest4');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T4',PPointer(Args));
+  AssertEquals('Value passed',123,sa);
+  AssertEquals('Value returned',321,A);
+end;
+
+procedure TTestInvokeHelper.DoTest5;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest5');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T5',PPointer(Args));
+  AssertEquals('Value passed',s,ss);
+end;
+
+procedure TTestInvokeHelper.DoTest6;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest6');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T6',PPointer(Args));
+  AssertEquals('Value passed','123',ss);
+  AssertEquals('Value returned','more testing',s);
+end;
+
+procedure TTestInvokeHelper.DoTest7;
+
+var
+  sar : array of ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest7');
+  setlength(sar,3);
+  sar[0]:='123';
+  sar[1]:='456';
+  sar[2]:='789';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@Sar;
+  CallInvokeHelper(TI,GetInterfaceAsPTR,'T7',PPointer(Args));
+  AssertEquals('Length value passed',3,length(ssa));
+  AssertEquals('Value 0 passed','123',ssa[0]);
+  AssertEquals('Value 1 passed','456',ssa[1]);
+  AssertEquals('Value 2 passed','789',ssa[2]);
+end;
+  
+
+begin
+  With TTestInvokeHelper.Create do
+    try
+      DoTest2;
+      DoTest3;
+      DoTest4;
+      DoTest5;
+      DoTest6;
+      DoTest7;
+      Writeln('All OK');
+    finally
+      Free;
+    end;   
+end.

tests/test/testihr.pp

@@ -0,0 +1,301 @@
+{ %CPU=wasm32 }
+{$mode objfpc}
+{$H+}
+{$Interfaces CORBA}
+uses typinfo, sysutils;
+
+{
+  Test for invoke helper generated by compiler in combination with CallInvokeHelper from Typinfo unit.
+  Test using COM interface
+}
+
+Type
+
+  {$M+}
+  I1 = interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    Procedure T2(a : Integer);
+    Function T3(a : Integer) : Integer;
+    procedure T4(var a : integer);
+    procedure T5(s : ansistring);
+    procedure T6(var s : ansistring);
+    procedure T7(sar : array of ansistring);
+  end;
+  
+  TT1 = Class(TObject,I1)
+  Protected
+    Procedure T2(a : Integer);
+    Function T3(a : Integer) : Integer;
+    procedure T4(var a : integer);
+    procedure T5(s : ansistring);
+    procedure T6(var s : ansistring);
+    procedure T7(sar : array of ansistring);
+  Published
+    Procedure Test;  
+  end;
+
+  { TTestInvokeHelper }
+
+  TTestInvokeHelper = class
+  Public
+    FTest : string;
+    C : TT1;
+    I : I1;
+    TI : PTypeInfo;
+    function GetInterfaceAsPtr: Pointer;
+    Procedure Fail(const S : String);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Ansistring);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure StartTest(const aName : string);
+    Constructor Create;
+    Destructor destroy; override;
+  Published
+    Procedure DoTest2;
+    Procedure DoTest3;
+    Procedure DoTest4;
+    Procedure DoTest5;
+    Procedure DoTest6;
+    Procedure DoTest7;
+  end;
+  
+var
+  sa : Integer;  
+  ss : ansistring;
+  ssa : array of ansistring;
+  
+Procedure TT1.T2(a : Integer);
+
+begin
+  Writeln('in T2');
+  sa:=a;
+end;
+
+Function TT1.T3(a : Integer) : Integer;
+
+begin
+  Writeln('in t3');
+  result:=a;
+end;
+
+  
+Procedure TT1.Test;
+
+begin
+  Writeln('This is a test');  
+end;  
+
+procedure TT1.T4(var a : integer);
+
+begin
+  writeln('in t4');
+  sa:=a;
+  a:=321;
+end;
+
+procedure TT1.T5(s : ansistring);
+begin 
+  Writeln('In T5');
+  ss:=s;
+end;
+
+procedure TT1.T6(var s : ansistring);
+
+begin
+  ss:=s;
+  Writeln('In t6 : ',S);
+  S:='more testing';
+end;
+
+procedure TT1.T7(sar : array of ansistring);
+ 
+var
+  I : Integer;
+ 
+begin
+  writeln('T7');
+  setlength(ssa,length(sar));
+  for i:=0 to Length(sar)-1 do
+    ssa[i]:=sar[i];
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect,
+  aActual: Ansistring);
+begin
+  AssertTrue(Msg+': "'+aExpect+'" <> "'+aActual+'"',aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    Fail(' failed: '+Msg);
+end;
+
+procedure TTestInvokeHelper.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestInvokeHelper.StartTest(const aName: string);
+begin
+  FTest:=aName;
+  I:=Nil;
+end;
+
+constructor TTestInvokeHelper.Create;
+begin
+  TI:=TypeInfo(I1);
+  C:=Nil;
+end;
+
+destructor TTestInvokeHelper.destroy;
+begin
+  FreeAndNil(C);
+  inherited destroy;
+end;
+
+
+function TTestInvokeHelper.GetInterfaceAsPtr: Pointer;
+
+begin
+  // Clear previous
+  I:=Nil;
+  FreeAndNil(C);
+  C:=TT1.Create;
+  if Not Supports(C,I1,I) then
+    Fail('No I1');
+  Result:=Pointer(I);
+end;
+
+procedure TTestInvokeHelper.Fail(const S : String);
+
+begin
+  Writeln(FTest,' '+S);
+  Halt(1);
+end;
+  
+
+procedure TTestInvokeHelper.DoTest2;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest2');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T2',PPointer(Args));
+  AssertEquals('Value passed',A,sa);
+end;
+
+procedure TTestInvokeHelper.DoTest3;
+
+var
+  a,ra : Integer;
+  args : Array of pointer;
+
+begin
+  StartTest('DoTest3');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=@RA;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T3',PPointer(Args));
+  AssertEquals('Return result',A,Ra);
+end;
+
+procedure TTestInvokeHelper.DoTest4;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest4');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T4',PPointer(Args));
+  AssertEquals('Value passed',123,sa);
+  AssertEquals('Value returned',321,A);
+end;
+
+procedure TTestInvokeHelper.DoTest5;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest5');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T5',PPointer(Args));
+  AssertEquals('Value passed',s,ss);
+end;
+
+procedure TTestInvokeHelper.DoTest6;
+
+var
+  s : ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest6');
+  s:='123';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@S;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T6',PPointer(Args));
+  AssertEquals('Value passed','123',ss);
+  AssertEquals('Value returned','more testing',s);
+end;
+
+procedure TTestInvokeHelper.DoTest7;
+
+var
+  sar : array of ansistring;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest7');
+  setlength(sar,3);
+  sar[0]:='123';
+  sar[1]:='456';
+  sar[2]:='789';
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@Sar;
+  CallInvokeHelper(TI,GetInterfaceAsPTR,'T7',PPointer(Args));
+  AssertEquals('Length value passed',3,length(ssa));
+  AssertEquals('Value 0 passed','123',ssa[0]);
+  AssertEquals('Value 1 passed','456',ssa[1]);
+  AssertEquals('Value 2 passed','789',ssa[2]);
+end;
+  
+
+begin
+  With TTestInvokeHelper.Create do
+    try
+      DoTest2;
+      DoTest3;
+      DoTest4;
+      DoTest5;
+      DoTest6;
+      DoTest7;
+      Writeln('All OK');
+    finally
+      Free;
+    end;   
+end.

tests/test/testihvo.pp

@@ -0,0 +1,191 @@
+{ %CPU=wasm32 }
+{$mode objfpc}
+{$H+}
+uses typinfo, sysutils;
+
+{
+  Test for invoke helper generated by compiler in combination with CallInvokeHelper from Typinfo unit.
+  Test using COM interface
+}
+
+Type
+
+  {$M+}
+  I1 = interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    procedure T1(var a);
+    procedure T2(out a);
+    procedure T3(constref a);
+  end;
+  
+  TT1 = Class(TInterfacedObject,I1)
+  Protected
+    procedure T1(var a);
+    procedure T2(out a);
+    procedure T3(constref a);
+  end;
+
+  { TTestInvokeHelper }
+
+  TTestInvokeHelper = class
+  Public
+    FTest : string;
+    I : IInterface;
+    TI : PTypeInfo;
+    function GetInterfaceAsPtr: Pointer;
+    Procedure Fail(const S : String);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Ansistring);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure StartTest(const aName : string);
+    Constructor Create;
+  Published
+    Procedure DoTest1;
+    Procedure DoTest2;
+    Procedure DoTest3;
+  end;
+  
+var
+  sa : Integer;  
+  ss : ansistring;
+  ssa : array of ansistring;
+  
+Procedure TT1.T1(var a);
+
+begin
+  Writeln('in T1');
+  sa:=PInteger(@a)^;
+  PInteger(@a)^:=321;
+end;
+
+procedure TT1.T2(out a);
+
+begin
+  Writeln('in T2');
+  PInteger(@a)^:=321;
+end;
+
+  
+Procedure TT1.T3(constref a);
+
+begin
+  Writeln('in T3');
+  sa:=PInteger(@a)^;
+end;  
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertEquals(Msg: string; aExpect,
+  aActual: Ansistring);
+begin
+  AssertTrue(Msg+': "'+aExpect+'" <> "'+aActual+'"',aExpect=aActual);
+end;
+
+procedure TTestInvokeHelper.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    Fail(' failed: '+Msg);
+end;
+
+procedure TTestInvokeHelper.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestInvokeHelper.StartTest(const aName: string);
+begin
+  FTest:=aName;
+  I:=Nil;
+end;
+
+constructor TTestInvokeHelper.Create;
+begin
+  TI:=TypeInfo(I1);
+end;
+
+
+function TTestInvokeHelper.GetInterfaceAsPtr: Pointer;
+
+var
+  IU : IInterface;
+
+begin
+  I:=Nil; // Free previous
+  I:=TT1.Create;
+  if Not Supports(I,I1,IU) then
+    Fail('No I1');
+  Result:=Pointer(IU);
+end;
+
+procedure TTestInvokeHelper.Fail(const S : String);
+
+begin
+  Writeln(FTest,' '+S);
+  Halt(1);
+end;
+  
+
+procedure TTestInvokeHelper.DoTest1;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest1');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T1',PPointer(Args));
+  AssertEquals('Value passed',123,sa);
+  AssertEquals('Retured value',321,A);
+end;
+
+procedure TTestInvokeHelper.DoTest2;
+
+var
+  a : Integer;
+  args : Array of pointer;
+  
+begin
+  StartTest('DoTest2');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=Nil;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T2',PPointer(Args));
+  AssertEquals('Returned value',321,A);
+ 
+end;
+
+procedure TTestInvokeHelper.DoTest3;
+
+var
+  a,ra : Integer;
+  args : Array of pointer;
+
+begin
+  StartTest('DoTest3');
+  A:=123;
+  Setlength(Args,2);
+  Args[0]:=@RA;
+  Args[1]:=@A;
+  CallInvokeHelper(TI,GetInterfaceAsPtr,'T3',PPointer(Args));
+  AssertEquals('Value passed',A,sa);
+end;
+
+begin
+  With TTestInvokeHelper.Create do
+    try
+      DoTest1;
+      DoTest2;
+      DoTest3;
+      Writeln('All OK');
+    finally
+      Free;
+    end;   
+end.