mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 00:59:08 +02:00
* fixed linux flock type by defining and using a kernel_off_t type
whose size depends on whether the run time environment is 32 or 64 bit (mantis #13647) + added flock64 type for 32 bit systems (usable with special 64 bit fcntl operations) git-svn-id: trunk@13119 -
This commit is contained in:
parent
1ce9d05b78
commit
53ad1bcabe
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -7244,6 +7244,8 @@ tests/tbs/tb0557.pp svneol=native#text/plain
|
|||||||
tests/tbs/tb0558.pp svneol=native#text/plain
|
tests/tbs/tb0558.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0559.pp svneol=native#text/plain
|
tests/tbs/tb0559.pp svneol=native#text/plain
|
||||||
tests/tbs/tb0560.pp svneol=native#text/plain
|
tests/tbs/tb0560.pp svneol=native#text/plain
|
||||||
|
tests/tbs/tb0561a.pp svneol=native#text/plain
|
||||||
|
tests/tbs/tb0561b.pp svneol=native#text/plain
|
||||||
tests/tbs/tb205.pp svneol=native#text/plain
|
tests/tbs/tb205.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0060.pp svneol=native#text/plain
|
tests/tbs/ub0060.pp svneol=native#text/plain
|
||||||
tests/tbs/ub0069.pp svneol=native#text/plain
|
tests/tbs/ub0069.pp svneol=native#text/plain
|
||||||
|
@ -137,14 +137,33 @@ type
|
|||||||
TUtimBuf = UtimBuf;
|
TUtimBuf = UtimBuf;
|
||||||
pUtimBuf = ^UtimBuf;
|
pUtimBuf = ^UtimBuf;
|
||||||
|
|
||||||
|
kernel_off_t = clong;
|
||||||
|
kernel_loff_t = clonglong;
|
||||||
|
|
||||||
FLock = Record
|
FLock = Record
|
||||||
l_type : cshort; { lock type: read/write, etc. }
|
l_type : cshort; { lock type: read/write, etc. }
|
||||||
l_whence: cshort; { type of l_start }
|
l_whence: cshort; { type of l_start }
|
||||||
l_start : off_t; { starting offset }
|
l_start : kernel_off_t; { starting offset }
|
||||||
l_len : off_t; { len = 0 means until end of file }
|
l_len : kernel_off_t; { len = 0 means until end of file }
|
||||||
l_pid : pid_t; { lock owner }
|
l_pid : pid_t; { lock owner }
|
||||||
|
{$ifdef cpusparc}
|
||||||
|
__pad : cshort;
|
||||||
|
{$endif}
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
{$ifndef cpu64}
|
||||||
|
FLock64 = Record
|
||||||
|
l_type : cshort; { lock type: read/write, etc. }
|
||||||
|
l_whence: cshort; { type of l_start }
|
||||||
|
l_start : kernel_loff_t; { starting offset }
|
||||||
|
l_len : kernel_loff_t; { len = 0 means until end of file }
|
||||||
|
l_pid : pid_t; { lock owner }
|
||||||
|
{$ifdef cpusparc}
|
||||||
|
__pad : cshort;
|
||||||
|
{$endif}
|
||||||
|
End;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
tms = packed Record
|
tms = packed Record
|
||||||
tms_utime : clock_t; { User CPU time }
|
tms_utime : clock_t; { User CPU time }
|
||||||
tms_stime : clock_t; { System CPU time }
|
tms_stime : clock_t; { System CPU time }
|
||||||
|
31
tests/tbs/tb0561a.pp
Normal file
31
tests/tbs/tb0561a.pp
Normal file
@ -0,0 +1,31 @@
|
|||||||
|
{ %norun }
|
||||||
|
{ %target=linux }
|
||||||
|
|
||||||
|
program test;
|
||||||
|
|
||||||
|
{$mode delphi}{$H+}
|
||||||
|
|
||||||
|
Uses cthreads, Classes, SysUtils, BaseUnix;
|
||||||
|
|
||||||
|
Const Fn = '/tmp/fpctest.lock';
|
||||||
|
F_RDLCK = 0;
|
||||||
|
F_WRLCK = 1;
|
||||||
|
F_UNLCK = 2;
|
||||||
|
|
||||||
|
Var F, I : Integer;
|
||||||
|
Region : FLock;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
F := FpOpen (Fn, O_RDWR Or O_CREAT, $1B6); // $1B6 = o666
|
||||||
|
With Region Do Begin
|
||||||
|
l_type := F_RDLCK; l_whence := SEEK_SET;
|
||||||
|
l_start := 80; l_len := 1
|
||||||
|
End;
|
||||||
|
If FpFcntl (F, F_SETLK, Region) = -1 Then
|
||||||
|
begin
|
||||||
|
writeln(fpgeterrno);
|
||||||
|
WriteLn ('unable to apply readlock on 80'); // <-- Error
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
FpClose (F);
|
||||||
|
End.
|
40
tests/tbs/tb0561b.pp
Normal file
40
tests/tbs/tb0561b.pp
Normal file
@ -0,0 +1,40 @@
|
|||||||
|
{ %target=linux }
|
||||||
|
|
||||||
|
program setup;
|
||||||
|
|
||||||
|
{$mode delphi}{$H+}
|
||||||
|
|
||||||
|
Uses cthreads, Classes, SysUtils, BaseUnix;
|
||||||
|
|
||||||
|
{ don't use current directory in case it's on a network share that does not
|
||||||
|
support locking
|
||||||
|
}
|
||||||
|
Const Fn = '/tmp/fpctest.lock';
|
||||||
|
F_RDLCK = 0;
|
||||||
|
F_WRLCK = 1;
|
||||||
|
F_UNLCK = 2;
|
||||||
|
|
||||||
|
Var F, I : Integer;
|
||||||
|
Region : FLock;
|
||||||
|
res: longint;
|
||||||
|
Begin
|
||||||
|
If FileExists (Fn) Then DeleteFile (Fn);
|
||||||
|
F := FpOpen (Fn, O_RDWR Or O_CREAT, $1B6); // $1B6 = o666
|
||||||
|
For I := 0 To 255 Do FpWrite (F, I, 1);
|
||||||
|
With Region Do Begin
|
||||||
|
l_type := F_WRLCK; l_whence := SEEK_SET;
|
||||||
|
l_start := 10; l_len := 20
|
||||||
|
End;
|
||||||
|
If FpFcntl (F, F_SETLK, Region) = -1 Then
|
||||||
|
begin
|
||||||
|
FpClose (F);
|
||||||
|
deletefile(fn);
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
res:=executeprocess('./tb0561a','');
|
||||||
|
FpClose (F);
|
||||||
|
deletefile(fn);
|
||||||
|
if res<>0 then
|
||||||
|
halt(2);
|
||||||
|
End.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user