Утечка памяти Опции

[klem4]

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

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

ТУТ память не освобождается

А ты что хотел,

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

  temp := First;

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

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

Не выйдет

[klem4]

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

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

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? Утечка, сэр

[klem4]

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

Grand merci !

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

[volvo]

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



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

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

Твои действия?

[klem4]

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

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]

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

Следующий шаг: почему бы 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.