* fixed with r1182

git-svn-id: trunk@1190 -
This commit is contained in:
florian 2005-09-25 15:34:58 +00:00
parent 6e2a771c41
commit 291db810bd
2 changed files with 76 additions and 0 deletions

1
.gitattributes vendored
View File

@ -6214,6 +6214,7 @@ tests/webtbs/tw4162.pp svneol=native#text/plain
tests/webtbs/tw4173.pp svneol=native#text/plain
tests/webtbs/tw4188.pp svneol=native#text/plain
tests/webtbs/tw4199.pp svneol=native#text/plain
tests/webtbs/tw4201.pp svneol=native#text/plain
tests/webtbs/tw4202.pp svneol=native#text/plain
tests/webtbs/tw4215.pp svneol=native#text/plain
tests/webtbs/tw4219.pp svneol=native#text/plain

75
tests/webtbs/tw4201.pp Normal file
View File

@ -0,0 +1,75 @@
{ Source provided for Free Pascal Bug Report 4201 }
{ Submitted by "Gergely Nagy" on 2005-07-19 }
{ e-mail: gergely.nagy@softreal.hu }
{ TThread.Synchronize on an abstract virtual method bug demonstration
by Gergely Nagy <gergely.nagy@softreal.hu> }
{$mode delphi}
program fp_thread_bug_test;
uses
{$ifdef unix}
CThreads,
{$endif unix}
Classes;
type
TBuggedBaseThread = class;
TBuggedBaseThread = class (TThread)
protected
procedure Execute; override;
function ExecuteOperation: Boolean; virtual; abstract;
procedure EndOperation; virtual; abstract;
public
constructor Create;
procedure StopThread;
end;
TBuggedThread = class (TBuggedBaseThread)
protected
function ExecuteOperation: Boolean; override;
procedure EndOperation; override;
end;
constructor TBuggedBaseThread.Create;
begin
inherited Create(True);
end;
procedure TBuggedBaseThread.StopThread;
begin
Terminate;
Suspended:= False;
WaitFor;
Free;
end;
procedure TBuggedBaseThread.Execute;
begin
WriteLn ('# Execute...');
ExecuteOperation;
WriteLn ('# ...Going to sync...');
Synchronize(EndOperation);
Terminate;
end;
procedure TBuggedThread.EndOperation;
begin
WriteLn ('# EndOperation');
end;
function TBuggedThread.ExecuteOperation: Boolean;
begin
WriteLn ('# ExecuteOperation');
Result:= True;
end;
var
t: TBuggedThread;
begin
t:= TBuggedThread.Create;
t.Execute;
end.