Поменял New/Dispose на GetMem/FreeMem не помогло.
{$mode objfpc}
uses crt;
type
TData = integer;
PList = ^TList;
TList = record
data : TData;
next : PList;
end;
TStack = object
public
constructor Init;
destructor Done;
procedure Push(item : TData);
function Pop : TData;
private
First, Last : PList;
end;
constructor TStack.Init;
begin
First := nil;
Last := nil;
end;
destructor TStack.Done;
begin
FreeMem(First, sizeof(TList));
FreeMem(Last, sizeof(TList));
end;
procedure TStack.Push(item : TData);
var
temp : PList;
begin
GetMem(temp, sizeof(TList));
temp^.data := item;
temp^.next := nil;
if First = nil then begin
First := temp;
Last := temp;
end else begin
Last^.next := temp;
Last := temp;
end;
end;
function TStack.Pop : TData;
var
temp : PList;
begin
if First = nil then begin
writeln('nil');
exit;
end;
new(temp);
temp := First;
result := First^.Data;
First := First^.Next;
FreeMem(temp, sizeof(TList)); // ===================> ТУТ память не освобождается :(
end;
var
s : TStack;
begin
clrscr;
writeln('Free Before = ', GetHeapStatus.TotalFree);
s.Init;
s.Push(3);
s.Push(12);
s.Push(4);
s.Pop;
s.Pop;
s.Pop;
s.Done;
writeln('Free After = ', GetHeapStatus.TotalFree);
readln;
end.