Forum > FPC development
Compiler Generated Temporary Interface References
Coxy:
I'm having problems with temporary interface references created by the compiler. Here's a simplified example,
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type TMyInterface = interface procedure DoSometing; end; TMyOtherIntf = interface(TMyInterface) end; { TMyClass } TMyClass = class(TInterfacedObject,TMyOtherIntf) public destructor Destroy;override; procedure DoSometing; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private function GetMyInterface:TMyOtherIntf; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);var myIntf : TMyInterface;begin MyIntf:=GetMyInterface; MyIntf:=nil; // Should cause destructor of TMyClass to be called.end; // Place breakpoint here function TForm1.GetMyInterface: TMyOtherIntf;begin result := TMyClass.Create;end; { TMyClass } destructor TMyClass.Destroy;begin inherited Destroy; // Place breakpoint hereend; procedure TMyClass.DoSometing;begin end; end.
If you place breakpoints where indicated and run this example you'll find the "end;" breakpoint is triggered before the one in the destructor. This is probably caused by compiler creating temporary variable to hold "GetMyInterface" interface value "TMyOtherIntf" which is then converted to "TMyInterface", it being tidied up in the routines exit code.
Now I'm implementing non reference counted interfaces with my own "_AddRef", "_Release" and "QueryInterface" routines, and have a "FreeInterface" routine similar to "FreeAndNil" that free the underlying TObject. The tidying up of temporary interface references in routine exit code causes an access violation. Example,
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure ClearArray;var i : integer; intf : TMyInterface;begin for i:=0 to FIntfCount do begin intf:=GetInterface(i); FreeInterface(intf); end;end;
Is there a way to have compiler tidy temporary interfaces references immediately after assignment to "intf" rather than in routine exit code.
I know about using "{$interfaces CORBA}", but I wish to mix both reference counted and non reference counted interfaces in the same unit.
Free Pascal: 3.2.0
OS: Windows 10
marcov:
Easiest is to look at the generated assembly code for the method (compile with -al)
If you handtuned your interface handling in Delphi, beware that doesn't mean it is safe if it "works".
Read this: https://stackoverflow.com/questions/9592654/what-are-the-differences-between-implementation-of-interfaces-in-delphi-and-laza/9623502#9623502
Coxy:
I stepped through assembler code in debugger to identify use of temporary interface variable and clean up in routine exit code.
For me it works in Delphi and fails in FPC.
Coding routines like "FreeAndNil" and "FreeInterface" become problematic because of the compilers creation and use of temporary variables.
One workaround in code is to do the following,
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure ClearArray;var i : integer; intf : TMyInterface; procedure SetIntf; begin intf:=GetInterface(i); end;begin for i:=0 to FIntfCount do begin SetIntf; FreeInterface(intf); end;end;
Here the temporary interface variable is tidied up in the sub method exit code, resolving the problem. But this is a workaround not a fix.
marcov:
--- Quote from: Coxy on January 26, 2021, 02:50:59 pm ---I stepped through assembler code in debugger to identify use of temporary interface variable and clean up in routine exit code.
For me it works in Delphi and fails in FPC.
Coding routines like "FreeAndNil" and "FreeInterface" become problematic because of the compilers creation and use of temporary variables.
--- End quote ---
Then your routines are wrong. If you do it right, then it works with all cases. If you depend on the lifetime of the variable the code is simply wrong, as the URL I gave explains, working in Delphi is not necessarily correct code.
If you still have questions, please create a self contained (preferably console) example of what goes wrong, and we'll look if it is a coding error or a compiler bug (however, that is unlikely)
Coxy:
Here's some example code.
See routine FreeInterface, comment/uncomment highlighted lines to reproduce problem.
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls; type IMyInterface = interface ['{CEC89718-0B2D-4BA5-886F-03FF11955644}'] function GetSelf:TObject; function _ReferenceCounted:boolean; end; { TMyInterfacedObjectNoRefCount } TMyInterfacedObjectNoRefCount = class(TObject, IUnknown, IMyInterface) private protected function _AddRef:longint;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF}; function _Release:longint;{$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF}; function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): {$IFDEF LINUX}Longint;cdecl{$ELSE}HResult;stdcall{$ENDIF}; public function GetSelf:TObject;virtual; function _ReferenceCounted:boolean;virtual; end; TMyInterface = interface procedure DoSometing; end; TMyOtherIntf = interface(TMyInterface) end; { TMyClass } TMyClass = class(TMyInterfacedObjectNoRefCount,TMyOtherIntf) public destructor Destroy;override; procedure DoSometing; end; { TForm1 } TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private function GetMyInterface:TMyOtherIntf; public end; var Form1: TForm1; implementation {$R *.lfm} procedure FreeInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} X);{$IFDEF AUTOREFCOUNT}beginend;{$ELSE}var obj : TObject; p : ^Pointer; a1 : IUnknown; a2 : IMyInterface; procedure GetIMyInterface; begin // The following assignment in FPC causes RecCount to be incremented twice // while DCC only once. This is because FPC increments with the call to // QueryInterface (DCC doesn't). The temp result is released (decremented) // on exit from this nested method. So the net effect is only one increment. // If this assignment were done in the main routine the temp result would be // released in the tidy up for FreeInterface after the object had been freed // causing an AV. // This method works in both FPC and DCC. Except in routine that call // FreeInterface that also have a temporary reference to this interface. a2 := a1 as IMyInterface; end;begin a1 := IUnknown(X); if not assigned(a1) then exit; try// a2 := a1 as IMyInterface; // Uncomment for AV GetIMyInterface; // Uncomment for work except exit; end; if not a2._ReferenceCounted then begin obj := a2.GetSelf; a1 := nil; a2 := nil; obj.Free; p := Pointer(@X); p^ := nil; end else a1 := nil;end; { TMyInterfacedObjectNoRefCount } function TMyInterfacedObjectNoRefCount._AddRef: longint; stdcall;begin result := -1end; function TMyInterfacedObjectNoRefCount._Release: longint; stdcall;begin result := -1end; function TMyInterfacedObjectNoRefCount.QueryInterface(constref IID: TGUID; out Obj): HResult; stdcall;const E_NOINTERFACE = HResult($80004002);begin if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;end; function TMyInterfacedObjectNoRefCount.GetSelf: TObject;begin result := self;end; function TMyInterfacedObjectNoRefCount._ReferenceCounted: boolean;begin result := false;end; {$ENDIF} { TForm1 } procedure TForm1.Button1Click(Sender: TObject);var myIntf : TMyInterface;begin MyIntf:=GetMyInterface; FreeInterface(MyIntf);end; function TForm1.GetMyInterface: TMyOtherIntf;begin result := TMyClass.Create;end; { TMyClass } destructor TMyClass.Destroy;begin inherited Destroy;end; procedure TMyClass.DoSometing;begin end; end.
Navigation
[0] Message Index
[#] Next page