no message

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: [email protected] }
+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.