mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 06:39:38 +02:00
Fix for Mantis #28271.
rtl/objpas/classes/classes.inc: + new variable ExternalThreadsCleanup to keep track whether ExternalThreads list is currently cleared * TExternalThread.Create: add the thread instance to the external thread list * TExetrnalThread.Destroy: remove the thread instance from the external thread list (if not in system cleanup anyway) * CommonCleanup: set ExternalThreadsCleanup to true so that the threads don't remove themselves from the list anymore + added test git-svn-id: trunk@31028 -
This commit is contained in:
parent
8214e72841
commit
b0fa341006
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -14513,6 +14513,7 @@ tests/webtbs/tw2809.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2812.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2815.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2817.pp svneol=native#text/plain
|
||||
tests/webtbs/tw28271.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw2829.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2830.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2832.pp svneol=native#text/plain
|
||||
|
@ -83,6 +83,9 @@ var
|
||||
{ this list holds all instances of external threads that need to be freed at
|
||||
the end of the program }
|
||||
ExternalThreads: TThreadList;
|
||||
{ this list signals that the ExternalThreads list is cleared and thus the
|
||||
thread instances don't need to remove themselves }
|
||||
ExternalThreadsCleanup: Boolean = False;
|
||||
|
||||
{ this must be a global var, otherwise unwanted optimizations might happen in
|
||||
TThread.SpinWait() }
|
||||
@ -135,6 +138,7 @@ type
|
||||
procedure Execute; override;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
@ -149,6 +153,25 @@ begin
|
||||
FExternalThread := True;
|
||||
{ the parameter is unimportant if FExternalThread is True }
|
||||
inherited Create(False);
|
||||
with ExternalThreads.LockList do
|
||||
try
|
||||
Add(Self);
|
||||
finally
|
||||
ExternalThreads.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
destructor TExternalThread.Destroy;
|
||||
begin
|
||||
inherited;
|
||||
if not ExternalThreadsCleanup then
|
||||
with ExternalThreads.LockList do
|
||||
try
|
||||
Extract(Self);
|
||||
finally
|
||||
ExternalThreads.UnlockList;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -2184,6 +2207,7 @@ begin
|
||||
InitHandlerList:=Nil;
|
||||
FindGlobalComponentList.Free;
|
||||
FindGlobalComponentList:=nil;
|
||||
ExternalThreadsCleanup:=True;
|
||||
with ExternalThreads.LockList do
|
||||
try
|
||||
for i := 0 to Count - 1 do
|
||||
|
65
tests/webtbs/tw28271.pp
Normal file
65
tests/webtbs/tw28271.pp
Normal file
@ -0,0 +1,65 @@
|
||||
{ %OPT=-gh }
|
||||
|
||||
program tw28271;
|
||||
|
||||
{$mode delphi}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
Classes
|
||||
{ you can add units after this };
|
||||
|
||||
type
|
||||
TMyMsgDlg=class
|
||||
private
|
||||
class procedure SyncFree;
|
||||
class procedure SyncCreate;
|
||||
public
|
||||
class procedure StaticCreate;
|
||||
class procedure StaticFree;
|
||||
end;
|
||||
|
||||
var
|
||||
Dlg:TMyMsgDlg;
|
||||
|
||||
class procedure TMyMsgDlg.SyncCreate;
|
||||
begin
|
||||
Dlg:=TMyMsgDlg.Create;
|
||||
end;
|
||||
|
||||
class procedure TmyMsgDlg.SyncFree;
|
||||
begin
|
||||
if Assigned(Dlg) then
|
||||
Dlg.free;
|
||||
Dlg:=nil;
|
||||
end;
|
||||
|
||||
class procedure TMyMsgDlg.StaticCreate;
|
||||
begin
|
||||
if IsLibrary then
|
||||
SyncCreate
|
||||
else
|
||||
TThread.Synchronize(nil,SyncCreate);
|
||||
end;
|
||||
|
||||
class procedure TMyMsgDlg.StaticFree;
|
||||
begin
|
||||
if IsLibrary then
|
||||
SyncFree
|
||||
else
|
||||
begin
|
||||
TThread.Synchronize(nil,SyncFree)
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
HaltOnNotReleased := True;
|
||||
//writeln('Create');
|
||||
TMyMsgDlg.StaticCreate;
|
||||
//writeln('Free');
|
||||
TMyMsgDlg.StaticFree;
|
||||
//writeln('Done');
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user