Related
We have run into this multi-threading problem in our backend services:
In a multi-threading Windows service app, with 30+ threads, problem in SysUtils.EventCache arise. The problem is that NewWaitObj function sometimes return NIL instead of Event object. This function is used in TMonitor sync methods Wait. TMonitor.Wait stops working when it get NIL for event object. That affects many VCL and RTL thread sync source code and it cause different side problems in multi-threading apps, for example TThreadedQueue.PopItem doesnt wait for new item to arrive in Queue and returns immediately with timeout result.
Problem occurs in NewWaitObj function:
function NewWaitObj: Pointer;
var
EventItem: PEventItemHolder;
begin
EventItem := Pop(EventCache);
if EventItem <> nil then
begin
Result := EventItem.Event;
EventItem.Event := nil;
Push(EventItemHolders, EventItem);
end else
Result := NewSyncWaitObj;
ResetSyncWaitObj(Result);
end;
Looks like Pop function is not well protected in heavy multi-threaded app and at some number of concurrent threads it starts to return one and the same EventItem instance to two (or more) threads. Then race conditions are happening in NewWaitObj:
One thread takes EventItem.Event and return it as Result and zero it with NIL, the racing parallel thread is getting the same EventItem.Event but it is already cleared by first thread.
That cause one of racing threads to return valid Event handle and the other(s) racing threads return NIL.
TMonitor.Wait function doesnt work, because it get NIL as Event handle.
TThreadedQueue.PopItem doesnt wait, other sync methods also doesnt work correctly.
For some reason thread sync in Pop method doesnt work when app have many concurrent threads:
function Pop(var Stack: PEventItemHolder): PEventItemHolder;
begin
repeat
Result := Stack;
if Result = nil then
Exit;
until AtomicCmpExchange(Pointer(Stack), Result.Next, Result) = Result;
end;
In test app on 60 test threads problem arise in about 10-20 secs, with 30 threads its much harder to happens, usually 5-10 mins are needed. Once problem occurs - it never stop until restart of App. In test app after thread sync get broken - about one of each 5 operations with EventCache return NIL. Looks like something get broken in AtomicCmpExchange, I've checked the generated code - it's just one CMPXCHG instruction and few more to setup registers. I am not quite sure what cause the problem - can one thread get intervention from other thread for example while it setups registers to call CMPXCHG or after the call while it process the results?
Trying to understand what cause the problem, so I can find best workaround. For now I am planning to replace original NewWaitObj with my own, which will just call the original version till it return valid object. This problem occurs constantly in our dev, test and prod environments, for real middle-ware services on production servers it's needed few hours (sometimes couple of days) for problem to arise, after that only restart fix the problem.
Test app can be downloaded from issue in Embarcadero JIRA: https://quality.embarcadero.com/browse/RSP-31154
EDIT: TestApp: https://quality.embarcadero.com/secure/attachment/31605/EventCacheBug.zip
Example Delphi source code:
unit FormMainEventCacheBugU;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.StdCtrls;
const
MaxProducers = 60;
type
TFormEventCacheBug = class(TForm)
BtnMaxProducers: TButton;
BtnRemoveProducer: TButton;
BtnAddProducer: TButton;
procedure BtnMaxProducersClick(Sender: TObject);
procedure BtnRemoveProducerClick(Sender: TObject);
procedure BtnAddProducerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TEventEater = class(TThread)
private
SleepTime: Integer;
SMsg, EMsg, NMsg: PChar;
procedure EatEvent;
protected
procedure Execute; override;
public
constructor Create;
end;
var
FormEventCacheBug: TFormEventCacheBug;
Producers: array[1..MaxProducers] of TThread;
ProdCount: Integer;
implementation
{$R *.dfm}
procedure AddProducer;
begin
if ProdCount < MaxProducers then
begin
Inc(ProdCount);
Producers[ProdCount] := TEventEater.Create;
Producers[ProdCount].FreeOnTerminate := True;
end;
end;
procedure RemoveProducer;
begin
if ProdCount > 0 then
begin
Producers[ProdCount].Terminate;
Dec(ProdCount);
end;
end;
{ TEventEater }
constructor TEventEater.Create;
begin
inherited Create(False);
SleepTime := RandomRange(1, 3);
end;
procedure TEventEater.EatEvent;
var
EventHandle: Pointer;
begin
//OutputDebugString(SMsg);
EventHandle := System.MonitorSupport.NewWaitObject;
try
if EventHandle = nil then
OutputDebugString('NIL');
Sleep(SleepTime);
finally
if EventHandle <> nil then
System.MonitorSupport.FreeWaitObject(EventHandle);
// OutputDebugString(EMsg);
end;
end;
procedure TEventEater.Execute;
begin
SMsg := PChar('S:' + GetCurrentThreadId.ToString);
EMsg := PChar('E:' + GetCurrentThreadId.ToString);
NMsg := PChar('NIL:' + GetCurrentThreadId.ToString);
while not Terminated do
begin
EatEvent;
Sleep(SleepTime);
end;
end;
procedure TFormEventCacheBug.BtnAddProducerClick(Sender: TObject);
begin
AddProducer;
end;
procedure TFormEventCacheBug.BtnRemoveProducerClick(Sender: TObject);
begin
RemoveProducer;
end;
procedure TFormEventCacheBug.BtnMaxProducersClick(Sender: TObject);
var
i: Integer;
begin
for i := ProdCount + 1 to MaxProducers do
AddProducer;
end;
end.
Thanks for any ideas,
#MiroslavPenchev, thank you for the post!
Working in XE2 and had similar issue.
Delphi 10.4.1 got TMonitor ABA problem solved using the linked list head with a counter and 128-bit Compare Exchange.
Unfortunately this is not an easy option for XE2.
Again, thanks to your suggestion to override some of MonitorSupport methods calling original ones.
The following is the solution that I'm using. It is not 100% perfect as involves locking, but for less concurrent environment it at least makes system stable and free from 100% CPU issue.
var
MonitorSupportFix: TMonitorSupport;
OldMonitorSupport: PMonitorSupport;
NewWaitObjCS: TCriticalSection;
function NewWaitObjFix: Pointer;
begin
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Enter;
try
Result := OldMonitorSupport.NewWaitObject;
finally
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Leave;
end;
end;
procedure FreeWaitObjFix(WaitObject: Pointer);
begin
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Enter;
try
OldMonitorSupport.FreeWaitObject(WaitObject);
finally
if Assigned(NewWaitObjCS) then
NewWaitObjCS.Leave;
end;
end;
procedure InitMonitorSupportFix;
begin
OldMonitorSupport := System.MonitorSupport;
MonitorSupportFix := OldMonitorSupport^;
MonitorSupportFix.NewWaitObject := NewWaitObjFix;
MonitorSupportFix.FreeWaitObject := FreeWaitObjFix;
System.MonitorSupport := #MonitorSupportFix;
end;
initialization
NewWaitObjCS := TCriticalSection.Create;
InitMonitorSupportFix;
finalization
FreeAndNil(NewWaitObjCS);
end.
I have a frame, inside it I have a thread, the creation of this front and at runtime, each click that give the button it creates a new frame and may have innumerable within the form. the problem is that ... I create the first, the thread starts normal when I create the second, the first thread to, and the second begins, if I click again, the first and second stand still and the third begins, if I close the third, the second back to work, because this happens?
thank you
constructor TMy_Thread.Create(fraConnect : TfraConnect);
begin
inherited Create(True);
Priority := tpTimeCritical;
FreeOnTerminate := true;
fraConnectT := fraConnect;
end;
procedure TMy_Thread.Execute;
begin
Synchronize(Teste);
end;
procedure TMy_Thread.TEste;
var
iSize : Int64;
iCnt : Integer;
Msg : TMsg ;
begin
inherited;
with fraConnectT do begin
While not Terminated do begin
Log(fraConnectT.Name,'');
Application.ProcessMessages;
end;
end;
end;
////////////////
procedure TfraConnect.Click(Sender: TObject);
var
Sc : TMy_Thread;
begin
Sc := TMy_Thread.Create(Self);
try
iTela := 0;
Sc.Execute;
finally
Sc.Terminate;
end;
end;
You are not using TThread correctly. You are not starting the thread (so it does not free itself when terminated), you are calling Execute() directly, you are Synchronizeing the entire body of Execute(). So Execute() runs in the main thread, calling ProcessMessages() to allow a new button click, which calls Execute() blocking the previous Execute() until the new Execute() exits, and so on. That is why you are experiencing the symptoms you are seeing.
To fix this, you need to do the following:
In the thread constructor, call inherited Create(False) instead. This allows the thread to start running automatically. Otherwise, you have to call the thread's Resume() or Start() method after the constructor exits.
remove Execute() from Click(). Let the running thread call Execute().
remove ProcessMessages() from Teste(). There is never a need to call ProcessMessages() in a thread (unless it is being called inside of Synchronized or Queued code running in the main thread, but even then it should be avoided when possible).
only Synchronize() small code blocks that actually need to run in the main thread - code that does not work in a secondary thread, code that needs to access the UI, code that needs to access a resource shared by multiple threads, etc. The bulk of your thread code should NOT be Synchronized, that defeats the purpose of using a thread in the first place.
Try something more like this:
type
fraConnect = class;
TMy_Thread = class(TThread)
private
fraConnectT : TfraConnect;
procedure DoLog;
protected
procedure Execute; override;
public
constructor Create(fraConnect : TfraConnect);
property Terminated;
end;
...
constructor TMy_Thread.Create(fraConnect : TfraConnect);
begin
inherited Create(True);
Priority := tpTimeCritical;
FreeOnTerminate := true;
fraConnectT := fraConnect;
end;
procedure TMy_Thread.Execute;
begin
with fraConnectT do begin
While not Terminated do begin
// assuming Log() is not thread-safe...
Synchronize(DoLog);
Sleep(100);
end;
end;
end;
procedure TMy_Thread.DoLog;
begin
Log(fraConnectT.Name,'');
end;
type
TMy_Thread = class;
TfraConnect = class(TFrame)
Start: TButton;
Stop: TButton;
StartClick(Sender: TObject);
StopClick(Sender: TObject);
private
Sc: TMy_Thread;
procedure ThreadTerminated(Sender: TObject);
end;
...
procedure TfraConnect.StartClick(Sender: TObject);
begin
if (not Assigned(Sc)) or Sc.Terminated then
begin
Sc := TMy_Thread.Create(Self);
Sc.OnTerminate := ThreadTerminated;
Sc.Resume; // or Sc.Start;
end;
end;
procedure TfraConnect.StopClick(Sender: TObject);
begin
if Assigned(Sc) then
Sc.Terminate;
end;
procedure TfraConnect.ThreadTerminated(Sender: TObject);
begin
if Sc = Sender then
Sc := nil;
end;
My PC is connected to two electronic devices that send data using a TCP connection. I would like to develop a Delphi program able to log all this data. In the following code I create two TCPClients using two threads. I am able to log data from one device using one thread, but when two threads are runnning the application freezes. I don´t have experience programming in Delphi, sorry if there are too many mistakes... I am using Delphi 7. What can I do to avoid freezing the app?
Thanks in advance
//************************************************************************//
type TThreadConn1 = class(TThread)
private
protected
procedure Execute; override;
end;
type TThreadConn2 = class(TThread)
private
protected
procedure Execute; override;
end;
var
Form1: TForm1;
TCP1: TThreadConn1;
TCP2: TThreadConn2;
flag1: bool;
flag2: bool;
implementation
{$R *.dfm}
//******************************Connection 1******************************//
procedure TThreadConn1.Execute; //Connect+loop read buffer+disconnect
begin
Form1.IdTCPClient1.Connect;
While flag1 = false do
Form1.IdTCPClient1.CurrentReadBuffer;
Form1.IdTCPClient1.Disconnect;
end;
procedure TForm1.ButtonConnection1Click(Sender: TObject);
begin
flag1:=false;
TCP1 := TThreadConn1.Create(false); //Launch thread
end;
procedure TForm1.ButtonDisconnection1Click(Sender: TObject);
begin
flag1:=true;
if (TCP1.Terminated = false) then
TCP1.Terminate; //Is it ok to finish this way a thread?
end;
//******************************Connection2******************************//
procedure TThreadConn2.Execute; //Connect+loop read buffer+disconnect
begin
Form1.IdTCPClient2.Connect;
While flag2 = false do
Form1.IdTCPClient1.CurrentReadBuffer;
Form1.IdTCPClient2.Disconnect;
end; { of procedure }
procedure TForm1.ButtonConnection2Click(Sender: TObject);
begin
flag2:=false;
TCP2 := TThreadConn2.Create(false);
end;
procedure TForm1.ButtonDisconnection2Click(Sender: TObject);
begin
flag2:=true;
if (TCP2.Terminated = false) then
TCP2.Terminate;
end;
end.
You don't need to create two separate threads that do the same thing. Create one class and then instantiate multiple copies of it. Try this instead:
type
TThreadConn = class(TThread)
private
FClient: TIdTCPClient;
protected
procedure Execute; override;
public
constructor Create(AClient: TIdTCPClient);
end;
var
TCP1: TThreadConn = nil;
TCP2: TThreadConn = nil;
constructor TThreadConn.Create(AClient: TIdTCPClient);
begin
inherited Create(False);
FClient := AClient;
end;
procedure TThreadConn.Execute;
begin
FClient.Connect;
try
while Terminated = false do
FClient.CurrentReadBuffer;
finally
FClient.Disconnect;
end;
end;
procedure TForm1.ButtonConnection1Click(Sender: TObject);
begin
TCP1 := TThreadConn.Create(TIdTCPClient1);
end;
procedure TForm1.ButtonDisconnection1Click(Sender: TObject);
begin
if (TCP1 <> nil) then
begin
TCP1.Terminate;
TCP1.WaitFor;
FreeAndNil(TCP1);
end;
end;
procedure TForm1.ButtonConnection2Click(Sender: TObject);
begin
TCP2 := TThreadConn.Create(IdTCPClient2);
end;
procedure TForm1.ButtonDisconnection2Click(Sender: TObject);
begin
if (TCP2 <> nil) then
begin
TCP2.Terminate;
TCP2.WaitFor;
FreeAndNil(TCP2);
end;
end;
Apart from the overall design, (which you will probably fix in time, maybe with some more help), in TThreadConn2.Execute, you call Form1.IdTCPClient1.CurrentReadBuffer.
Hints:
If you want to use threads to communicate with several different clients, don't plonk TidTCPClients onto forms. This is inflexible because every time you want to add a new client, you have to plonk another instance onto the form and rebuild. It also makes for a lot of extra work to get your app to shut down cleanly which, I assure you, you will not want.
Dynamically create a TidTCPClient instance in either the TThread descendant ctor or at the top of the 'Execute' method.
Try and declare one class that can be instantiated for each client connection, so you don't have to copy/paste code, edit it and and get it wrong
Oh - for now, don't try and terminate the threads at all. In fact, forever, don't try and terminate the threads at all. In the execute, loop around connect() until successful, then read stuff in a loop, write to log, (in a thread-safe manner). Do that forever. If you wnat to stop the logging, set a 'don't log' boolean so that the thread still runs but simply doesn't bother calling the logger. Again - don't go near trying to terminate the threads.
If I get a chance over the weekend, I'll do a simple example - one form, four TEdits for two pair hostname/port and two TMemos to send data to and display data from the server.
I just realized that my exceptions are not being shown to the user in my threads!
At first I used this in my thread for raising the exception, which does not work:
except on E:Exception do
begin
raise Exception.Create('Error: ' + E.Message);
end;
The IDE shows me the exceptions, but my app does not!
I have looked around for a solution, this is what I found:
Delphi thread exception mechanism
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_22039681.html
And neither of these worked for me.
Here's my Thread unit:
unit uCheckForUpdateThread;
interface
uses
Windows, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, GlobalFuncs, Classes, HtmlExtractor, SysUtils, Forms;
type
TUpdaterThread = class(TThread)
private
FileGrabber : THtmlExtractor;
HTTP : TIdHttp;
AppMajor,
AppMinor,
AppRelease : Integer;
UpdateText : string;
VersionStr : string;
ExceptionText : string;
FException: Exception;
procedure DoHandleException;
procedure SyncUpdateLbl;
procedure SyncFinalize;
public
constructor Create;
protected
procedure HandleException; virtual;
procedure Execute; override;
end;
implementation
uses
uMain;
{ TUpdaterThread }
constructor TUpdaterThread.Create;
begin
inherited Create(False);
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(nil);
try
try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
except on E: Exception do
begin
UpdateText := 'Error while updating xSky!';
ExceptionText := 'Error: Cannot find remote file! Please restart xSky and try again! Also, make sure you are connected to the Internet, and that your Firewall is not blocking xSky!';
HandleException;
end;
end;
try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
except on E:Exception do
begin
HandleException;
end;
end;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then
begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.SyncFinalize;
begin
DoTransition(frmMain.TransSearcher3, frmMain.gbLogin, True, 500);
end;
procedure TUpdaterThread.SyncUpdateLbl;
begin
frmMain.lblCheckingForUpdates.Caption := UpdateText;
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TUpdaterThread.DoHandleException;
begin
Application.ShowException(FException);
end;
end.
If you need more info just let me know.
Again: The IDE catches all the exceptions, but my program does not show them.
EDIT: It was Cosmin's solution that worked in the end - and the reason it didn't at first, was because I didn't add the ErrMsg variable, instead I just placed whatever the variable would contain into the Synchronize, which would NOT work, however I have NO idea why. I realized it when I had no other ideas, and I just messed around with the solutions.
As always, the joke's on me. =P
Something very important you need to understand about multi-theraded development:
Each thread has its own call-stack, almost as if they're separate programs. This includes the main-thread of your program.
Threads can only interact with each other in specific ways:
They can operate on shared data or objects. This can lead to concurrency issues 'race conditions', and therefore you need to be able to help them 'share data nicely'. Which brings us to the next point.
They can "signal each other" using a variety of OS support routines. These include things like:
Mutexes
Critical Sections
Events
And finally you can send messages to other threads. Provided the thread has in some way been written to be a message receiver.
NB: Note that threads cannot strictly speaking call other threads directly. If for example Thread A tried to call Thread B directly, that would be a step on Thread A's call-stack!
This brings us to the topic of the question: "exceptions are not being raised in my threads"
The reason for this is that all an exception does is:
Record the error
And unwind the call-stack. <-- NB: Your TThread instance can't unwind the main thread's call-stack, and cannot arbitrarily interrupt the main threads execution.
So TThread will not automatically report exceptions to your main application.
You have to make the explicit decision as to how you wish to handle errors in threads, and implement accordingly.
Solution
The first step is the same as within a single threaded application. You need to decide what the error means and how the thread should react.
Should the thread continue processing?
Should the thread abort?
Should the error be logged/reported?
Does the error need a user decision? <-- This is by far the most difficult to implement, so we'll skip it for now.
Once this has been decided, implement the appropriate excpetion handler.
TIP: Make sure the exception doesn't escape the thread. The OS won't like you if it does.
If you need the main program (thread) to report the error to the user, you have a few options.
If the thread was written to return a result object, then it's easy: Make a change so that it can return the error in that object if something went wrong.
Send a message to the main thread to report the error. Note, the main thread already implements a message loop, so your application will report the error as soon as it processes that message.
EDIT: Code Sample for indicated requirement.
If all you want to do is notify the user, then Cosmind Prund's answer
should work perfectly for Delphi 2010. Older versions of Delphi need a little more work. The following is conceptually similar to Jeff's own answer, but without the mistakes:
procedure TUpdaterThread.ShowException;
begin
MessageDlg(FExceptionMessage, mtError, [mbOk], 0);
end;
procedure TUpdaterThread.Execute;
begin
try
raise Exception.Create('Test Exception');
//The code for your thread goes here
//
//
except
//Based on your requirement, the except block should be the outer-most block of your code
on E: Exception do
begin
FExceptionMessage := 'Exception: '+E.ClassName+'. '+E.Message;
Synchronize(ShowException);
end;
end;
end;
Some important corrections on Jeff's own answer, including the implementation shown within his question:
The call to Terminate is only relevant if your thread is implemented within a while not Terminated do ... loop. Take a look at what the Terminate method actually does.
The call to Exit is an unnecessary waste, but you probably did this because of your next mistake.
In your question, you're wrapping each step in its own try...except to handle the exception. This is an absolute no-no! By doing this you pretend that even though an exception occurred, everything is ok. Your thread tries the next step, but is actually guaranteed to fail! This is not the way to handle exceptions!
Here's my very, very short "take" on the issue. It only works on Delphi 2010+ (because that version introduced Anonymous methods). Unlike the more sophisticated methods already posted mine only shows the error message, nothing more, nothing less.
procedure TErrThread.Execute;
var ErrMsg: string;
begin
try
raise Exception.Create('Demonstration purposes exception');
except on E:Exception do
begin
ErrMsg := E.ClassName + ' with message ' + E.Message;
// The following could be all written on a single line to be more copy-paste friendly
Synchronize(
procedure
begin
ShowMessage(ErrMsg);
end
);
end;
end;
end;
Threads don't automatically propagate exceptions into other threads. So you must deal with it yourself.
Rafael has outlined one approach, but there are alternatives. The solution Rafael points to deals with the exception synchronously by marshalling it into the main thread.
In one of my own uses of threading, a thread pool, the threads catch and take over the ownership of the exceptions. This allows the controlling thread to handle them as it pleases.
The code looks like this.
procedure TMyThread.Execute;
begin
Try
DoStuff;
Except
on Exception do begin
FExceptAddr := ExceptAddr;
FException := AcquireExceptionObject;
//FBugReport := GetBugReportCallStackEtcFromMadExceptOrSimilar.
end;
End;
end;
If the controlling thread elects to raise the exception it can do so like this:
raise Thread.FException at Thread.FExceptAddr;
Sometimes you may have code that cannot call Synchronize, e.g. some DLLs and this approach is useful.
Note that if you don't raise the exception that was captured, then it needs to be destroyed otherwise you have a memory leak.
Well,
It is gonna be hard without your source code, but i have tested this:
How to handle exceptions in TThread objects
And it works fine. Perhaps you should take a look at it.
EDIT:
You are not following what the links you point out tell us to do. Check my link and you will see how to do that.
EDIT 2:
Try that and tell me if it worked:
TUpdaterThread= class(TThread)
private
FException: Exception;
procedure DoHandleException;
protected
procedure Execute; override;
procedure HandleException; virtual;
end;
procedure TUpdaterThread.Execute;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
FileGrabber := THtmlExtractor.Create;
HTTP := TIdHTTP.Create(Nil);
try
Try
FileGrabber.Grab('http://jeffijoe.com/xSky/Updates/CheckForUpdates.php');
Except
HandleException;
End;
Try
AppMajor := StrToInt(FileGrabber.ExtractValue('AppMajor[', ']'));
AppMinor := StrToInt(FileGrabber.ExtractValue('AppMinor[', ']'));
AppRelease := StrToInt(FileGrabber.ExtractValue('AppRelease[[', ']'));
Except
HandleException;
End;
if (APP_VER_MAJOR < AppMajor) or (APP_VER_MINOR < AppMinor) or (APP_VER_RELEASE < AppRelease) then begin
VersionStr := Format('%d.%d.%d', [AppMajor, AppMinor, AppRelease]);
UpdateText := 'Downloading Version ' + VersionStr;
Synchronize(SyncUpdateLbl);
end;
finally
FileGrabber.Free;
HTTP.Free;
end;
Synchronize(SyncFinalize);
end;
procedure TUpdaterThread.HandleException;
begin
FException := Exception(ExceptObject);
try
Synchronize(DoHandleException);
finally
FException := nil;
end;
end;
procedure TMyThread.DoHandleException;
begin
Application.ShowException(FException);
end;
EDIT 3:
You said you are no able to catch EIdHTTPProtocolException. But it works for me. Try this sample and see it for yourself:
procedure TUpdaterThread.Execute;
begin
Try
raise EIdHTTPProtocolException.Create('test');
Except
HandleException;
End;
end;
I've previously used SendMessge for inter thread communication using the TWMCopyData, so I think the following should work:
Const MyAppThreadError = WM_APP + 1;
constructor TUpdaterThread.Create(ErrorRecieverHandle: THandle);
begin
Inherited Create(False);
FErrorRecieverHandle := Application.Handle;
end;
procedure TUpdaterThread.Execute;
var
cds: TWMCopyData;
begin
try
DoStuff;
except on E:Exception do
begin
cds.dwData := 0;
cds.cbData := Length(E.message) * SizeOf(Char);
cds.lpData := Pointer(#E.message[1]);
SendMessage(FErrorRecieverHandle, MyAppThreadError, LPARAM(#cds), 0);
end;
end;
end;
I've only used it for sending simple data types or strings, but I'm sure it could be adapted send more information through as necessary.
You'll need add Self.Handle to the constructor in form created the thread and Handle the messsage in the form which created it
procedure HandleUpdateError(var Message:TMessage); message MyAppThreadError;
var
StringValue: string;
CopyData : TWMCopyData;
begin
CopyData := TWMCopyData(Msg);
SetLength(StringValue, CopyData.CopyDataStruct.cbData div SizeOf(Char));
Move(CopyData.CopyDataStruct.lpData^, StringValue[1], CopyData.CopyDataStruct.cbData);
Message.Result := 0;
ShowMessage(StringValue);
end;
Strange that everyone answered this question but failed to spot the obvious problem: given that exceptions raised in a background thread are asynchronous, and can occur at any time, this means that showing exceptions from a background thread would pop-up a dialog box at random times to the user, quite possibly showing an exception that has nothing to do with what the user is doing at the moment. I doubt that doing this could possibly enhance the user experience.
We have a pretty mature COM dll, which we test using DUnit. One of our recent tests creates a few threads, and tests the object from those threads. This test works fine when running the test using the gui front-end, but hangs when running as a console application. Here's a quick pseudo view of what we have in the test
SetupTest;
fThreadRefCount := 0; //number of active threads
Thread1 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread1.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount
Thread3 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread2.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount
Thread3 := TMyThread.Create(True);
Inc(fThreadRefCount);
Thread3.OnTerminate := HandleTerminate; //HandleOnTerminate decrements fThreadRefCount
Thread1.Resume;
Thread2.Resume;
Thread3.Resume;
while fThreadRefCount > 0 do
Application.ProcessMessages;
I have tried doing nothing in the OnExecute, so I'm sure it's not the actual code I'm testing. In the console, fThreadRefCount never decrements, while if I run it as a gui app, it's fine!
As far as I can see, the OnTerminate event is just not called.
You need to provide more data.
Note that OnTerminate is called via Synchronize(), which requires a call to CheckSynchronize() at some point somewhere. Application.ProcessMessages() normally does this, but depending on how the VCL has been initialized, it's possible that the Synchronize() mechanism hasn't been fully hooked together in a Console application.
In any case, this program works as expected on my machine:
uses Windows, SysUtils, Classes, Forms;
var
threadCount: Integer;
type
TMyThread = class(TThread)
public
procedure Execute; override;
class procedure Go;
class procedure HandleOnTerminate(Sender: TObject);
end;
procedure TMyThread.Execute;
begin
end;
class procedure TMyThread.Go;
function MakeThread: TThread;
begin
Result := TMyThread.Create(True);
Inc(threadCount);
Result.OnTerminate := HandleOnTerminate;
end;
var
t1, t2, t3: TThread;
begin
t1 := MakeThread;
t2 := MakeThread;
t3 := MakeThread;
t1.Resume;
t2.Resume;
t3.Resume;
while threadCount > 0 do
Application.ProcessMessages;
end;
class procedure TMyThread.HandleOnTerminate(Sender: TObject);
begin
InterlockedDecrement(threadCount);
end;
begin
try
TMyThread.Go;
except
on e: Exception do
Writeln(e.Message);
end;
end.
As Barry rightly pointed out, unless CheckSyncronize() is called, Synchronize() is not processed, and if Synchronize() is not processed, then the OnTerminate event is not fired.
What seems to be happening is that when I run my unit tests as a Console application, there are no messages on the message queue, and thus Application.ProcessMessage(), which is called from Application.ProcessMessages(), never gets to call CheckSynchronize().
I've now solved the problem by changing the loop to this:
While fThreadRefCount > 0 do
begin
Application.ProcessMessages;
CheckSynchronize;
end;
It now works in both Console and GUI modes.
The whole WakeupMainThread hook seems to be setup properly. It's this hook which posts the WM_NULL message that triggers the CheckSynchronize(). It just doesn't get that far in the Console app.
More Investigation
So, Synchronize() does get called. DoTerminate() calls Synchronize(CallOnTerminate) but there's a line in there:
WaitForSingleObject(SyncProcPtr.Signal, Infinite);
which just waits forever.
So, while my fix above works, there's something deeper to this!