(* Пример использования флага Open_NONBLOCK *)
uses linux,stdio;

const
  MSGSIZE=6;
  msg1:array [0..MSGSIZE-1] of char = 'hello';
  msg2:array [0..MSGSIZE-1] of char = 'bye!!';


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


function parent(fdin,fdout:integer):integer;		(* код родительского процесса *)
var
  nread:longint;
  buf:array [0..MSGSIZE-1] of char;
begin
  fdclose (fdout);
  while true do
  begin
    nread := fdread (fdin, buf, MSGSIZE);
    case nread of
      -1:
      begin
        (* Проверить, есть ли данные в канале. *)
        if linuxerror = Sys_EAGAIN then
        begin
          writeln('(канал пуст)');
          sleep (1);
        end
        else
          fatal ('Ошибка вызова read');
      end;
      0:
      begin
        (* Канал был закрыт. *)
        writeln('Конец связи');
        halt (0);
      end;
      else
	writeln('MSG=', buf);
    end;
  end;
end;


function child (fdin,fdout:integer):integer;
var 
  count:longint;
begin
  fdclose (fdin);
  for count := 1 to 3 do
  begin
    fdwrite (fdout, msg1, MSGSIZE);
    sleep (3);
  end;
  (* Послать последнее сообщение *)
  fdwrite (fdout, msg2, MSGSIZE);
  halt (0);
end;


var
  fdin,fdout:longint;
begin
  (* Открыть канал *)
  if not assignpipe (fdin,fdout) then
    fatal ('Ошибка вызова pipe ');
  (* Установить флаг Open_NONBLOCK для дескриптора fdin *)
  fcntl (fdin, F_SETFL, Open_NONBLOCK);
  if (linuxerror=sys_eagain) or (linuxerror=sys_eacces)   then
    fatal ('ошибка вызова fcntl');
  case fork of
    -1:			(* ошибка *)
      fatal ('ошибка вызова fork');
    0:			(* дочерний процесс *)
      child (fdin,fdout);
    else		(* родительский процесс *)
      parent (fdin,fdout);
  end;
end.
