mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 09:06:02 +02:00
* adjust TThread.Synchronize so that it also works correctly if the passed in thread instance is not the instance of the current thread
+ added test git-svn-id: trunk@38124 -
This commit is contained in:
parent
899707979a
commit
640480272f
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -11486,6 +11486,7 @@ tests/tbs/tb0632.pp svneol=native#text/pascal
|
|||||||
tests/tbs/tb0633.pp svneol=native#text/pascal
|
tests/tbs/tb0633.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0634.pp svneol=native#text/pascal
|
tests/tbs/tb0634.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb0635.pp svneol=native#text/pascal
|
tests/tbs/tb0635.pp svneol=native#text/pascal
|
||||||
|
tests/tbs/tb0636.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb205.pp svneol=native#text/plain
|
tests/tbs/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/tb610.pp svneol=native#text/pascal
|
tests/tbs/tb610.pp svneol=native#text/pascal
|
||||||
tests/tbs/tb613.pp svneol=native#text/plain
|
tests/tbs/tb613.pp svneol=native#text/plain
|
||||||
|
@ -362,8 +362,18 @@ procedure TThread.DoneSynchronizeEvent;
|
|||||||
class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
|
class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
|
||||||
var
|
var
|
||||||
syncentry: PThreadQueueEntry;
|
syncentry: PThreadQueueEntry;
|
||||||
|
thread: TThread;
|
||||||
begin
|
begin
|
||||||
if not Assigned(AThread) then begin
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
|
if Assigned(AThread) and (AThread.ThreadID = GetCurrentThreadID) then
|
||||||
|
{$else}
|
||||||
|
if Assigned(AThread) then
|
||||||
|
{$endif}
|
||||||
|
thread := AThread
|
||||||
|
else if Assigned(CurrentThreadVar) then
|
||||||
|
thread := CurrentThreadVar
|
||||||
|
else begin
|
||||||
|
thread := Nil;
|
||||||
{ use a local synchronize event }
|
{ use a local synchronize event }
|
||||||
New(syncentry);
|
New(syncentry);
|
||||||
FillChar(syncentry^, SizeOf(TThreadQueueEntry), 0);
|
FillChar(syncentry^, SizeOf(TThreadQueueEntry), 0);
|
||||||
@ -374,11 +384,13 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
|
|||||||
syncentry^.ThreadID := 0{GetCurrentThreadID};
|
syncentry^.ThreadID := 0{GetCurrentThreadID};
|
||||||
syncentry^.SyncEvent := nil{RtlEventCreate};
|
syncentry^.SyncEvent := nil{RtlEventCreate};
|
||||||
{$endif}
|
{$endif}
|
||||||
end else begin
|
end;
|
||||||
{ the Synchronize event is instantiated on demand }
|
|
||||||
AThread.InitSynchronizeEvent;
|
|
||||||
|
|
||||||
syncentry := AThread.FSynchronizeEntry;
|
if Assigned(thread) then begin
|
||||||
|
{ the Synchronize event is instantiated on demand }
|
||||||
|
thread.InitSynchronizeEvent;
|
||||||
|
|
||||||
|
syncentry := thread.FSynchronizeEntry;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
syncentry^.Exception := Nil;
|
syncentry^.Exception := Nil;
|
||||||
@ -388,7 +400,7 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
|
|||||||
syncentry^.Method := Nil;
|
syncentry^.Method := Nil;
|
||||||
syncentry^.Next := Nil;
|
syncentry^.Next := Nil;
|
||||||
|
|
||||||
if not Assigned(AThread) then begin
|
if not Assigned(thread) then begin
|
||||||
{ clean up again }
|
{ clean up again }
|
||||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
RtlEventDestroy(syncentry^.SyncEvent);
|
RtlEventDestroy(syncentry^.SyncEvent);
|
||||||
|
129
tests/tbs/tb0636.pp
Normal file
129
tests/tbs/tb0636.pp
Normal file
@ -0,0 +1,129 @@
|
|||||||
|
program tb0636;
|
||||||
|
|
||||||
|
{$mode objfpc}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$ifdef unix}
|
||||||
|
cthreads,
|
||||||
|
{$endif}
|
||||||
|
Classes, syncobjs;
|
||||||
|
|
||||||
|
type
|
||||||
|
TTestThread1 = class(TThread)
|
||||||
|
private
|
||||||
|
fOnNotify: TNotifyEvent;
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
public
|
||||||
|
property OnNotify: TNotifyEvent read fOnNotify write fOnNotify;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TTestThread2 = class(TThread)
|
||||||
|
private
|
||||||
|
procedure DoSync;
|
||||||
|
procedure DoSync2;
|
||||||
|
private
|
||||||
|
procedure HandleNotify(aSender: TObject);
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
ev1, ev2: TEvent;
|
||||||
|
sync1, sync2: LongInt;
|
||||||
|
|
||||||
|
{ TTestThread2 }
|
||||||
|
|
||||||
|
procedure TTestThread2.DoSync;
|
||||||
|
begin
|
||||||
|
Inc(sync1);
|
||||||
|
Writeln('main in t2: DoSync');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestThread2.DoSync2;
|
||||||
|
begin
|
||||||
|
Inc(sync2);
|
||||||
|
Writeln('main in t2: DoSync2');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestThread2.HandleNotify(aSender: TObject);
|
||||||
|
begin
|
||||||
|
Writeln('t1 in t2: Signalling ev1');
|
||||||
|
ev1.SetEvent;
|
||||||
|
Writeln('t1 in t2: Synchronizing DoSync');
|
||||||
|
Synchronize(@DoSync);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestThread2.Execute;
|
||||||
|
begin
|
||||||
|
Writeln('t2: Waiting for ev1');
|
||||||
|
ev1.WaitFor(INFINITE);
|
||||||
|
Sleep(100);
|
||||||
|
Writeln('t2: Signalling ev2');
|
||||||
|
ev2.SetEvent;
|
||||||
|
Writeln('t2: Synchronizing DoSync2');
|
||||||
|
Synchronize(@DoSync2);
|
||||||
|
Writeln('t2: Waiting for ev1');
|
||||||
|
ev1.WaitFor(INFINITE);
|
||||||
|
Writeln('t2: Done');
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TTestThread1 }
|
||||||
|
|
||||||
|
procedure TTestThread1.Execute;
|
||||||
|
begin
|
||||||
|
Writeln('t1: Calling fOnNotify');
|
||||||
|
fOnNotify(Self);
|
||||||
|
Writeln('t1: Done');
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
t1: TTestThread1;
|
||||||
|
t2: TTestThread2;
|
||||||
|
begin
|
||||||
|
sync1 := 0;
|
||||||
|
sync2 := 0;
|
||||||
|
|
||||||
|
ev1 := Nil;
|
||||||
|
ev2 := Nil;
|
||||||
|
t1 := Nil;
|
||||||
|
t2 := Nil;
|
||||||
|
|
||||||
|
try
|
||||||
|
ev1 := TEvent.Create(Nil, False, False, '');
|
||||||
|
ev2 := TEvent.Create(Nil, False, False, '');
|
||||||
|
t1 := TTestThread1.Create(True);
|
||||||
|
t2 := TTestThread2.Create(True);
|
||||||
|
|
||||||
|
Writeln('main: Starting t2');
|
||||||
|
t2.Start;
|
||||||
|
|
||||||
|
t1.OnNotify := @t2.HandleNotify;
|
||||||
|
Writeln('main: Starting t1');
|
||||||
|
t1.Start;
|
||||||
|
|
||||||
|
Writeln('main: Waiting for ev2');
|
||||||
|
ev2.WaitFor(INFINITE);
|
||||||
|
|
||||||
|
Writeln('main: Calling CheckSynchronize');
|
||||||
|
CheckSynchronize();
|
||||||
|
|
||||||
|
Writeln('main: Signalling ev1');
|
||||||
|
ev1.SetEvent;
|
||||||
|
|
||||||
|
Writeln('main: Waiting for threads');
|
||||||
|
t1.WaitFor;
|
||||||
|
t2.WaitFor;
|
||||||
|
|
||||||
|
Writeln('main: Cleaning up');
|
||||||
|
finally
|
||||||
|
t1.Free;
|
||||||
|
t2.Free;
|
||||||
|
ev1.Free;
|
||||||
|
ev2.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (sync1 <> 1) or (sync2 <> 1) then
|
||||||
|
Halt(1);
|
||||||
|
Writeln('main: ok');
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user