fpc/tests/webtbs/tw28271.pp
svenbarth b0fa341006 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 -
2015-06-12 13:39:31 +00:00

66 lines
1002 B
ObjectPascal

{ %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.