(* Программа 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.
