summaryrefslogtreecommitdiff
path: root/fpcsrc/tests/tbs/tb0561a.pp
blob: af1d4fe28e5aef77d05dad863ae4d9ecc92345ee (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
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.