(* Программа для проверки процедур работы со списком *)

{$i list.inc}

const 
  strs:array [0..2] of pchar=('again', 'world', 'Hello');


(* Процедура free_list -- освободить занятую списком память *)
procedure free_list (head:ppMEMBER);
var
  curr, next:pMEMBER;
begin
  curr := head^;
  while curr <> nil do
  begin
    next := curr^.m_next;
    (* Освободить память, занятую данными *)
    free (curr^.m_data);
    (* Освободить память, отведенную под структуру списка *)
    free (curr);
    curr := next;
  end;
  (* Обнулить указатель на начало списка *)
  head^ := nil;
end;

(* Функция new_member -- выделить память для нового элемента *)
function new_member (data:pchar):pMEMBER;
var
  newmem:pMEMBER;
begin
  newmem := malloc (sizeof (MEMBER));
  if newmem = nil then
    writeln (stderr, 'new_member: недостаточно памяти')
  else
  begin
    (* Выделить память для копирования данных *)
    newmem^.m_data := malloc (strlen (data) + 1);
    (* Скопировать данные в структуру *)
    strcopy (newmem^.m_data, data);
    (* Обнулить указатель в структуре *)
    newmem^.m_next := nil;
  end;
  new_member:=newmem;
end;

(* Процедура add_member -- добавить новый элемент MEMBER *)
procedure add_member (head:ppMEMBER; newmem:pMEMBER);
begin
  (* Эта простая процедура вставляет новый
   * элемент в начало списка
   *)
  newmem^.m_next := head^;
  head^ := newmem;
end;


(* Обход и вывод списка *)
procedure printlist (listhead:pMEMBER);
var
  m:pMEMBER;
begin
  writeln (#$a'Содержимое списка:');
  if listhead = nil then
    writeln (#9'(пусто)')
  else
  begin
    m := listhead; 
    while m <> nil do
    begin
      writeln (#9, m^.m_data);
      m := m^.m_next;
    end;
  end;
end;


var
  head, newm:pMEMBER;
  j:integer;
begin
  (* Инициализация списка *)
  head := nil;
  (* Добавление элементов к списку *)
  for j:=0 to 2 do
  begin
    newm := new_member (strs[j]);
    add_member (@head, newm);
  end;
  (* Вывести элементы списка *)
  printlist (head);
  (* Удалить список *)
  free_list (@head);
  (* Вывести элементы списка *)
  printlist (head);
end.
