From 100e0a446315185d5988eb124fc73683e4aeeb2d Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Fri, 25 Feb 2005 21:43:06 +0000
Subject: [PATCH] no message

---
 tests/webtbs/tw3695.pp | 73 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 73 insertions(+)
 create mode 100644 tests/webtbs/tw3695.pp

diff --git a/tests/webtbs/tw3695.pp b/tests/webtbs/tw3695.pp
new file mode 100644
index 0000000000..f96bf09af8
--- /dev/null
+++ b/tests/webtbs/tw3695.pp
@@ -0,0 +1,73 @@
+{ Source provided for Free Pascal Bug Report 3695 }
+{ Submitted by "Pedro Lopez-Cabanillas" on  2005-02-25 }
+{ e-mail: plcl@telefonica.net }
+program testsync;
+
+{$ifdef FPC}
+    {$mode delphi}
+{$endif}
+
+uses Classes, SysUtils
+{$ifdef unix}
+,cthreads, Libc
+{$endif unix}
+;
+
+type
+    Tester = class
+    private
+	counter: Integer;
+    public
+	procedure count;
+	procedure run;
+    end;
+
+    MyThread = class(TThread)
+    private
+        worker: Tester;
+    public
+	constructor Create(w: Tester);
+	procedure Execute; override;
+    end;
+
+constructor MyThread.Create(w: Tester);
+begin
+  worker:= w;
+  inherited Create(false);
+end;
+
+procedure MyThread.Execute;
+begin
+  WriteLn('Starting MyThread.Execute');
+  repeat
+    Synchronize(worker.count);
+  until Terminated;
+  WriteLn('Ending MyThread.Execute');
+end;
+
+procedure Tester.count;
+begin
+  Inc(counter);
+  WriteLn(counter);
+end;
+
+procedure Tester.run;
+var
+  thread: MyThread;
+begin
+  thread := MyThread.Create(Self);
+  While counter < 10 do
+  begin
+    Sleep(100);
+    CheckSynchronize;
+    //WriteLn('Loop forever inside Tester.run when compiled by FPC 1.9.8');
+  end;
+  thread.Terminate;
+end;
+
+var
+    t: Tester;
+begin
+    t := Tester.Create;
+    t.run;
+end.