Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Free Pascal, Pascal ABC и другие _ Утечка памяти

Автор: klem4 20.08.2006 22:56

Ухх что-то мозг уже не варит, куда память пропадает ?

Поменял 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.

Автор: volvo 20.08.2006 23:26

Цитата
ТУТ память не освобождается sad.gif

А ты что хотел,
  new(temp); { Выделять память через New }

temp := First;

result := First^.Data;
First := First^.Next;

FreeMem(temp, sizeof(TList)); { а возвращать - через FreeMem? }


Не выйдет smile.gif

Автор: klem4 20.08.2006 23:29

unsure.gif

Вот, посмотри, везде только 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;

GetMem(temp, sizeof(TList));

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);

writeln;

writeln('Free - 1 = ', GetHeapStatus.TotalFree);
s.push(12);
writeln('Free - 2 = ', GetHeapStatus.TotalFree);
s.Push(4);
writeln('Free - 3 = ', GetHeapStatus.TotalFree);

writeln;

s.Pop;
writeln('Free + 1 = ', GetHeapStatus.TotalFree);
s.Pop;
writeln('Free + 2 = ', GetHeapStatus.TotalFree);
s.Pop;
writeln('Free + 3 = ', GetHeapStatus.TotalFree);

s.Done;

writeln;

writeln('Free After = ', GetHeapStatus.TotalFree);

readln;
end.

Автор: volvo 20.08.2006 23:33

Ну, и ты посмотри:

function TStack.Pop : TData;
var
temp : PList;
begin

if First = nil then begin
writeln('nil');
exit;
end;

GetMem(temp, sizeof(TList)); { <-- Выделил память }

temp := First;

result := First^.Data;
First := First^.Next;

FreeMem(temp, sizeof(TList)); { <-- Тут уже ЕЁ ЖЕ вернул }

end;

А где будем возвращать память, выделенную в TStack.Push? Утечка, сэр smile.gif

Автор: klem4 20.08.2006 23:38

smile.gif Получается GetMem для temp тут вообще не нужен. Логично smile.gif Без него все OK.

Grand merci !

А то понадобилось такую конструкцию в прогу вставить, решил ее сначала отладить а тут такая лажа )

Автор: volvo 21.08.2006 1:23

klem4, ты думаешь, это - все?

no1.gif

У меня твоя программа вылетает с таким вот ужасом:

Цитата
00403786 SYSTEM_HANDLEERRORADDRFRAME$LONGINT$POINTER$POINTER ()
004021DC SYSTEM_HANDLEERRORFRAME$LONGINT$POINTER ()
00404A28 SYSTEM_HANDLEERROR$LONGINT ()
0040337B SYSTEM_SYSFREEMEMSIZE$POINTER$LONGINT$$LONGINT ()
0040146A SYSTEM_FREEMEM$POINTER$LONGINT ()
__65098.pp(39) TSTACK__DONE (vmt=$0, this={FIRST = $0, LAST = $8b47c, _vptr$ = {$40902c, $61120f7c}})
__65098.pp(101) main ()


destructor TStack.Done;
begin
FreeMem(First, sizeof(TList)); { < --- 39 строка }
FreeMem(Last, sizeof(TList));
end;


А если сделать так:
destructor TStack.Done;
begin
if assigned(first) then
FreeMem(First, sizeof(TList));
if assigned(last) then
FreeMem(Last, sizeof(TList));
end;

, то не вылетает, НО:
Цитата
Free Before = 65456
Free After = 65472


rolleyes.gif Твои действия?

Автор: klem4 21.08.2006 1:54

rolleyes.gif

Я это тоже пропалил smile.gif Ужасов я правда не видел, но вот это

Цитата

Free Before = 65456
Free After = 65472


меня настарожило и я сделал так :

destructor TStack.Done;
var
temp : PList;
begin
while (First <> nil) do begin
temp := First;
First := First^.Next;
FreeMem(temp, sizeof(TList));
end;
end;

Автор: volvo 21.08.2006 2:07

Так... Уже ближе.

Следующий шаг: почему бы TList не сделать объектом? У меня вот что получилось:

{$mode objfpc}
uses crt;

type
TData = integer;

PList = ^TList;
TList = object

public
data: TData;
next: PList;

constructor init(X: TData);
end;

TStack = object

public
constructor Init;
destructor Done;

procedure Push(item : TData);
function Pop : TData;

private
First, Last : PList;
end;

constructor tlist.init(X: TData);
begin
Data := X; next := nil;
end;

constructor TStack.Init;
begin
First := nil;
Last := nil;
end;

destructor TStack.Done;
var
temp : PList;
begin
while (First <> nil) do begin
temp := First;
First := First^.Next;
dispose(temp);
end;
end;

procedure TStack.Push(item : TData);
var
temp : PList;
begin
temp := new(PList, init(item));

if First = nil then First := temp
else Last^.next := temp;

Last := temp;
end;

function TStack.Pop : TData;
var
temp : PList;
begin

if First = nil then begin
writeln('nil');
exit;
end;

temp := First;

result := First^.Data;
First := First^.Next;

dispose(temp);
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.