Recent

Author Topic: [Solved] SigSeg in TQtWidget.GetWidget: QWidgetH;  (Read 550 times)

cdbc

  • Sr. Member
  • ****
  • Posts: 356
    • http://www.cdbc.dk
[Solved] SigSeg in TQtWidget.GetWidget: QWidgetH;
« on: January 16, 2021, 03:11:19 pm »
Hi
Can someone please explain to me, why i get this error, when i run threadcode in my application???

Code: Pascal  [Select][+][-]
  1. in QtWidgets:
  2.  
  3. function TQtWidget.GetWidget: QWidgetH;
  4. begin
  5.   Result := QWidgetH(TheObject);
  6. end;
  7.  
Thread code
Code: Pascal  [Select][+][-]
  1.  
  2. {------------------------------------------------------------------------------|
  3. | Project name: Debug Server                                                   |
  4. | Unit name   : lfm_main.pas                                                   |
  5. | Copyright   : (c) 2021 cdbc.dk                                               |
  6. | Programmer  : Benny Christensen /bc                                          |
  7. | Created     : 2021.01.13 /bc initial design and coding                       |
  8. | Updated     : 2020.01.13 /bc Setting up environment, structure and vision    |
  9. |                                                                              |
  10. |                                                                              |
  11. |                                                                              |
  12. |                                                                              |
  13. |------------------------------------------------------------------------------|
  14. | Abstract:                                                                    |
  15. |   A debug server to connect to while running a live application.             |
  16. |                                                                              |
  17. |                                                                              |
  18. |                                                                              |
  19. |                                                                              |
  20. -------------------------------------------------------------------------------}
  21.  
  22. unit debug_srv;
  23. {$mode objfpc}{$H+}
  24. {.$define debug}
  25. interface
  26.  
  27. uses
  28.   Classes,
  29.   LMessages,
  30.   LCLIntf,
  31.   sysutils,
  32.   blcksock,
  33.   synsock;
  34.  
  35. const
  36.   { internal messages for use between daemon & app }
  37.   LM_CREATE           = LM_USER+1;
  38.   LM_LISTEN           = LM_USER+3;
  39.   LM_ACCEPT           = LM_USER+5;
  40.   LM_WORKING          = LM_USER+7;
  41.   LM_DONE             = LM_USER+11;
  42.   LM_DESTROY          = LM_USER+13;
  43.  
  44. type
  45.   { TTCPDebugDaemon }
  46.   TTCPDebugDaemon = class(TThread)
  47.   private
  48.     fHandle: THandle;
  49.     fAddress: string;
  50.     fPort: string;
  51.     fSock: TTCPBlockSocket;
  52.   public
  53.     Constructor Create(const aHandle: THandle);
  54.     Destructor Destroy; override;
  55.     procedure Execute; override;
  56.     property Address: string read fAddress write fAddress;
  57.     property Port: string read fPort write fPort;
  58.   end;
  59.  
  60.   { TTCPDebugThrd }
  61.  
  62.   TTCPDebugThrd = class(TThread)
  63.   private
  64.     fHandle: THandle;
  65.     fSock:TTCPBlockSocket;
  66.     CSock: TSocket;
  67.   public
  68.     Constructor Create(hSock: TSocket;aHandle: THandle);
  69.     procedure Execute; override;
  70.   end;
  71.  
  72. implementation
  73.  
  74. { TTCPDebugThrd }
  75.  
  76. constructor TTCPDebugThrd.Create(hSock: TSocket; aHandle: THandle);
  77. begin
  78.   inherited Create(true); // 13.01.2021 / bc:   inherited create(false);
  79.   CSock:= hSock;
  80.   FreeOnTerminate:= true;
  81.   fHandle:= aHandle;
  82.   Start; { safer this way, thread may start running before the properties are set! }
  83. end;
  84.  
  85. procedure TTCPDebugThrd.Execute;
  86. var S: string;
  87. begin
  88.   fSock:= TTCPBlockSocket.create;
  89.   try
  90.     fSock.Socket:= CSock;
  91.     fSock.GetSins;
  92.     with fSock do begin
  93.       repeat
  94.         if Terminated then break;
  95.         S:= RecvPacket(60000);
  96.         if LastError <> 0 then break;
  97.         PostMessage(fHandle,LM_WORKING,length(S),longint(pchar('Worker thread is running...')));
  98.         SendString(S); // here ææ
  99.         S:= 'Sent: '+S;
  100. //        PostMessage(fHandle,LM_WORKING,length(S),longint(pchar(S)));  //AV
  101.         if LastError <> 0 then break;
  102.       until false;
  103.     end;
  104.   finally
  105.     fSock.Free;
  106.   end;
  107.   PostMessage(fHandle,LM_WORKING,0,longint(pchar('Worker thread is Done.')));
  108. end;
  109.  
  110. (*
  111. var
  112.   __Example: TObject;
  113.  
  114. function Example: TObject; { singleton }
  115. begin
  116.   if not assigned(__Example) then __Example:= TObject.Create;
  117.   Result:= __Example;
  118. end; { gets released on progam end }
  119. *)
  120.  
  121. { TTCPDebugDaemon }
  122.  
  123. constructor TTCPDebugDaemon.Create(const aHandle: THandle);
  124. begin
  125.   inherited create(true);
  126.   fSock:=TTCPBlockSocket.create;  { this is the server socket, it only listens }
  127.   FreeOnTerminate:= true;                                 { when done, go away }
  128.   fAddress:= '0.0.0.0';                                        { listen to all }
  129.   fPort:= '8723';                                                { port ~ 8723 }
  130.   fHandle:= aHandle;                     { used for inter-thread communication }
  131.   Start;                                              { RUN Forrest run!!! :-) }
  132.   PostMessage(fHandle,
  133.               LM_CREATE,
  134.               strtoint(fPort),
  135.               longint(pchar('Debug daemon created...')));
  136. end;
  137.  
  138. destructor TTCPDebugDaemon.Destroy;
  139. begin
  140.   fSock.free;
  141.   PostMessage(fHandle,LM_DESTROY,strtoint(fPort),longint(pchar('Debug daemon destroyed...')));
  142.   inherited Destroy;
  143. end;
  144.  
  145. procedure TTCPDebugDaemon.Execute;
  146. var
  147.   ClientSock:TSocket;
  148. begin
  149.   with fSock do begin
  150.     CreateSocket;
  151.     SetLinger(true,10000);
  152.     Bind(fAddress,fPort); //ææ
  153.     Listen;
  154.     PostMessage(fHandle,LM_LISTEN,strtoint(fPort),longint(pchar('Debug daemon is listening...')));
  155.     repeat
  156.       if Terminated then break;
  157.       if CanRead(1000) then begin
  158.         ClientSock:= Accept;
  159.         if LastError = 0 then begin
  160.           TTCPDebugThrd.Create(ClientSock,fHandle);
  161.           PostMessage(fHandle,LM_ACCEPT,strtoint(fPort),longint(pchar('Worker thread created...')));
  162.         end;
  163.       end;
  164.     until false;
  165.   end;
  166.   PostMessage(fHandle,LM_DONE,strtoint(fPort),longint(pchar('Debug daemon done.')));
  167. end;
  168.  
  169. initialization
  170. //  __Example:= nil;
  171.  
  172. finalization
  173. //  FreeAndNil(__Example);
  174.  
  175. end.
  176.  
lfm_main.pas code:

Code: Pascal  [Select][+][-]
  1. unit lfm_main;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
  9.   ExtCtrls,
  10.   LMessages,
  11.   debug_srv;
  12.  
  13. type
  14.  
  15.   { TfrmMain }
  16.  
  17.   TfrmMain = class(TForm)
  18.     btnConnect: TButton;
  19.     gbxControls: TGroupBox;
  20.     gbxData: TGroupBox;
  21.     edtLocalAddress: TLabeledEdit;
  22.     edtRemoteAddress: TLabeledEdit;
  23.     edtPort: TLabeledEdit;
  24.     lblStatus: TLabel;
  25.     Memo1: TMemo;
  26.     stbNotifications: TStatusBar;
  27.     procedure btnConnectClick(Sender: TObject);
  28.   private
  29.     fDebugDaemon: TTCPDebugDaemon;
  30.     procedure LMCreate(var Message: TLMessage); message LM_CREATE;
  31.     procedure LMListen(var Message: TLMessage); message LM_LISTEN;
  32.     procedure LMAccept(var Message: TLMessage); message LM_ACCEPT;
  33.     procedure LMWorking(var Message: TLMessage); message LM_WORKING;
  34.     procedure LMDone(var Message: TLMessage); message LM_DONE;
  35.     procedure LMDestroy(var Message: TLMessage); message LM_DESTROY;
  36.   public
  37.     procedure StartServer;
  38.     procedure StopServer;
  39.   end;
  40.  
  41. var
  42.   frmMain: TfrmMain;
  43.  
  44. implementation
  45.  
  46. {$R *.lfm}
  47.  
  48. { TfrmMain }
  49.  
  50. procedure TfrmMain.btnConnectClick(Sender: TObject);
  51. begin
  52.   case btnConnect.Tag of
  53.     0: begin
  54.          btnConnect.Caption:= 'Stop';
  55.          lblStatus.Font.Color:= clLime;
  56.          lblStatus.Caption:= 'Running';
  57.          btnConnect.Tag:= 1;
  58.          stbNotifications.SimpleText:= 'Serving...';
  59.          Application.ProcessMessages;
  60.          StartServer;
  61.        end;
  62.     1: begin
  63.          btnConnect.Caption:= 'Start';
  64.          lblStatus.Font.Color:= clRed;
  65.          lblStatus.Caption:= 'Stopped';
  66.          btnConnect.Tag:= 0;
  67.          stbNotifications.SimpleText:= 'Waiting...';
  68.          Application.ProcessMessages;
  69.          StopServer;
  70.        end;
  71.   end;
  72. end;
  73.  
  74. procedure TfrmMain.LMCreate(var Message: TLMessage);
  75. begin
  76.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  77. end;
  78.  
  79. procedure TfrmMain.LMListen(var Message: TLMessage);
  80. begin
  81.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  82. end;
  83.  
  84. procedure TfrmMain.LMAccept(var Message: TLMessage);
  85. begin
  86.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  87. end;
  88.  
  89. procedure TfrmMain.LMWorking(var Message: TLMessage);
  90. begin
  91.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  92. end;
  93.  
  94. procedure TfrmMain.LMDone(var Message: TLMessage);
  95. begin
  96.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  97. end;
  98.  
  99. procedure TfrmMain.LMDestroy(var Message: TLMessage);
  100. begin
  101.   Memo1.Lines.Add(inttostr(Message.WParam)+': '+string(pchar(Message.LParam)));
  102. end;
  103.  
  104. procedure TfrmMain.StartServer;
  105. begin
  106.   fDebugDaemon:= TTCPDebugDaemon.Create(Handle);
  107. end;
  108.  
  109. procedure TfrmMain.StopServer;
  110. begin
  111.   fDebugDaemon.Terminate;
  112.   fDebugDaemon.WaitFor;
  113.   FreeAndNil(fDebugDaemon);
  114. end;
  115.  
  116. end.
  117.  
And yes i have enabled cthreads in lpr file.
Regards Benny
« Last Edit: January 20, 2021, 01:50:38 pm by cdbc »
If it ain't broke, don't fix it ;)

zeljko

  • Hero Member
  • *****
  • Posts: 1169
    • http://wiki.lazarus.freepascal.org/User:Zeljan
Re: SigSeg in TQtWidget.GetWidget: QWidgetH;
« Reply #1 on: January 17, 2021, 12:02:46 pm »
Probably because TheObject is dangling pointer ? What kind of widget it is ? Form ?

cdbc

  • Sr. Member
  • ****
  • Posts: 356
    • http://www.cdbc.dk
Re: SigSeg in TQtWidget.GetWidget: QWidgetH;
« Reply #2 on: January 20, 2021, 01:49:49 pm »
Hi
No, not a dangling pointer...
Tried to free the thread twice:
Code: Pascal  [Select][+][-]
  1. OnTerminate:= true; // <---- stupid me :-)
  2.  
  3. procedure StopServer;
  4. begin
  5.   Terminate;
  6.   Waitfor;
  7.   FreeAndNil; // <---- stupid me :-)
  8. end;
  9.  
Now it all works as expected, thank you for your suggestion  ;)
Regards Benny
If it ain't broke, don't fix it ;)

 

TinyPortal © 2005-2018