+ test for mantis #15363 fixed in r15066

git-svn-id: trunk@15070 -

.gitattributes

@@ -10291,6 +10291,7 @@ tests/webtbs/tw15296.pp svneol=native#text/plain
 tests/webtbs/tw15304.pp svneol=native#text/plain
 tests/webtbs/tw15308.pp svneol=native#text/plain
 tests/webtbs/tw1532.pp svneol=native#text/plain
+tests/webtbs/tw15363.pp svneol=native#text/plain
 tests/webtbs/tw15364.pp svneol=native#text/plain
 tests/webtbs/tw15370.pp svneol=native#text/plain
 tests/webtbs/tw15377.pp svneol=native#text/pascal

tests/webtbs/tw15363.pp

@@ -0,0 +1,88 @@
+{$mode delphi}
+uses
+  Classes, SysUtils; 
+
+type
+  ITest = interface ['{AAAA09DA-4019-4A5C-A450-3631A73CF288}']
+    function TestIt: integer;
+  end;
+
+  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;
+  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;
+  End;
+
+function TTestBE.TestIt : integer;
+Begin
+  result := 1;
+End;
+
+function TTest._AddRef: Integer;
+begin
+  Result := -1;
+end;
+
+function TTest._Release: Integer;
+begin
+  Result := -1;
+end;
+
+function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
+begin
+  Result := BE.QueryInterface(IID, obj);
+end;
+
+function TTestBE._AddRef: Integer;
+begin
+  Result := -1;
+end;
+
+function TTestBE._Release: Integer;
+begin
+  Result := -1;
+end;
+
+function TTestBE.QueryInterface(const IID: TGUID; out Obj): HResult;
+begin
+  if GetInterface(IID, Obj)
+    then Result := 0
+end;
+
+
+
+
+Var
+  Test : TTest;
+  A    : ITest;
+begin
+  Test    := TTest.Create;
+  Test.BE := TTestBE.Create;
+
+  // Works ok in Lazarus and Delphi
+  Test.BE.GetInterface (ITest, A);
+  // Works ok in Lazarus. Delphi will not compile this line
+  A := Test.BE As ITest;
+
+  // Both Delphi and Lazarus return nil ptr
+  Test.GetInterface(ITest, A);
+
+  // Works in Lazarus
+  Test.QueryInterface (ITest, A);
+
+  // Lazarus throws typecast error.
+  // Works fine in delphi because delphi calls QueryInterface while Lazarus does not
+  A := Test As ITest;
+end.
+