From b810d8f32b36d88f8f43b66fed90aa0c5f700583 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Sun, 10 Feb 2019 15:43:03 +0000
Subject: [PATCH] * 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 -
---
 .gitattributes                 |  1 +
 rtl/objpas/classes/classes.inc | 18 ++++----
 tests/webtbs/tw35027.pp        | 81 ++++++++++++++++++++++++++++++++++
 3 files changed, 92 insertions(+), 8 deletions(-)
 create mode 100644 tests/webtbs/tw35027.pp

diff --git a/.gitattributes b/.gitattributes
index fbde46ca38..39f2b02696 100644
--- a/.gitattributes
+++ b/.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
diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc
index 7021c27a37..fb06bc2ab1 100644
--- a/rtl/objpas/classes/classes.inc
+++ b/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);
+    try
+      ThreadQueueAppend(syncentry, False);
+    finally
+      syncentry^.Method := Nil;
+      syncentry^.Next := Nil;
 
-    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;
 
diff --git a/tests/webtbs/tw35027.pp b/tests/webtbs/tw35027.pp
new file mode 100644
index 0000000000..9bd949a53a
--- /dev/null
+++ b/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.