* fix for Mantis #35028: when the mainthread executes a queued ThreadMethod make sure that the queue entry is released even if an exception is raised

+ added test

git-svn-id: trunk@41280 -
This commit is contained in:
svenbarth 2019-02-10 15:42:58 +00:00
parent 6108d38c23
commit 1502a13e7c
3 changed files with 38 additions and 3 deletions

1
.gitattributes vendored
View File

@ -16498,6 +16498,7 @@ tests/webtbs/tw3492.pp svneol=native#text/plain
tests/webtbs/tw3494.pp svneol=native#text/plain
tests/webtbs/tw34971.pp svneol=native#text/plain
tests/webtbs/tw3499.pp svneol=native#text/plain
tests/webtbs/tw35028.pp svneol=native#text/pascal
tests/webtbs/tw3504.pp svneol=native#text/plain
tests/webtbs/tw3506.pp svneol=native#text/plain
tests/webtbs/tw3523.pp svneol=native#text/plain

View File

@ -308,9 +308,12 @@ begin
if (GetCurrentThreadID = MainThreadID) and (not aQueueIfMain or not IsMultiThread) then
{$endif}
begin
ExecuteThreadQueueEntry(aEntry);
if not Assigned(aEntry^.SyncEvent) then
Dispose(aEntry);
try
ExecuteThreadQueueEntry(aEntry);
finally
if not Assigned(aEntry^.SyncEvent) then
Dispose(aEntry);
end;
{$ifdef FPC_HAS_FEATURE_THREADING}
end else begin
{ store thread and whether we're dealing with a synchronized event; the

31
tests/webtbs/tw35028.pp Normal file
View File

@ -0,0 +1,31 @@
{ %OPT=-gh }
program tw35028;
{$mode objfpc}
uses
{$ifdef unix}
cthreads,
{$endif}
Classes;
type
TTest = class
procedure Test;
end;
procedure TTest.Test;
begin
raise TObject.Create;
end;
var
t: TTest;
begin
HaltOnNotReleased := True;
try
TThread.Queue(Nil, @t.Test);
except
end;
end.