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

* Introduce fmShareNoLocking to disable locking of file descriptors on unix

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-01-28 10:50:29 +01:00
parent bac4ca19e7
commit e79f5ef577
2 changed files with 7 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
rtl/objpas/sysutils/filutilh.inc
View File

@ -199,6 +199,8 @@ Const
fmShareDenyWrite = $0020;
fmShareDenyRead = $0030;
fmShareDenyNone = $0040;
// internal to FPC
fmShareNoLocking = $0100;
{ File seek origins }
fsFromBeginning = 0;

8
rtl/unix/sysutils.pp
View File

@ -471,7 +471,8 @@ Function FileOpen (Const FileName : RawbyteString; Mode : Integer) : Longint;
begin
FileOpen:=FileOpenNoLocking(FileName, Mode);
FileOpen:=DoFileLocking(FileOpen, Mode);
if (Mode and fmShareNoLocking)=0 then
FileOpen:=DoFileLocking(FileOpen, Mode);
end;
function FileFlush(Handle: THandle): Boolean;
@ -513,7 +514,7 @@ begin
(which we can by definition) }
fd:=FileOpenNoLocking(FileName,ShareMode);
{ the file exists, check whether our locking request is compatible }
if fd>=0 then
if (fd>=0) and ((ShareMode and fmShareNoLocking)=0) then
begin
Result:=DoFileLocking(fd,ShareMode);
FileClose(fd);
@ -523,7 +524,8 @@ begin
end;
{ now create the file }
Result:=FileCreate(FileName,Rights);
Result:=DoFileLocking(Result,ShareMode);
if (ShareMode and fmShareNoLocking)=0 then
Result:=DoFileLocking(Result,ShareMode);
end;