mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-06 23:58:35 +02:00
* fix for Mantis #35027: ensure that the synchronize event entry is reset correctly in case of an exception
+ added test git-svn-id: trunk@41281 -
This commit is contained in:
parent
1502a13e7c
commit
b810d8f32b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -16498,6 +16498,7 @@ tests/webtbs/tw3492.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw3494.pp svneol=native#text/plain
|
tests/webtbs/tw3494.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw34971.pp svneol=native#text/plain
|
tests/webtbs/tw34971.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3499.pp svneol=native#text/plain
|
tests/webtbs/tw3499.pp svneol=native#text/plain
|
||||||
|
tests/webtbs/tw35027.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw35028.pp svneol=native#text/pascal
|
tests/webtbs/tw35028.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw3504.pp svneol=native#text/plain
|
tests/webtbs/tw3504.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3506.pp svneol=native#text/plain
|
tests/webtbs/tw3506.pp svneol=native#text/plain
|
||||||
|
@ -418,17 +418,19 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
|
|||||||
|
|
||||||
syncentry^.Exception := Nil;
|
syncentry^.Exception := Nil;
|
||||||
syncentry^.Method := AMethod;
|
syncentry^.Method := AMethod;
|
||||||
ThreadQueueAppend(syncentry, False);
|
try
|
||||||
|
ThreadQueueAppend(syncentry, False);
|
||||||
|
finally
|
||||||
|
syncentry^.Method := Nil;
|
||||||
|
syncentry^.Next := Nil;
|
||||||
|
|
||||||
syncentry^.Method := Nil;
|
if not Assigned(thread) then begin
|
||||||
syncentry^.Next := Nil;
|
{ clean up again }
|
||||||
|
|
||||||
if not Assigned(thread) then begin
|
|
||||||
{ clean up again }
|
|
||||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
RtlEventDestroy(syncentry^.SyncEvent);
|
RtlEventDestroy(syncentry^.SyncEvent);
|
||||||
{$endif}
|
{$endif}
|
||||||
Dispose(syncentry);
|
Dispose(syncentry);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
81
tests/webtbs/tw35027.pp
Normal file
81
tests/webtbs/tw35027.pp
Normal file
@ -0,0 +1,81 @@
|
|||||||
|
program tw35027;
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF}
|
||||||
|
Classes, sysutils, syncobjs;
|
||||||
|
|
||||||
|
type
|
||||||
|
MT1= class(TThread)
|
||||||
|
procedure Execute; override;
|
||||||
|
private
|
||||||
|
procedure MySync;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ MT2 }
|
||||||
|
|
||||||
|
MT2= class(TThread)
|
||||||
|
procedure Execute; override;
|
||||||
|
private
|
||||||
|
procedure MySync2;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
E1, E2, E3: TEventObject;
|
||||||
|
T1: MT1;
|
||||||
|
T2: MT2;
|
||||||
|
MT1Count, MT2Count: Integer;
|
||||||
|
|
||||||
|
{ MT2 }
|
||||||
|
|
||||||
|
procedure MT2.Execute;
|
||||||
|
begin
|
||||||
|
E1.WaitFor(INFINITE);
|
||||||
|
Sleep(100);
|
||||||
|
try
|
||||||
|
Synchronize(@MySync2);
|
||||||
|
except end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MT2.MySync2;
|
||||||
|
begin
|
||||||
|
Inc(MT2Count);
|
||||||
|
writeln('x2 ');
|
||||||
|
raise Exception.Create('Foo'); // prevent event^.Method from being set to nil
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MT1.Execute;
|
||||||
|
begin
|
||||||
|
E1.SetEvent;
|
||||||
|
try
|
||||||
|
Synchronize(@MySync);
|
||||||
|
except end;
|
||||||
|
E3.SetEvent;
|
||||||
|
E2.WaitFor(INFINITE);
|
||||||
|
try
|
||||||
|
Synchronize(@MySync);
|
||||||
|
except end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure MT1.MySync;
|
||||||
|
begin
|
||||||
|
Inc(MT1Count);
|
||||||
|
writeln('x');
|
||||||
|
raise Exception.Create('Foo'); // prevent event^.Next from being set to nil
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
E1 := TEvent.Create(Nil, False, False, '');
|
||||||
|
E2 := TEvent.Create(Nil, False, False, '');
|
||||||
|
E3 := TEvent.Create(Nil, False, False, '');
|
||||||
|
T1 := MT1.Create(False);
|
||||||
|
T2 := MT2.Create(False);
|
||||||
|
Sleep(2000);
|
||||||
|
CheckSynchronize(1000);
|
||||||
|
CheckSynchronize(1000);
|
||||||
|
E3.WaitFor(INFINITE);
|
||||||
|
E2.SetEvent;
|
||||||
|
CheckSynchronize(1000);
|
||||||
|
CheckSynchronize(1000);
|
||||||
|
if (MT1Count <> 2) or (MT2Count <> 1) then
|
||||||
|
Halt(1);
|
||||||
|
Writeln('ok');
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user