Преглед изворни кода

* fix for Mantis #35027: ensure that the synchronize event entry is reset correctly in case of an exception
+ added test

git-svn-id: trunk@41281 -

svenbarth пре 6 година
родитељ
комит
b810d8f32b
3 измењених фајлова са 92 додато и 8 уклоњено
  1. 1 0
      .gitattributes
  2. 10 8
      rtl/objpas/classes/classes.inc
  3. 81 0
      tests/webtbs/tw35027.pp

+ 1 - 0
.gitattributes

@@ -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/tw35027.pp svneol=native#text/pascal
 tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain

+ 10 - 8
rtl/objpas/classes/classes.inc

@@ -418,17 +418,19 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
 
     syncentry^.Exception := Nil;
     syncentry^.Method := AMethod;
-    ThreadQueueAppend(syncentry, False);
-
-    syncentry^.Method := Nil;
-    syncentry^.Next := Nil;
+    try
+      ThreadQueueAppend(syncentry, False);
+    finally
+      syncentry^.Method := Nil;
+      syncentry^.Next := Nil;
 
-    if not Assigned(thread) then begin
-      { clean up again }
+      if not Assigned(thread) then begin
+        { clean up again }
 {$ifdef FPC_HAS_FEATURE_THREADING}
-      RtlEventDestroy(syncentry^.SyncEvent);
+        RtlEventDestroy(syncentry^.SyncEvent);
 {$endif}
-      Dispose(syncentry);
+        Dispose(syncentry);
+      end;
     end;
   end;
 

+ 81 - 0
tests/webtbs/tw35027.pp

@@ -0,0 +1,81 @@
+program tw35027;
+{$mode objfpc}{$H+}
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF}
+  Classes, sysutils, syncobjs;
+
+type
+  MT1= class(TThread)
+    procedure Execute; override;
+  private
+    procedure MySync;
+  end;
+
+  { MT2 }
+
+  MT2= class(TThread)
+    procedure Execute; override;
+  private
+    procedure MySync2;
+  end;
+var
+  E1, E2, E3: TEventObject;
+  T1: MT1;
+  T2: MT2;
+  MT1Count, MT2Count: Integer;
+
+{ MT2 }
+
+procedure MT2.Execute;
+begin
+  E1.WaitFor(INFINITE);
+  Sleep(100);
+  try
+    Synchronize(@MySync2);
+  except end;
+end;
+
+procedure MT2.MySync2;
+begin
+  Inc(MT2Count);
+  writeln('x2 ');
+  raise Exception.Create('Foo'); // prevent event^.Method from being set to nil
+end;
+
+procedure MT1.Execute;
+begin
+  E1.SetEvent;
+  try
+    Synchronize(@MySync);
+  except end;
+  E3.SetEvent;
+  E2.WaitFor(INFINITE);
+  try
+    Synchronize(@MySync);
+  except end;
+end;
+
+procedure MT1.MySync;
+begin
+  Inc(MT1Count);
+  writeln('x');
+  raise Exception.Create('Foo'); // prevent event^.Next from being set to nil
+end;
+
+begin
+  E1 := TEvent.Create(Nil, False, False, '');
+  E2 := TEvent.Create(Nil, False, False, '');
+  E3 := TEvent.Create(Nil, False, False, '');
+  T1 := MT1.Create(False);
+  T2 := MT2.Create(False);
+  Sleep(2000);
+  CheckSynchronize(1000);
+  CheckSynchronize(1000);
+  E3.WaitFor(INFINITE);
+  E2.SetEvent;
+  CheckSynchronize(1000);
+  CheckSynchronize(1000);
+  if (MT1Count <> 2) or (MT2Count <> 1) then
+    Halt(1);
+  Writeln('ok');
+end.