Утечка памяти - Free Pascal

Формулировка задачи:

Условие : Деревом поиска называется двоичное дерево, в котором слева от каждой вершины находятся вершины с элементами, меньшими элемента из этой вершины, а справа большими элементами. Описать функцию или процедуру, которая строит новое дерево поиска T1 из тех элементов дерева поиска Т, которое меньше величины Е.

{$I-} 
uses crt;
 
type 
  nodelink = ^node; 
  
  node = record 
    data: integer; 
    left: ^node; 
    right: ^node; 
  end;
 
var 
  c: char; 
  head: nodelink; 
  n: integer; 
  r:integer; 
  z:boolean; 
 
procedure print(node: nodelink; prefix: string);
begin
  if node <> nil then begin
    writeln(prefix,'->',node^.data);
    print(node^.left, prefix + 'L');
    print(node^.right, prefix + 'R');
  end;
end;
 
procedure insert(data: integer; var node: nodelink); 
begin 
  if node = nil then begin 
    new(node); 
    node^.data := data; 
    node^.left := Nil; 
    node^.right := Nil; 
  end else if data < node^.data then 
    insert(data, node^.left) 
  else if data > node^.data then 
    insert(data, node^.right); 
end; 
 
procedure print(node: nodelink); 
begin 
  if node <> Nil then begin 
    print(node^.left); 
    write(' ', node^.data); 
    print(node^.right); 
  end; 
end; 
 
function build(t: nodelink; e: integer):nodelink; 
begin 
  if t = Nil then
    build := Nil 
  else if t^.data < e then begin 
    build := t; 
    build^.right := build(t^.right, e); 
  end else if t^.data = e then begin 
    build := t^.left; 
  end else if t^.data > e then 
    build := build(t^.left, e); 
end; 
 
procedure deleteTree(var Tree: NodeLink); 
begin 
  if Tree <> nil then begin 
    deleteTree(Tree^.left); 
    deleteTree(Tree^.right); 
    dispose(Tree); 
    Tree:=nil;
  end; 
end; 
 
begin
  writeln('BEFORE ',getheapstatus.TotalAllocated);
  readkey;  
  repeat 
    head := Nil; 
    z := false; 
    writeln('Vvedite elementy dereva'); 
    repeat 
      read(n); 
      r := IOResult; 
      if r <> 0 then begin 
        writeln('Error'); 
        z:=true 
      end else if n <> -1 then 
        insert(n, head); 
    until (n = -1) or z; 
 
    if not z then begin 
      print(head, '');
      writeln(); 
 
      writeln('Vvedite element e'); 
      repeat 
        read(n); 
        r := IOResult; 
        if r <> 0 then begin 
          writeln('Error'); 
          z:=true; 
        end; 
      until (r = 0) or z; 
 
      if not z then begin 
        head := build( head, n );
        print(head, '');
        writeln(); 
      end; 
    end;  
    readln(); deleteTree(head);
    writeln('Hotite prodolzhit? (y)'); 
    read(c); 
  until c <> 'y'; deleteTree(head); dispose(head);
  writeln('AFTER ',getheapstatus.TotalAllocated);  
  readkey; 
end.

Решение задачи: «Утечка памяти»

Листинг программы

{$I-}
uses crt;
 
type
  nodelink = ^node;
 
  node = record
    data: integer;
    left: ^node;
    right: ^node;
  end;
 
var
  c: char;
  head, b: nodelink;
  n: integer;
  r:integer;
  z:boolean;
 
procedure print(node: nodelink; prefix: string);
begin
  if node <> nil then begin
    writeln(prefix,'->',node^.data);
    print(node^.left, prefix + 'L');
    print(node^.right, prefix + 'R');
  end;
end;
 
procedure insert(data: integer; var node: nodelink);
begin
  if node = nil then begin
    new(node);
    node^.data := data;
    node^.left := Nil;
    node^.right := Nil;
  end else if data < node^.data then
    insert(data, node^.left)
  else if data > node^.data then
    insert(data, node^.right);
end;
 
procedure print(node: nodelink);
begin
  if node <> Nil then begin
    print(node^.left);
    write(' ', node^.data);
    print(node^.right);
  end;
end;
 
procedure build(var b : nodelink; t: nodelink; e: integer);
begin
  if t <> nil then
  begin
    if t^.data > E then // нужно идти только налево
      build(b, t^.left, E)
    else // тут нужно и направо и налево, но
    begin
      if t^.data < E then // добавлять в новое дерево - только меньшие элементы
        insert(t^.data, b);
      build(b, t^.left, E);
      build(b, t^.right, E)
    end;
  end;
end;
 
procedure deleteTree(var Tree: NodeLink);
begin
  if Tree = nil then exit;
 
  deleteTree(Tree^.left);
  deleteTree(Tree^.right);
  // writeln('removing', Tree^.data);
  dispose(Tree);
  Tree := nil;
end;
 
begin
  writeln('BEFORE ',getheapstatus.TotalAllocated);
  readkey;
  repeat
    head := Nil;
    z := false;
    writeln('Vvedite elementy dereva');
    repeat
      read(n);
      r := IOResult;
      if r <> 0 then begin
        writeln('Error');
        z:=true
      end else if n <> -1 then
        insert(n, head);
    until (n = -1) or z;
 
    if not z then begin
      print(head, '');
      writeln();
 
      writeln('Vvedite element e');
      repeat
        read(n);
        r := IOResult;
        if r <> 0 then begin
          writeln('Error');
          z:=true;
        end;
      until (r = 0) or z;
 
      if not z then begin
        b := nil;
        build(b, head, n);
        print(b, '');
        writeln();
      end;
    end;
    readln(); deleteTree(b);
    writeln('Hotite prodolzhit? (y)');
    read(c);
  until c <> 'y'; deleteTree(head); // dispose(head);
  writeln('AFTER ',getheapstatus.TotalAllocated);
  readkey;
end.

Объяснение кода листинга программы

Объявлены переменные: c, head, b, n, r, z, node, nodelink, t, e, left, right, data.
Определены типы: nodelink, node, integer, boolean.
Создана процедура print(node: nodelink; prefix: string).
Создана процедура insert(data: integer; var node: nodelink).
Создана процедура print(node: nodelink).
Создана процедура build(var b : nodelink; t: nodelink; e: integer).
Создана процедура deleteTree(var Tree: NodeLink).
Создана основная программа.
Выводится информация о выделенной памяти перед началом программы.
Ввод данных: ввод элементов дерева до момента, когда вводится -1 или ошибка.
Если ввод не вызывает ошибку, то вызывается функция build для построения дерева.
После построения дерева выводится сообщение об ошибке, если было введено -1 или ошибка во время ввода.
Если ввод не вызывает ошибку, то начинается цикл, который продолжается до тех пор, пока пользователь не введет 'y'.
В каждой итерации цикла происходит удаление дерева и выводится сообщение об ошибке, если было введено -1 или ошибка во время ввода.
В каждой итерации цикла происходит выделение памяти для нового дерева и его построение.
После построения нового дерева выводится сообщение об ошибке, если было введено -1 или ошибка во время ввода.
Если ввод не вызывает ошибку, то выводится сообщение об ошибке, если было введено -1 или ошибка во время ввода.
В каждой итерации цикла происходит выделение памяти для нового дерева и его построение.
После построения нового дерева выводится сообщение об ошибке, если было введено -1 или ошибка во время ввода.
В каждой итерации цикла происходит выделение памяти для нового дерева и его построение.