Полищук, Семериков. Системное программирование в UNIX средствами Free Pascal / examples / 8 / deadlock

(* рТПЗТБННБ deadlock - ДЕНПОУФТБГЙС ЛМЙОЮБ *)
uses linux, stdio;

function fatal (s:pchar):integer;
begin
perror (s);
halt (1);
end;

var
fd:longint;
first_lock, second_lock:flockrec;
begin
first_lock.l_type := F_WRLCK;
first_lock.l_whence := SEEK_SET;
first_lock.l_start := 0;
first_lock.l_len := 10;
second_lock.l_type := F_WRLCK;
second_lock.l_whence := SEEK_SET;
second_lock.l_start := 10;
second_lock.l_len := 5;

writeln(sizeof(flockrec));
fd := fdopen ('locktest', Open_RDWR);

fcntl (fd, F_SETLKW, longint(@first_lock));
if linuxerror>0 then (*A *)
fatal ('A');

writeln ('A: ХУРЕЫОБС ВМПЛЙТПЧЛБ (РТПГЕУУ ',getpid,')');

case fork of
-1:
(* ПЫЙВЛБ *)
fatal ('пЫЙВЛБ ЧЩЪПЧБ fork');
0:
begin
(* ДПЮЕТОЙК РТПГЕУУ *)
fcntl (fd, F_SETLKW, longint(@second_lock));
if linuxerror>0 then (*B *)
fatal ('B');
writeln ('B: ХУРЕЫОБС ВМПЛЙТПЧЛБ (РТПГЕУУ ',getpid,')');
fcntl (fd, F_SETLKW, longint(@first_lock));
if linuxerror>0 then (*C *)
fatal ('C');
writeln ('C: ХУРЕЫОБС ВМПЛЙТПЧЛБ (РТПГЕУУ ',getpid,')');
halt (0);
end;
else
begin
(* ТПДЙФЕМШУЛЙК РТПГЕУУ *)
writeln ('рТЙПУФБОПЧЛБ ТПДЙФЕМШУЛПЗП РТПГЕУУБ');
sleep (10);
fcntl (fd, F_SETLKW, longint(@second_lock));
if linuxerror>0 then (*D *)
fatal ('D');
writeln ('D: ХУРЕЫОБС ВМПЛЙТПЧЛБ (РТПГЕУУ ',getpid,')');
end;
end;
end.