Recent

Author Topic: ExecuteInThread - Usage guidelines with nested proc  (Read 2485 times)

istoica

  • New Member
  • *
  • Posts: 21
ExecuteInThread - Usage guidelines with nested proc
« on: January 26, 2022, 03:52:08 pm »
I am trying to implement an API client with a simple usage interface where the main GUI thread code is this

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls,
  9.   podman;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     Memo1: TMemo;
  18.     ProgressBar1: TProgressBar;
  19.     Podman: TFPPodmanAPIClient;
  20.     procedure Button1Click(Sender: TObject);
  21.     procedure FormCreate(Sender: TObject);
  22.   private
  23.     procedure OnPodmanSystemInfoResult(res: TFPPodmanAPISystemInfo);
  24.     procedure OnPodmanSystemInfoError(err: string);
  25.  
  26.   public
  27.  
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TForm1 }
  38.  
  39.  
  40. procedure TForm1.OnPodmanSystemInfoResult(res: TFPPodmanAPISystemInfo);
  41. begin
  42. end;
  43.  
  44. procedure TForm1.OnPodmanSystemInfoError(err: string);
  45. begin
  46. end;
  47.  
  48. procedure TForm1.Button1Click(Sender: TObject);
  49. begin
  50.   Podman.GetSystemInfo(@OnPodmanSystemInfoResult, @OnPodmanSystemInfoError);
  51. end;
  52.  
  53. procedure TForm1.FormCreate(Sender: TObject);
  54. begin
  55.   Podman := TFPPodmanAPIClient.Create(nil);
  56. end;
  57.  
  58. end.
  59.  

Following all what I found online so far related to `TThread.ExecuteInThread` - I arrived to an API client that looks like this

Code: Pascal  [Select][+][-]
  1. unit podman;
  2.  
  3. {$mode ObjFPC}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils,
  9.   fphttpclientnext;
  10.  
  11. type
  12.  
  13.   {TFPPodmanAPISystemHostInfo}
  14.   TFPPodmanAPISystemHostInfo = class
  15.     private
  16.       FArch : String;
  17.       FBuildahVersion : String;
  18.     public
  19.       Property Arch : String Read FArch Write FArch;
  20.       Property BuildahVersion : String Read FBuildahVersion Write FBuildahVersion;
  21.   end;
  22.  
  23.   {TFPPodmanAPISystemInfo}
  24.   TFPPodmanAPISystemInfo = class
  25.     private
  26.       FHost: TFPPodmanAPISystemHostInfo;
  27.     public
  28.       Property Host : TFPPodmanAPISystemHostInfo Read FHost Write FHost;
  29.   end;
  30.  
  31.   { TFPPodmanAPIClient }
  32.  
  33.   TFPPodmanAPISystemInfoResultCallback = function (res: TFPPodmanAPISystemInfo): boolean of object;
  34.   TFPPodmanAPIErrorCallback = function (err: string): boolean of object;
  35.  
  36.   TFPPodmanAPIClient = class(TComponent)
  37.   public
  38.     constructor Create(AOwner: TComponent); override;
  39.     destructor Destroy; override;
  40.     procedure GetSystemInfo(const ResultCallback: TFPPodmanAPISystemInfoResultCallback; const ErrorCallback: TFPPodmanAPIErrorCallback);
  41.   end;
  42.  
  43. implementation
  44.  
  45. constructor TFPPodmanAPIClient.Create(AOwner: TComponent);
  46. begin
  47.   inherited Create(AOwner);
  48. end;
  49.  
  50. destructor TFPPodmanAPIClient.Destroy;
  51. begin
  52.   inherited Destroy;
  53. end;
  54.  
  55. procedure  TFPPodmanAPIClient.GetSystemInfo(const ResultCallback: TFPPodmanAPISystemInfoResultCallback; const ErrorCallback: TFPPodmanAPIErrorCallback);
  56. type
  57.   PThreadMethod = ^TThreadMethod;
  58.   TGetSystemInfoIvocation = record
  59.     success: boolean;
  60.     input: string;
  61.     output: string;
  62.   end;
  63.   PGetSystemInfoIvocation = ^TGetSystemInfoIvocation;
  64. var
  65.   ExecuteMethod: TMethod;
  66.   ExecuteProc: TThreadMethod;
  67.   StatusMethod: TMethod;
  68.   StatusProc: TThreadMethod;
  69.   TerminateMethod: TMethod;
  70.   TerminateProc: TThreadMethod;
  71.   pThreadInfo: PGetSystemInfoIvocation;
  72.   procedure OnExecute(AData : Pointer; ReportStatus : TThreadReportStatus);
  73.     var S: string;
  74.         client: TFPHTTPClient;
  75.         pThreadInfo: PGetSystemInfoIvocation;
  76.     begin
  77.       pThreadInfo := PGetSystemInfoIvocation(aData);
  78.       client := TFPHTTPClient.Create(nil);
  79.       client.UnixSocketPath := '/tmp/podman.sock';
  80.       S := client.Get('http://d/v3.0.0/libpod/info');
  81.       client.Free;
  82.     end ;
  83.   procedure OnStatus(Sender : TThread; AData : Pointer; Const status : String);
  84.     var pThreadInfo: PGetSystemInfoIvocation;
  85.     begin
  86.       pThreadInfo := PGetSystemInfoIvocation(aData);
  87.     end ;
  88.   procedure OnTerminate(Sender : TObject; AData : Pointer);
  89.     var pThreadInfo: PGetSystemInfoIvocation;
  90.     begin
  91.       pThreadInfo := PGetSystemInfoIvocation(aData);
  92.     end ;
  93. begin
  94.   ExecuteMethod.Data := @Self;
  95.   ExecuteMethod.Code := @OnExecute;
  96.   ExecuteProc := PThreadMethod(@ExecuteMethod)^;
  97.  
  98.   StatusMethod.Data := @Self;
  99.   StatusMethod.Code := @OnStatus;
  100.   StatusProc := PThreadMethod(@StatusMethod)^;
  101.  
  102.   TerminateMethod.Data := @Self;
  103.   TerminateMethod.Code := @OnTerminate;
  104.   TerminateProc := PThreadMethod(@TerminateMethod)^;
  105.   // Pass data
  106.   new(pThreadInfo);
  107.   pThreadInfo^.input := 'test data';
  108.   // Excute async
  109.   TThread.ExecuteInThread(ExecuteProc, StatusProc, pThreadInfo, TerminateProc);
  110. end;
  111.  
  112. end.
  113.  


I am now stuck wit this error

Code: [Select]
podman.pas(109,78) Error: Incompatible type for arg no. 4: Got "<procedure variable type of procedure of object;Register>", expected "<procedure variable type of procedure(TObject;Pointer);Register>"

Although the prototypes of TThread.ExecuteInThread include

Code: Pascal  [Select][+][-]
  1. Class Function TThread.ExecuteInThread(AMethod : TThreadExecuteStatusHandler; AOnStatus : TThreadStatusNotifyEvent; AOnTerminate : TNotifyEvent = Nil) : TThread;
  2.  

Code: [Select]
classes.inc(937,24) Hint: Found declaration: class ExecuteInThread(TThreadExecuteStatusCallBack;TThreadStatusNotifyCallBack;Pointer=`nil`;TNotifyCallBack=`nil`):TThread; Static;

I don't know if it is the proper way, if there are other ways for me to isolate as much code as possible related to the API, from the UI, what could they be ?

Thaddy

  • Hero Member
  • *****
  • Posts: 11545
Re: ExecuteInThread - Usage guidelines with nested proc
« Reply #1 on: January 26, 2022, 06:02:34 pm »
See examples in the documentation: https://www.freepascal.org/docs-html/rtl/classes/tthread.executeinthread.html

Basically, do not intermix versions that require methods to be declared of object with the normal procedure variants.
It may also bite you if you use it as nested procedures. I would declare them outside.
« Last Edit: January 26, 2022, 06:25:12 pm by Thaddy »
Путин преступник. Россияне дезинформированы.

istoica

  • New Member
  • *
  • Posts: 21
Re: ExecuteInThread - Usage guidelines with nested proc
« Reply #2 on: January 26, 2022, 11:29:38 pm »
Thanks, it is true, AData arguments are available only in non of object procedures.
If I take normal procedures path, then I have to manage allocations / communication with the UI thread.

My last qvasi-working attempt using nested inner procs

Code: Pascal  [Select][+][-]
  1. procedure  TFPPodmanAPIClient.GetSystemInfo(OnResult: TFPPodmanAPIGetSystemInfoEvent; OnError: TFPPodmanAPIErrorHandler);
  2. var thread: TThread;
  3.   responseBody: string;
  4.   procedure InnerOnGetSystemInfoExecute;
  5.   var client: TFPHttpClient;
  6.   begin
  7.     WriteLn('Execution started');
  8.     client := TFPHTTPClient.Create(nil);
  9.     client.UnixSocketPath := '/tmp/podman.sock';
  10.     responseBody := client.Get('http://d/v3.0.0/libpod/info');
  11.     client.Free;
  12.   end;
  13.   procedure InnerOnGetSystemInfoTerminate(Sender: TObject);
  14.   var SystemInfo: TFPPodmanAPISystemInfo;
  15.   begin
  16.     WriteLn('Execution complete', (Sender as TThread).ThreadID, responseBody);
  17.     SystemInfo.Host.Arch := responseBody;
  18.     if Assigned(OnResult) then
  19.     begin
  20.       OnResult(Self, SystemInfo);
  21.     end;
  22.   end;
  23. begin
  24.   thread := TThread.ExecuteInThread(
  25.     MakeProc(Self, @InnerOnGetSystemInfoExecute),
  26.     MakeNotify(Self, @InnerOnGetSystemInfoTerminate)
  27.   );
  28.   WriteLn('Execution launched', thread.ThreadID);
  29. end;
  30.  

Which I invoke like this

Code: Pascal  [Select][+][-]
  1. procedure TForm1.OnPodmanSystemInfoResult(Sender: TObject; res: TFPPodmanAPISystemInfo);
  2. begin
  3.   WriteLn('Got result');
  4.   Memo1.Lines.Add(res.Host.Arch);
  5. end;
  6.  
  7. procedure TForm1.OnPodmanSystemInfoError(Sender: TObject; err: string);
  8. begin
  9.   WriteLn('Got error', err);
  10. end;
  11.  
  12. procedure TForm1.Button1Click(Sender: TObject);
  13. begin
  14.   Podman.GetSystemInfo(@OnPodmanSystemInfoResult, @OnPodmanSystemInfoError);
  15. end;
  16.  

Of course OnResult and OnError are allocated on the main thread and the nested proc InnerOnGetSystemInfoTerminate has lost access to them.

Any tips on not loosing the references to those functions and having them accessible, is it even achievable ?

PascalDragon

  • Hero Member
  • *****
  • Posts: 4029
  • Compiler Developer
Re: ExecuteInThread - Usage guidelines with nested proc
« Reply #3 on: January 27, 2022, 10:05:39 am »
Don't pass nested functions to ordinary function or method variables/parameters. This is only asking for trouble.

Best move both the event handlers and the state to a separate class that you instantiate inside e.g. GetSystemInfo and that is then freed at the end of OnTerminate.

istoica

  • New Member
  • *
  • Posts: 21
Re: ExecuteInThread - Usage guidelines with nested proc
« Reply #4 on: January 27, 2022, 05:05:04 pm »
Thank you @PascalDragon - I moved away from nested.

Here is my initial client, without them - I wanted to hide the json decoding and pass it as a result to the callbacks, but I guess I cannot, so I am exposing deserializers that the users of the class will have to call, they have to

Code: Pascal  [Select][+][-]
  1. var SystemInfo: TFPPodmanAPISystemInfo;
  2. begin
  3.   SystemInfo := TFPPodmanAPIDomain.CoerceSystemInfo(res);
  4. end;
  5.  

instead of

Code: Pascal  [Select][+][-]
  1. procedure TMainForm.OnPodmanSystemInfoResult(Sender: TObject; res: TFPPodmanAPISystemInfo);
  2.  


Client

Code: Pascal  [Select][+][-]
  1. unit podman;
  2.  
  3. {$mode ObjFPC}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, fpjson, jsonparser, fphttpclientnext;
  9.  
  10. type
  11.  
  12.   TResponse = record
  13.     Content: string;
  14.     Code: Integer;
  15.   end;
  16.  
  17.   TRequestOptions = record
  18.     Method: string;
  19.     BaseURL: string;
  20.     Path: string;
  21.     UnixSocketPath: string;
  22.   end;
  23.  
  24.  
  25.   TRequestResultHandler = procedure (Sender: TObject; response: TResponse) of object;
  26.  
  27.   TRequestThread = Class(TObject)
  28.     FResponse: TResponse;
  29.     FOptions: TRequestOptions;
  30.     FOnResult: TRequestResultHandler;
  31.     FOnError : TRequestResultHandler;
  32.     constructor Create(options: TRequestOptions; OnResult: TRequestResultHandler; OnError : TRequestResultHandler);
  33.     Procedure DoneThread(Sender : TObject);
  34.     Procedure DoThread;
  35.     Procedure Run;
  36.   end;
  37.  
  38.   {TFPPodmanAPISystemHostInfo}
  39.   TFPPodmanAPISystemHostInfo = record
  40.     arch : string;
  41.     buildahVersion : string;
  42.     cgroupManager: string;
  43.     cgroupVersion: string;
  44.     cgroupControllers: array of string;
  45.   end;
  46.  
  47.   {TFPPodmanAPISystemInfo}
  48.   TFPPodmanAPISystemInfo = record
  49.     host : TFPPodmanAPISystemHostInfo;
  50.   end;
  51.  
  52.   { TFPPodmanAPIClient }
  53.  
  54.   TFPPodmanAPIClient = class(TComponent)
  55.   public
  56.     const Version: string = '1.0.0';
  57.     constructor Create(AOwner: TComponent); override;
  58.     destructor Destroy; override;
  59.     procedure GetSystemInfo(OnResult: TRequestResultHandler; OnError : TRequestResultHandler; Scope: TObject);
  60.   end;
  61.  
  62.   TFPPodmanAPIDomain = class(TObject)
  63.   public
  64.     class function CoerceSystemInfo(response: TResponse): TFPPodmanAPISystemInfo; static;
  65.   end;
  66.  
  67.  
  68. implementation
  69.  
  70. class Function TFPPodmanAPIDomain.CoerceSystemInfo(response: TResponse): TFPPodmanAPISystemInfo;
  71. var ResponseObject : TJSONObject;
  72.   Coerced: TFPPodmanAPISystemInfo;
  73. begin
  74.   try
  75.     ResponseObject := GetJSON(response.Content) as TJSONObject;
  76.     Coerced.Host.arch := ResponseObject.FindPath('host.arch').AsString;
  77.     Coerced.Host.buildahVersion := ResponseObject.FindPath('host.buildahVersion').AsString;
  78.     Coerced.Host.cgroupManager := ResponseObject.FindPath('host.cgroupManager').AsString;
  79.     Coerced.Host.cgroupVersion := ResponseObject.FindPath('host.cgroupVersion').AsString;
  80.   finally
  81.   end;
  82.   Result := Coerced;
  83. end;
  84.  
  85. constructor TRequestThread.Create(Options: TRequestOptions; OnResult: TRequestResultHandler; OnError : TRequestResultHandler);
  86. begin
  87.   Self.FOptions := Options;
  88.   Self.FOptions.UnixSocketPath := '/tmp/podman.sock';
  89.   Self.FOptions.BaseURL := 'http://d/v3.0.0/libpod';
  90.   Self.FOnResult := OnResult;
  91.   Self.FOnError := OnError;
  92. end;
  93.  
  94. procedure TRequestThread.DoneThread(Sender : TObject);
  95. begin
  96.   Self.FOnResult(Sender, Self.FResponse);
  97. end;
  98.  
  99. procedure TRequestThread.DoThread;
  100. var client : TFPHTTPClient;
  101.   RequestURL: string;
  102. begin
  103.   RequestURL := Self.FOptions.BaseURL + Self.FOptions.Path;
  104.   client := TFPHTTPClient.Create(nil);
  105.   client.UnixSocketPath := Self.FOptions.UnixSocketPath;
  106.   case uppercase(Self.FOptions.Method) of
  107.     'GET': Self.FResponse.Content := client.Get(RequestURL);
  108.   end;
  109.   Self.FResponse.Code := client.ResponseStatusCode;
  110. end;
  111.  
  112. procedure TRequestThread.Run;
  113. begin
  114.   TThread.ExecuteInThread(@DoThread, @DoneThread);
  115. end;
  116.  
  117.  
  118. constructor TFPPodmanAPIClient.Create(AOwner: TComponent);
  119. begin
  120.   inherited Create(AOwner);
  121. end;
  122.  
  123. destructor TFPPodmanAPIClient.Destroy;
  124. begin
  125.   inherited Destroy;
  126. end;
  127.  
  128. procedure  TFPPodmanAPIClient.GetSystemInfo(OnResult: TRequestResultHandler; OnError: TRequestResultHandler; Scope: TObject);
  129. var
  130.   request: TRequestThread;
  131.   options: TRequestOptions;
  132. begin
  133.  
  134.   options.Method := 'GET';
  135.   options.Path := '/info';
  136.   request := TRequestThread.Create(
  137.     options,
  138.     OnResult,
  139.     OnError
  140.   );
  141.   request.Run;
  142. end;
  143.  
  144.  
  145. end.
  146.  
  147.  

with basic usage

Code: Pascal  [Select][+][-]
  1. procedure TMainForm.OnPodmanSystemInfoResult(Sender: TObject; res: TResponse);
  2. var SystemInfo: TFPPodmanAPISystemInfo;
  3. begin
  4.   SystemInfo := TFPPodmanAPIDomain.CoerceSystemInfo(res);
  5.   Memo1.Lines.Add(res.Content);
  6.   Memo1.Lines.Add(SystemInfo.Host.Arch);
  7. end;
  8.  
  9. procedure TMainForm.OnPodmanSystemInfoError(Sender: TObject; err: TResponse);
  10. begin
  11.   Memo1.Lines.Add(err.Content);
  12. end;
  13.  
  14. procedure TMainForm.Button1Click(Sender: TObject);
  15. begin
  16.   Podman.GetSystemInfo(@OnPodmanSystemInfoResult, @OnPodmanSystemInfoError, Sender);
  17. end;
  18.  
  19. procedure TMainForm.FormCreate(Sender: TObject);
  20. begin
  21.   Podman := TFPPodmanAPIClient.Create(nil);
  22. end;
  23.  

 

TinyPortal © 2005-2018