2
0
Эх сурвалжийг харах

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 -
svenbarth 10 жил өмнө
parent
commit
b0fa341006

+ 1 - 0
.gitattributes

@@ -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

+ 24 - 0
rtl/objpas/classes/classes.inc

@@ -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 - 0
tests/webtbs/tw28271.pp

@@ -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.
+