mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-11 01:38:07 +02:00
* fixed with r1182
git-svn-id: trunk@1190 -
This commit is contained in:
parent
6e2a771c41
commit
291db810bd
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
75
tests/webtbs/tw4201.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user