* Updated tests for new IUnknown.QueryInterface, _AddRef and _Release definitions

git-svn-id: branches/xpcom@16097 -

tests/tbs/tb0546.pp

@@ -41,9 +41,9 @@ type
    private
       FInnerX: TInnerObject;
    protected
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     function GetX: TInnerObject; virtual;
     function GetY: IYInterface;
    public
@@ -96,7 +96,7 @@ begin
    result := -1;
 end;
 
-function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TFoo.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
 end;function TFoo.GetX: TInnerObject;

tests/test/tinterface4.pp

@@ -13,9 +13,9 @@ type
   end;
   TA = class(TObject, IA, IInterface)
     destructor Destroy; override;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure AfterConstruction; override;
     class function NewInstance: TObject; override;
   end;
@@ -32,13 +32,13 @@ begin
   inherited AfterConstruction;
 end;
 
-function TA._AddRef: Integer; stdcall;
+function TA._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   InterlockedIncrement(fRefCount);
   Result := 0;
 end;
 
-function TA._Release: Integer; stdcall;
+function TA._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   InterlockedDecrement(fRefCount);
   if fRefCount = 0 then begin
@@ -49,7 +49,7 @@ begin
   Result := 0;
 end;
 
-function TA.QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
+function TA.QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   Result := E_NOINTERFACE;
 end;

tests/test/tsafecall1.pp

@@ -1,14 +1,16 @@
+program test;
 { %TARGET=win32,win64,wince}
 {$ifdef fpc}
 {$mode objfpc}
 {$endif}
 uses
-  SysUtils;
+  SysUtils,classes;
 type
-  TTest = class
+  TTest = class(TComponent)
   public
     procedure SomeError; safecall;
     function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
+    procedure QueryInterface(constref IID: TGUID; out Obj): Hresult; override; cdecl;
   end;
 
 var

tests/webtbs/tw10897.pp

@@ -22,9 +22,9 @@ type
     fRef: Integer;
   public
     function GetOwner: IMyIntf;
-    function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): HRESULT; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
     procedure Poing;
   end;
  
@@ -52,7 +52,7 @@ begin
   Writeln('GetOwner2');
 end;
  
-function TMYClass.QueryInterface(const IID: TGUID; out Obj): HRESULT;
+function TMYClass.QueryInterface(constref IID: TGUID; out Obj): HRESULT;
 begin
   if GetInterface(IID, Obj) then
     result := S_OK else result := -1;

tests/webtbs/tw15363.pp

@@ -10,18 +10,18 @@ type
   TTestBE = class (TObject, ITest)
     function TestIt: integer;
     { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   End;
 
   TTest = class (TPersistent, IInterface)
     BE : TTestBE;
     protected
     { IInterface }
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   End;
 
 function TTestBE.TestIt : integer;
@@ -39,7 +39,7 @@ begin
   Result := -1;
 end;
 
-function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TTest.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   Result := BE.QueryInterface(IID, obj);
 end;
@@ -54,7 +54,7 @@ begin
   Result := -1;
 end;
 
-function TTestBE.QueryInterface(const IID: TGUID; out Obj): HResult;
+function TTestBE.QueryInterface(constref IID: TGUID; out Obj): HResult;
 begin
   if GetInterface(IID, Obj)
     then Result := 0

tests/webtbs/tw16592.pp

@@ -24,9 +24,9 @@ type
     protected
       FRefCount : longint;
     public
-      function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
-      function _AddRef : longint;stdcall;
-      function _Release : longint;stdcall;
+      function QueryInterface(constref iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+      function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+      function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
       constructor Create;
 
@@ -96,7 +96,7 @@ end;
     WriteLn(Format('%s Obj=$%P class=%s RefCount=%d', [Str, Pointer(Self), ClassName, FRefCount]));
   end;
 
-function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdcall;
+function TInterfacedObj.QueryInterface(constref iid: tguid; out obj): longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     Result:=GetInterface(iid, obj);
 
@@ -105,7 +105,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
       Result:=FOwner.QueryInterface(iid, obj);
   end;
 
-  function TInterfacedObj._AddRef : longint;stdcall;[public,alias:'TInterfacedObj_AddRef'];
+  function TInterfacedObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};[public,alias:'TInterfacedObj_AddRef'];
   begin
     if not FDestructorCalled then
       begin
@@ -117,7 +117,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
       end;
   end;
 
-  function TInterfacedObj._Release : longint;stdcall;
+  function TInterfacedObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     if FDestructorCalled then Exit;
 

tests/webtbs/tw2177.pp

@@ -16,25 +16,25 @@ type
 
   Twii= class(TObject, ii)
     s: string;
-    function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
+    function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 
     procedure Show;stdcall;
   end;
 
   {________doomy interfaces______}
-  function Twii.QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
+  function Twii.QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;
 
-  function Twii._AddRef: Integer; stdcall;
+  function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;
 
-  function Twii._Release: Integer; stdcall;
+  function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
   begin
     result:= -1;
   end;

tests/webtbs/tw4086.pp

@@ -19,9 +19,9 @@ type
  
  ttestclass1 = class(tobject,itest)
   public
-   function queryinterface(const guid: tguid; out obj): hresult; stdcall;
-   function _addref: integer; stdcall;
-   function _release: integer; stdcall;
+   function queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function _addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+   function _release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
    procedure testproc;
  end;
 
@@ -32,19 +32,19 @@ type
  
 { ttestclass1 }
 
-function ttestclass1.queryinterface(const guid: tguid; out obj): hresult; stdcall;
+function ttestclass1.queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  result:= integer(e_nointerface);
 end;
 
-function ttestclass1._addref: integer; stdcall;
+function ttestclass1._addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  writeln('addref called');
 // result:= inherited _addref;
  result:= -1;
 end;
 
-function ttestclass1._release: integer; stdcall;
+function ttestclass1._release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
 begin
  writeln('release called');
 // result:= inherited _release;