1{%skiptarget=$nothread }
2{ Source provided for Free Pascal Bug Report 3695 }
3{ Submitted by "Pedro Lopez-Cabanillas" on  2005-02-25 }
4{ e-mail: plcl@telefonica.net }
5program testsync;
6
7{$ifdef FPC}
8    {$mode delphi}
9{$endif}
10
11uses
12{$ifdef unix}
13cthreads,
14{$endif unix}
15Classes, SysUtils
16;
17
18type
19    Tester = class
20    private
21	counter: Integer;
22    public
23	procedure count;
24	procedure run;
25    end;
26
27    MyThread = class(TThread)
28    private
29      worker: Tester;
30    public
31      constructor Create(w: Tester);
32	    procedure Execute; override;
33    end;
34
35constructor MyThread.Create(w: Tester);
36begin
37  worker:= w;
38  inherited Create(false);
39end;
40
41procedure MyThread.Execute;
42begin
43  WriteLn('Starting MyThread.Execute');
44  repeat
45    // sleep(500);
46    if worker.counter<10 then
47      Synchronize(worker.count);
48  until Terminated;
49  WriteLn('Ending MyThread.Execute');
50end;
51
52procedure Tester.count;
53begin
54  Inc(counter);
55  WriteLn(counter);
56end;
57
58procedure Tester.run;
59var
60  thread: MyThread;
61begin
62  thread := MyThread.Create(Self);
63  While counter<10 do
64  begin
65    CheckSynchronize(1000);
66    //WriteLn('Loop forever inside Tester.run when compiled by FPC 1.9.8');
67  end;
68  thread.Terminate;
69  thread.waitfor;
70end;
71
72var
73  t: Tester;
74begin
75  t:=Tester.Create;
76  t.run;
77  t.free;
78end.
79