Forum > Operating Systems
Main thread is being blocked by another thread and WaitForSingleObject
stoffman:
Hey,
I've created a thread which creates a process and waits for this process to end. I expected that it will not block the main thread and the UI will remain responsive. But that is not the case...
Any ideas ?
--- 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";}};} ---TExternalProcess = class(TThread) ...procedure TExternalProcess.Execute;begin if CreateProcess(nil, PChar(fExe), @Security, @Security, true, NORMAL_PRIORITY_CLASS or $08000000, nil, nil, start2, ProcessInfo) then begin WaitForSingleObject (ProcessInfo.hProcess,Infinite); .... .... end;end; procedure TForm1.Button1Click(Sender: TObject);var APRocess : TExternalProcess;begin AProcess := TExternalProcess.Create(true); AProcess.Execute;end;
Thanks,
Yoni
HeavyUser:
--- Quote from: stoffman on June 25, 2017, 04:15:38 pm ---
--- 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 TForm1.Button1Click(Sender: TObject);var APRocess : TExternalProcess;begin AProcess := TExternalProcess.Create(true); AProcess.Execute;end;
--- End quote ---
Yeah you do not call the execute method directly you simply resume the thread eg
--- 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 TForm1.Button1Click(Sender: TObject);var APRocess : TExternalProcess;begin AProcess := TExternalProcess.Create(true); AProcess.Resume;end; That should solve the problem of pausing the main thread.
Thaddy:
Indeed. AProcess.Execute;? That is supposed to work only IN the thread. You called the execute method of the thread in the context of the main process.
Just set CreateSuspended to false instead of true in the constructor, or use in place of Execute, Resume (Note that is actually deprecated)
Thaddy:
As a sidenote, I found a brilliant example that demonstrates why you should not use suspend resume.
It is from Barry Kelly (formerly Delphi's senior compiler engineer), I adapted it and made it cross-platform.
The problem is universal, not Delphi related, not platform related, not CPU related and simply a design flaw.
Run the program under Windows or Linux (I checked on arm-linux too...) It will (fail, but not crash) end up with deadlocks....
Just give it 30 secs or so to "recover" from the deadlocks.
Maybe I should add it to the wiki?
--- 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";}};} ---Program BadNews; //This program is adapted from Barry Kelly's example//from http://codeverge.com/embarcadero.delphi.win32/threads/1039644// I made it cross platform// It is a demonstration of why you should not use // TThread.Suspend/TThread.Resume, unless you are writing a debugger.//// Op.Cit Barry Kelly:// --- Folks, just don't use TThread.Suspend. If you still think you need it, // you had better be implementing a debugger, GC, // or something equivalently low-level. // -- Barry//// Note the problem is universal and not limited to Delphi, as you will // find out when you compile and run the program a few times ;)// Thaddy{$mode delphi}{$ifdef mswindows}{$APPTYPE CONSOLE}{$endif} Uses {$ifdef unix}cthreads,{$else} {$ifdef msWindows} windows, {$endif}{$endif} SysUtils, Classes, SyncObjs; Type TMyThread = Class(TThread) Private FCritSec: TCriticalSection; FList: TList; Protected Procedure Execute; override; Public constructor Create; destructor Destroy; override; Procedure DoWork(Var x: Integer);End; Var IOCritSec: TCriticalSection; // Thread-safe console output Procedure TWrite(Const s: String);Begin IOCritSec.Acquire; Try Writeln(Output, s); Flush(Output); Finally IOCritSec.Release;End;End; { TMyThread }constructor TMyThread.Create;Begin inherited Create(False); FCritSec := TCriticalSection.Create; FList := TList.Create;End;destructor TMyThread.Destroy;Begin FCritSec.Free; FList.Free; inherited;End; Procedure TMyThread.DoWork(Var x: Integer);Begin FCritSec.Acquire; Try FList.Insert(0, @x) Finally FCritSec.Release;End;If Suspended Then Resume;End; Procedure TMyThread.Execute; Var work: PInteger;Begin While Not Terminated Do Begin TWrite('W'); // heartbeat indicating OK FCritSec.Acquire; Try If FList.Count > 0 Then Begin work := FList.Last; FList.Delete(FList.Count - 1); End Else work := Nil; Finally FCritSec.Release; End; If work = Nil Then Begin TWrite('-sleep-'); Suspend; End Else Begin Inc(work^); End;End;End; Procedure Produce; Var worker: TMyThread;Procedure SpinUntil(Var ref: Integer; val: Integer); Var maxSpin: Integer;Begin maxSpin := High(Integer); While ref <> val Do Begin Dec(maxSpin); If maxSpin = 0 Then Begin If worker.Suspended Then Begin TWrite('Oh dear: we deadlocked.'); TWrite(IntToStr(worker.FList.Count) + ' missed work items.'); Halt; End Else TWrite('Unexpected spin loop failure'); Exit; End; End;End; Var a, b, c: Integer;Begin worker := TMyThread.Create; Try While True Do Begin a := 10; b := 20; c := 30; worker.DoWork(a); worker.DoWork(b); worker.DoWork(c); SpinUntil(c, 31); SpinUntil(a, 11); SpinUntil(b, 21); TWrite('P'); // heartbeat indicating OK End; Finally worker.Free;End;End; Begin IOCritSec := TCriticalSection.Create; Try Try Produce; Except on E: Exception Do Writeln(E.Classname, ': ', E.Message);End;Finally IOCritSec.Free;End;End.
stoffman:
Oh my! I didn't notice the execute...
Thank you all for the help!
@Thaddy Resume is deprecated for that reason. Start is the new Resume :-)
Navigation
[0] Message Index
[#] Next page