From 53ad1bcabe82ba6c24e20e046f332560e5e1f529 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 9 May 2009 19:47:59 +0000
Subject: [PATCH]   * 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 -
---
 .gitattributes        |  2 ++
 rtl/linux/ostypes.inc | 23 +++++++++++++++++++++--
 tests/tbs/tb0561a.pp  | 31 +++++++++++++++++++++++++++++++
 tests/tbs/tb0561b.pp  | 40 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 94 insertions(+), 2 deletions(-)
 create mode 100644 tests/tbs/tb0561a.pp
 create mode 100644 tests/tbs/tb0561b.pp

diff --git a/.gitattributes b/.gitattributes
index ea9f052c5b..3d5714cd7c 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -7244,6 +7244,8 @@ tests/tbs/tb0557.pp svneol=native#text/plain
 tests/tbs/tb0558.pp svneol=native#text/plain
 tests/tbs/tb0559.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/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
diff --git a/rtl/linux/ostypes.inc b/rtl/linux/ostypes.inc
index 0beec63441..98ff75d44d 100644
--- a/rtl/linux/ostypes.inc
+++ b/rtl/linux/ostypes.inc
@@ -137,14 +137,33 @@ type
    TUtimBuf  = UtimBuf;
    pUtimBuf  = ^UtimBuf;
 
+   kernel_off_t = clong;
+   kernel_loff_t = clonglong;
+
    FLock     = Record
                 l_type  : cshort;       { lock type: read/write, etc. }
                 l_whence: cshort;       { type of l_start }
-                l_start : off_t;        { starting offset }
-                l_len   : off_t;        { len = 0 means until end of file }
+                l_start : kernel_off_t; { starting offset }
+                l_len   : kernel_off_t; { len = 0 means until end of file }
                 l_pid   : pid_t;        { lock owner }
+{$ifdef cpusparc}
+                __pad   : cshort;
+{$endif}
                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_utime  : clock_t;   { User CPU time }
                 tms_stime  : clock_t;   { System CPU time }
diff --git a/tests/tbs/tb0561a.pp b/tests/tbs/tb0561a.pp
new file mode 100644
index 0000000000..af1d4fe28e
--- /dev/null
+++ b/tests/tbs/tb0561a.pp
@@ -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.
diff --git a/tests/tbs/tb0561b.pp b/tests/tbs/tb0561b.pp
new file mode 100644
index 0000000000..e6143778f6
--- /dev/null
+++ b/tests/tbs/tb0561b.pp
@@ -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.
+