diff --git a/.gitattributes b/.gitattributes index 30c98c4f7a..7015991dd6 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7904,6 +7904,7 @@ tests/webtbs/tw6735.pp svneol=native#text/plain tests/webtbs/tw6742.pp svneol=native#text/plain tests/webtbs/tw6767.pp svneol=native#text/plain tests/webtbs/tw6865.pp svneol=native#text/plain +tests/webtbs/tw6868.pp svneol=native#text/plain tests/webtbs/tw6960.pp svneol=native#text/plain tests/webtbs/tw6977.pp svneol=native#text/plain tests/webtbs/tw6980.pp svneol=native#text/plain diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index 000fa6dc02..62f2b287c1 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -78,13 +78,25 @@ end; procedure fpc_intf_assign_by_iid(var D: pointer; const S: pointer; const iid: TGUID);[public,alias: 'FPC_INTF_ASSIGN2']; compilerproc; + var + tmp : pointer; begin - if assigned(D) then - IUnknown(D)._Release; if assigned(S) then - IUnknown(S).QueryInterface(iid, D) + begin + if IUnknown(S).QueryInterface(iid,tmp)<>S_OK then + handleerror(219); + if assigned(tmp) then + IUnknown(tmp)._AddRef; + if assigned(D) then + IUnknown(D)._Release; + D:=tmp; + end else - D := nil; + begin + if assigned(D) then + IUnknown(D)._Release; + D:=nil; + end; end; diff --git a/tests/webtbs/tw6868.pp b/tests/webtbs/tw6868.pp new file mode 100644 index 0000000000..8bd4746175 --- /dev/null +++ b/tests/webtbs/tw6868.pp @@ -0,0 +1,29 @@ +program project1; +{$mode objfpc}{$H+} + +uses Classes, SysUtils; + +type IHelpSystem = interface(IInterface) end; + THelpManager = class(TInterfacedObject, IHelpSystem) end; + +var HelpManager : THelpManager = nil; +function GetHelpSystem(out H: IHelpSystem) : Integer; +begin + if HelpManager = nil then HelpManager := THelpManager.Create; // if help manager is not created here, it works + H := HelpManager; // <-- remove this and it works + result := 0; +end; + +procedure FreeHelpSystem; +begin + if HelpManager <> nil then + HelpManager._Release; + HelpManager := nil; +end; + +var h : IHelpSystem; +begin + GetHelpSystem(h); + FreeHelpSystem; +end. +