[Lazarus] File region locking under Linux

[ajv]

I have a problem with file region locking under Linux.
First I start setup to create a file and writelock range 10..30
--------------------------------------------------------------
program setup;

{$mode delphi}{$H+}

Uses    cthreads, Classes, SysUtils, BaseUnix;

Const   Fn      = '/home/anthony/test_lock';
        F_RDLCK = 0;
        F_WRLCK = 1;
        F_UNLCK = 2;

Var     F, I    : Integer;
        Region  : FLock;

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);                      // 
Populate file
   With Region Do                                               // Set 
WriteLock 10..30
   Begin
      l_type  := F_WRLCK; l_whence := SEEK_SET;
      l_start := 10;      l_len    := 20
   End;
   If FpFcntl (F, F_SETLK, Region) = -1 Then
      WriteLn ('unable to apply writelock');
   Sleep (20000);                                               // Sleep 
20 Sec
   FpClose (F);
End.
--------------------------------------------------------------------------------------
Then within 20 seconds i start test to obtain a readlock on 80.
This fails. Why? What am I doing wrong?
--------------------------------------------------------------------------------------
program test;

{$mode delphi}{$H+}

Uses    cthreads, Classes, SysUtils, BaseUnix;

Const   Fn      = '/home/anthony/test_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                                               // Set 
ReadLock on 80
   Begin
      l_type  := F_RDLCK; l_whence := SEEK_SET;
      l_start := 80;      l_len    := 1
   End;
   If FpFcntl (F, F_SETLK, Region) = -1 Then
      WriteLn ('unable to apply readlock on 80');
   FpClose (F);
End.
------------------------------------------------------------------------------------
Thanks


_______________________________________________
Lazarus mailing list
Lazarus@lazarus.freepascal.org
http://www.lazarus.freepascal.org/mailman/listinfo/lazarus