* Hidden thunk class tests for webassembly

tests/test/tthunkcl1.pp

@@ -0,0 +1,137 @@
+{ %CPU=wasm32 }
+program tthunkcl1;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, typinfo, uthintf;
+
+Type
+
+  { TTestThunk }
+
+  TTestThunk = class(TObject)
+  private
+    FOffset : integer;
+    FExpectMethod,
+    FExpectArgInt : Integer;
+    FExpectCount : Integer;
+    FExpectResult : Boolean;
+    FReturnResultInt : Integer;
+    FExpectArgTypeInfo : TTypeKind;
+    FExpectResultTypeInfo : TTypeKind;
+    FTest : String;
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure ThunkCallBack(aInstance: Pointer; aMethod, aCount: Longint; aData : TInterfaceThunk.PArgData);
+  Public
+    Procedure DoTest;
+  end;
+
+procedure TTestThunk.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestThunk.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    begin
+    Writeln(FTest+' failed: ',Msg);
+    Halt(1);
+    end;
+end;
+
+procedure TTestThunk.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestThunk.ThunkCallBack(aInstance: Pointer; aMethod,
+  aCount: Longint; aData : TInterfaceThunk.PargData);
+
+begin
+  AssertEquals('Correct method called',FOffset+FExpectMethod,aMethod);
+  AssertEquals('Correct argument count',FExpectCount,aCount);
+  AssertTrue('Have result',Assigned(aData[0].addr)=FExpectResult);
+  if ACount>0 then
+    begin
+    AssertTrue('Have arg 0 type info',Assigned(aData[1].info));
+    AssertTrue('Have arg 0 correct type info',PTypeInfo(aData[1].Info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectArgTypeInfo of
+      tkInteger: AssertEquals('Correct arg 0 integer argument value ',FExpectArgInt,PInteger(aData[1].addr)^);
+    end;
+    end;
+ if FExpectResult then
+    begin
+    AssertTrue('Have correct result type info',PTypeInfo(aData[0].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectResultTypeInfo of
+      tkInteger: PInteger(aData[0].addr)^:=FReturnResultInt;
+    end;
+    end;
+end;
+
+procedure TTestThunk.DoTest;
+
+var
+  PI,PC : PTypeInfo;
+  PT : PTypeData;
+  I : TMyInterface;
+  TT : TInterfaceThunk;
+  TC : TInterfaceThunkClass;
+  R : Integer;
+
+begin
+  PI:=TypeInfo(TMyInterface);
+  AssertNotNull('Type info',PI);
+  PT:=GetTypeData(PI);
+  AssertNotNull('Type data ',PT);
+  AssertNotNull('Thunk class',PInterfaceData(PT)^.ThunkClass);
+  PC:=PInterfaceData(PT)^.ThunkClass^;
+  TC:=TInterfaceThunkClass(GetTypeData(PC)^.ClassType);
+  TT:=TC.create(@ThunkCallBack);
+  FOffset:=TT.InterfaceVMTOffset;
+  I:=TT as TMyInterface;
+  FTest:='DoA1';
+  FExpectMethod:=0; 
+  FExpectCount:=1;
+  FExpectResult:=False;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=12;
+  I.DoA(12);
+  FTest:='DoA2';
+  FExpectMethod:=1;
+  FExpectCount:=0;
+  FExpectResult:=False;
+  I.DoA;
+  FTest:='DoB';
+  FExpectMethod:=2;
+  FExpectCount:=0;
+  FExpectResult:=True;
+  FReturnResultint:=42;
+  FExpectResultTypeInfo:=tkInteger;
+  R:=I.DoB;
+  AssertEquals('Result',FReturnResultint,R);
+  FTest:='DoC';
+  FExpectMethod:=3;
+  FExpectCount:=1;
+  FExpectResult:=True;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=41;
+  FExpectResultTypeInfo:=tkInteger;
+  FReturnResultInt:=43;
+  R:=I.DoC(41);
+  AssertEquals('Result',FReturnResultint,R);
+  Writeln('All OK');
+end;
+
+begin
+  With TTestThunk.Create do
+   try
+     DoTest;
+   finally
+     Free;
+   end;
+end.
+

tests/test/tthunkcl2.pp

@@ -0,0 +1,133 @@
+{ %CPU=wasm32 }
+program tthunkcl2;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, typinfo, uthintfn;
+
+Type
+
+  { TTestThunk }
+
+  TTestThunk = class(TObject)
+  private
+    FExpectMethod,
+    FExpectArgInt : Integer;
+    FExpectCount : Integer;
+    FExpectResult : Boolean;
+    FReturnResultInt : Integer;
+    FExpectArgTypeInfo : TTypeKind;
+    FExpectResultTypeInfo : TTypeKind;
+    FTest : String;
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure ThunkCallBack(aInstance: Pointer; aMethod, aCount: Longint; aData : TInterfaceThunk.PargData);
+  Public
+    Procedure DoTest;
+  end;
+
+procedure TTestThunk.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestThunk.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    begin
+    Writeln(FTest+' failed: ',Msg);
+    Halt(1);
+    end;
+end;
+
+procedure TTestThunk.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestThunk.ThunkCallBack(aInstance: Pointer; aMethod,
+  aCount: Longint; aData : TInterfaceThunk.PArgData);
+
+begin
+  AssertEquals('Correct method called',FExpectMethod,aMethod);
+  AssertEquals('Correct argument count',FExpectMethod,aMethod);
+  AssertTrue('Have result',Assigned(aData[0].Addr)=FExpectResult);
+  if ACount>0 then
+    begin
+    AssertTrue('Have arg 0 type info',Assigned(adata[1].info));
+    AssertTrue('Have arg 0 correct type info',PTypeInfo(aData[1].Info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectArgTypeInfo of
+      tkInteger: AssertEquals('Correct arg 0 integer argument value ',FExpectArgInt,PInteger(aData[1].addr)^);
+    end;
+    end;
+ if FExpectResult then
+    begin
+    AssertTrue('Have correct result type info',PTypeInfo(aData[0].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectResultTypeInfo of
+      tkInteger: PInteger(aData[0].addr)^:=FReturnResultInt;
+    end;
+    end;
+end;
+
+procedure TTestThunk.DoTest;
+
+var
+  PI,PC : PTypeInfo;
+  PT : PTypeData;
+  I : TNested.TMyInterface;
+  TC : TInterfaceThunkClass;
+  R : Integer;
+
+begin
+  PI:=TypeInfo(TNested.TMyInterface);
+  AssertNotNull('Type info',PI);
+  PT:=GetTypeData(PI);
+  AssertNotNull('Type data ',PT);
+  AssertNotNull('Thunk class',PInterfaceData(PT)^.ThunkClass);
+  PC:=PInterfaceData(PT)^.ThunkClass^;
+  TC:=TInterfaceThunkClass(GetTypeData(PC)^.ClassType);
+  I:=TC.create(@ThunkCallBack) as TNested.TMyInterface;
+  FTest:='DoA1';
+  FExpectMethod:=3; // Skip 0..2, part of IInterface.
+  FExpectCount:=1;
+  FExpectResult:=False;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=12;
+  I.DoA(12);
+  FTest:='DoA2';
+  FExpectMethod:=4;
+  FExpectCount:=0;
+  FExpectResult:=False;
+  I.DoA;
+  FTest:='DoB';
+  FExpectMethod:=5;
+  FExpectCount:=0;
+  FExpectResult:=True;
+  FReturnResultint:=42;
+  FExpectResultTypeInfo:=tkInteger;
+  R:=I.DoB;
+  AssertEquals('Result',FReturnResultint,R);
+  FTest:='DoC';
+  FExpectMethod:=6;
+  FExpectCount:=1;
+  FExpectResult:=True;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=41;
+  FExpectResultTypeInfo:=tkInteger;
+  FReturnResultInt:=43;
+  R:=I.DoC(41);
+  AssertEquals('Result',FReturnResultint,R);
+  Writeln('All OK');
+end;
+
+begin
+  With TTestThunk.Create do
+   try
+     DoTest;
+   finally
+     Free;
+   end;
+end.
+

tests/test/tthunkcl3.pp

@@ -0,0 +1,140 @@
+{ %CPU=wasm32 }
+program tthunkcl3;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, typinfo;
+
+Type
+  {$M+}
+  TMyInterface = Interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    Procedure DoA(a : Integer);
+    Procedure DoA;
+    function doB : Integer;
+    function doc(a : integer) : integer;
+  end;
+
+  { TTestThunk }
+
+  TTestThunk = class(TObject)
+  private
+    FExpectMethod,
+    FExpectArgInt : Integer;
+    FExpectCount : Integer;
+    FExpectResult : Boolean;
+    FReturnResultInt : Integer;
+    FExpectArgTypeInfo : TTypeKind;
+    FExpectResultTypeInfo : TTypeKind;
+    FTest : String;
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure ThunkCallBack(aInstance: Pointer; aMethod, aCount: Longint; aData : TInterfaceThunk.PargData);
+  Public
+    Procedure DoTest;
+  end;
+
+procedure TTestThunk.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestThunk.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    begin
+    Writeln(FTest+' failed: ',Msg);
+    Halt(1);
+    end;
+end;
+
+procedure TTestThunk.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestThunk.ThunkCallBack(aInstance: Pointer; aMethod,
+  aCount: Longint; aData : TInterfaceThunk.PargData);
+
+begin
+  AssertEquals('Correct method called',FExpectMethod,aMethod);
+  AssertEquals('Correct argument count',FExpectMethod,aMethod);
+  AssertTrue('Have result',Assigned(aData[0].Addr)=FExpectResult);
+  if ACount>0 then
+    begin
+    AssertTrue('Have arg 0 type info',Assigned(aData[1].info));
+    AssertTrue('Have arg 0 correct type info',PTypeInfo(aData[1].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectArgTypeInfo of
+      tkInteger: AssertEquals('Correct arg 0 integer argument value ',FExpectArgInt,PInteger(aData[1].Addr)^);
+    end;
+    end;
+ if FExpectResult then
+    begin
+    AssertTrue('Have correct result type info',PTypeInfo(aData[0].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectResultTypeInfo of
+      tkInteger: PInteger(aData[0].addr)^:=FReturnResultInt;
+    end;
+    end;
+end;
+
+procedure TTestThunk.DoTest;
+
+var
+  PI,PC : PTypeInfo;
+  PT : PTypeData;
+  I : TMyInterface;
+  TC : TInterfaceThunkClass;
+  R : Integer;
+
+begin
+  PI:=TypeInfo(TMyInterface);
+  AssertNotNull('Type info',PI);
+  PT:=GetTypeData(PI);
+  AssertNotNull('Type data ',PT);
+  AssertNotNull('Thunk class',PInterfaceData(PT)^.ThunkClass);
+  PC:=PInterfaceData(PT)^.ThunkClass^;
+  TC:=TInterfaceThunkClass(GetTypeData(PC)^.ClassType);
+  I:=TC.create(@ThunkCallBack) as TMyInterface;
+  FTest:='DoA1';
+  FExpectMethod:=3; // Skip 0..2, part of IInterface.
+  FExpectCount:=1;
+  FExpectResult:=False;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=12;
+  I.DoA(12);
+  FTest:='DoA2';
+  FExpectMethod:=4;
+  FExpectCount:=0;
+  FExpectResult:=False;
+  I.DoA;
+  FTest:='DoB';
+  FExpectMethod:=5;
+  FExpectCount:=0;
+  FExpectResult:=True;
+  FReturnResultint:=42;
+  FExpectResultTypeInfo:=tkInteger;
+  R:=I.DoB;
+  AssertEquals('Result',FReturnResultint,R);
+  FTest:='DoC';
+  FExpectMethod:=6;
+  FExpectCount:=1;
+  FExpectResult:=True;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=41;
+  FExpectResultTypeInfo:=tkInteger;
+  FReturnResultInt:=43;
+  R:=I.DoC(41);
+  AssertEquals('Result',FReturnResultint,R);
+  Writeln('All OK');
+end;
+
+begin
+  With TTestThunk.Create do
+   try
+     DoTest;
+   finally
+     Free;
+   end;
+end.
+

tests/test/tthunkcl4.pp

@@ -0,0 +1,133 @@
+{ %CPU=wasm32 }
+program tthunkcl4;
+
+{$mode objfpc}
+{$h+}
+
+uses sysutils, typinfo, uthintfr;
+
+Type
+
+  { TTestThunk }
+
+  TTestThunk = class(TObject)
+  private
+    FExpectMethod,
+    FExpectArgInt : Integer;
+    FExpectCount : Integer;
+    FExpectResult : Boolean;
+    FReturnResultInt : Integer;
+    FExpectArgTypeInfo : TTypeKind;
+    FExpectResultTypeInfo : TTypeKind;
+    FTest : String;
+    Procedure AssertEquals(Msg : string; aExpect,aActual : Integer);
+    Procedure AssertTrue(Msg : string; aValue : Boolean);
+    Procedure AssertNotNull(Msg : string; aValue : Pointer);
+    procedure ThunkCallBack(aInstance: Pointer; aMethod, aCount: Longint; aData : TInterfaceThunk.PargData);
+  Public
+    Procedure DoTest;
+  end;
+
+procedure TTestThunk.AssertEquals(Msg: string; aExpect, aActual: Integer);
+begin
+  AssertTrue(Msg+': '+IntToStr(aExpect)+'<>'+IntToStr(aActual),aExpect=aActual);
+end;
+
+procedure TTestThunk.AssertTrue(Msg: string; aValue: Boolean);
+begin
+  if not aValue then
+    begin
+    Writeln(FTest+' failed: ',Msg);
+    Halt(1);
+    end;
+end;
+
+procedure TTestThunk.AssertNotNull(Msg: string; aValue: Pointer);
+begin
+  AssertTrue(Msg+': not null',Assigned(aValue));
+end;
+
+procedure TTestThunk.ThunkCallBack(aInstance: Pointer; aMethod,
+  aCount: Longint; aData  : TInterfaceThunk.PargData);
+
+begin
+  AssertEquals('Correct method called',FExpectMethod,aMethod);
+  AssertEquals('Correct argument count',FExpectMethod,aMethod);
+  AssertTrue('Have result',Assigned(aData[0].addr)=FExpectResult);
+  if ACount>0 then
+    begin
+    AssertTrue('Have arg 0 type info',Assigned(adata[1].info));
+    AssertTrue('Have arg 0 correct type info',PTypeInfo(adata[1].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectArgTypeInfo of
+      tkInteger: AssertEquals('Correct arg 0 integer argument value ',FExpectArgInt,PInteger(aData[1].addr)^);
+    end;
+    end;
+ if FExpectResult then
+    begin
+    AssertTrue('Have correct result type info',PTypeInfo(aData[0].info)^.Kind=FExpectArgTypeInfo);
+    Case FExpectResultTypeInfo of
+      tkInteger: PInteger(aData[0].Addr)^:=FReturnResultInt;
+    end;
+    end;
+end;
+
+procedure TTestThunk.DoTest;
+
+var
+  PI,PC : PTypeInfo;
+  PT : PTypeData;
+  I : TMyInterface;
+  TC : TInterfaceThunkClass;
+  R : Integer;
+
+begin
+  PI:=TypeInfo(TMyInterface);
+  AssertNotNull('Type info',PI);
+  PT:=GetTypeData(PI);
+  AssertNotNull('Type data ',PT);
+  AssertNotNull('Thunk class',PInterfaceData(PT)^.ThunkClass);
+  PC:=PInterfaceData(PT)^.ThunkClass^;
+  TC:=TInterfaceThunkClass(GetTypeData(PC)^.ClassType);
+  I:=TC.create(@ThunkCallBack) as TMyInterface;
+  FTest:='DoA1';
+  FExpectMethod:=0; // no IInterface, so start at 0.
+  FExpectCount:=1;
+  FExpectResult:=False;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=12;
+  I.DoA(12);
+  FTest:='DoA2';
+  FExpectMethod:=1;
+  FExpectCount:=0;
+  FExpectResult:=False;
+  I.DoA;
+  FTest:='DoB';
+  FExpectMethod:=2;
+  FExpectCount:=0;
+  FExpectResult:=True;
+  FReturnResultint:=42;
+  FExpectResultTypeInfo:=tkInteger;
+  R:=I.DoB;
+  AssertEquals('Result',FReturnResultint,R);
+  FTest:='DoC';
+  FExpectMethod:=3;
+  FExpectCount:=1;
+  FExpectResult:=True;
+  FExpectArgTypeInfo:=tkInteger;
+  FExpectArgInt:=41;
+  FExpectResultTypeInfo:=tkInteger;
+  FReturnResultInt:=43;
+  R:=I.DoC(41);
+  AssertEquals('Result',FReturnResultint,R);
+  Writeln('All OK');
+end;
+
+begin
+  With TTestThunk.Create do
+   try
+     DoTest;
+   finally
+     Free;
+   end;
+end.
+

tests/test/uthintf.pp

@@ -0,0 +1,63 @@
+{ %CPU=wasm32 }
+Unit uthintf;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+
+type
+  TArgdata = record
+    toto : string;
+  end;
+  
+  {$M+}
+  TMyInterface = Interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    Procedure DoA(a : Integer);
+    Procedure DoA;
+    function doB : Integer;
+    function doc(a : integer) : integer;
+    procedure DoD(var p);
+    procedure DoE(data : TargData);
+  end;
+
+  ITestInterface = interface
+    ['{1DE799BB-BEE9-405F-9AF3-D55DE978C793}']
+    procedure TestMethod1;
+    function  TestMethod2(aArg1: SizeInt): SizeInt;
+    procedure TestMethod3(aArg1: AnsiString);
+    procedure TestMethod4(aArg1: ShortString);
+    function  TestMethod5: AnsiString;
+    function  TestMethod6: ShortString;
+    procedure TestMethod7(aArg1: SizeInt; var aArg2: SizeInt; out aArg3: SizeInt; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: SizeInt);
+    procedure TestMethod8(aArg1: AnsiString; var aArg2: AnsiString; out aArg3: AnsiString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: AnsiString);
+    procedure TestMethod9(aArg1: ShortString; var aArg2: ShortString; out aArg3: ShortString; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: ShortString);
+    procedure TestMethod10(aArg1: Single; var aArg2: Single; out aArg3: Single; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Single);
+    procedure TestMethod11(aArg1: Double; var aArg2: Double; out aArg3: Double; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Double);
+    procedure TestMethod12(aArg1: Extended; var aArg2: Extended; out aArg3: Extended; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Extended);
+    procedure TestMethod13(aArg1: Comp; var aArg2: Comp; out aArg3: Comp; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Comp);
+    procedure TestMethod14(aArg1: Currency; var aArg2: Currency; out aArg3: Currency; {$ifdef fpc}constref{$else}const [ref]{$endif}aArg4: Currency);
+    function  TestMethod15(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: SizeInt): SizeInt;
+    function  TestMethod16(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Single): Single;
+    function  TestMethod17(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Double): Double;
+    function  TestMethod18(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Extended): Extended;
+    function  TestMethod19(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Comp): Comp;
+    function  TestMethod20(aArg1, aArg2, aArg3, aArg4, aArg5, aArg6, aArg7, aArg8, aArg9, aArg10: Currency): Currency;
+    procedure TestMethod21(var aArg1; out aArg2; const aArg3; {$ifdef fpc}constref{$else}const [ref]{$endif} aArg4);
+  end;
+
+ ITestInterface2 = interface
+    procedure Test;
+    function Test2: LongInt;
+    procedure Test3(aArg1: LongInt; const aArg2: AnsiString; var aArg3: Boolean; out aArg4: Word);
+    function Test4(aArg1: array of LongInt; aArg2: array of const): AnsiString;
+  end;
+
+  
+implementation
+
+end.  
+  
+  
+  

tests/test/uthintfn.pp

@@ -0,0 +1,28 @@
+{ %CPU=wasm32 }
+Unit uthintfn;
+
+{$mode objfpc}
+{$h+}
+
+interface
+
+
+type
+  {$M+}
+  TNested = class
+    Type
+      TMyInterface = Interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+        Procedure DoA(a : Integer);
+        Procedure DoA;
+        function doB : Integer;
+        function doc(a : integer) : integer;
+      end;
+  end;
+ 
+  
+implementation
+
+end.  
+  
+  
+  

tests/test/uthintfr.pp

@@ -0,0 +1,26 @@
+{ %CPU=wasm32 }
+Unit uthintfr;
+
+{$mode objfpc}
+{$h+}
+{$interfaces corba}
+
+interface
+
+
+type
+  {$M+}
+  TMyInterface = Interface ['{76DC0D03-376C-45AA-9E0C-B3546B0C7208}']
+    Procedure DoA(a : Integer);
+    Procedure DoA;
+    function doB : Integer;
+    function doc(a : integer) : integer;
+  end;
+
+ 
+implementation
+
+end.  
+  
+  
+