paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 02:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Raise exception if BasicEventCreate fails in constructor (bug ID 30769)

Browse Source 
git-svn-id: trunk@34988 -
This commit is contained in:
michael 2016-11-27 16:08:40 +00:00
parent 975dd13dcb
commit 76f7f81c85
1 changed files with 9 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
packages/fcl-base/src/syncobjs.pp
View File

@ -28,6 +28,10 @@ const
INFINITE = Cardinal(-1); INFINITE = Cardinal(-1);
type type
ESyncObjectException = Class(Exception);
ELockException = Class(ESyncObjectException);
ELockRecursionException = Class(ESyncObjectException);
TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError); TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
TSynchroObject = class(TObject) TSynchroObject = class(TObject)
@ -79,6 +83,9 @@ type
implementation implementation
Resourcestring
SErrEventCreateFailed = 'Failed to create OS basic event with name "%s"';
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Real syncobjs implementation Real syncobjs implementation
---------------------------------------------------------------------} ---------------------------------------------------------------------}
@ -150,6 +157,8 @@ constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
begin begin
FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name); FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
if (FHandle=Nil) then
Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,[Name]);
FManualReset:=AManualReset; FManualReset:=AManualReset;
end; end;