paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 01:48:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for Mantis #35027: ensure that the synchronize event entry is reset correctly in case of an exception

Browse Source 
+ added test

git-svn-id: trunk@41281 -
This commit is contained in:
svenbarth 2019-02-10 15:43:03 +00:00
parent 1502a13e7c
commit b810d8f32b
3 changed files with 92 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -16498,6 +16498,7 @@ tests/webtbs/tw3492.pp svneol=native#text/plain
tests/webtbs/tw3494.pp svneol=native#text/plain
tests/webtbs/tw34971.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/tw3504.pp svneol=native#text/plain
tests/webtbs/tw3506.pp svneol=native#text/plain

18
rtl/objpas/classes/classes.inc
View File

@ -418,17 +418,19 @@ class procedure TThread.Synchronize(AThread: TThread; AMethod: TThreadMethod);
syncentry^.Exception := Nil;
syncentry^.Method := AMethod;
ThreadQueueAppend(syncentry, False);
try
ThreadQueueAppend(syncentry, False);
finally
syncentry^.Method := Nil;
syncentry^.Next := Nil;
syncentry^.Method := Nil;
syncentry^.Next := Nil;
if not Assigned(thread) then begin
{ clean up again }
if not Assigned(thread) then begin
{ clean up again }
{$ifdef FPC_HAS_FEATURE_THREADING}
RtlEventDestroy(syncentry^.SyncEvent);
RtlEventDestroy(syncentry^.SyncEvent);
{$endif}
Dispose(syncentry);
Dispose(syncentry);
end;
end;
end;

81
tests/webtbs/tw35027.pp Normal file
View 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.