Работа со стеком - не все нечетные элементы удаляются

Новичок · Регистрация: 17.07.2012

Author24 — интернет-сервис помощи студентам

Приветствую всех форумчан. Хочу научиться работать со стеком. Вот решил написать прогу, которая создает стек, выводит его, удаляет в нем нечетные элементы и выводит новый стек. Только что-то не все нечетные элементы удаляются, как это исправить? И еще, нет ли утечки памяти? Заранее благодарен.

Pascal

type TList=^List;
     List=record
     x:Integer;
     next:TList;
     end;
 
procedure add(var st:TList;value:Integer);
var ls:TList;
begin
new(ls);
ls^.x:=value;
ls^.next:=st;
st:=ls;
end;
 
procedure free(var st:TList);
var ls:TList;
begin
while st<>nil do
 begin
  ls:=st;
  st:=st^.next;
  dispose(ls);
 end;
 
end;
 
procedure delete(var st:TList);
var ls,next:TList;
begin
ls:=st;
while ls<>nil do
 begin
  next:=ls^.next;
  if next=nil then Break;
  if odd(next^.x) then 
   begin
    ls^.next:=next^.next;
    dispose(next);
   end; 
  ls:=ls^.next;
 end;
ls:=st;
if odd(ls^.x) then 
 begin
  st:=ls^.next;
  dispose(ls);
 end;
end;
 
var stack,lst:TList;
i,n:Integer;
begin
Write('n=');
Readln(n);
Writeln('Stack:');
new(stack);
Randomize;
stack^.x:=Random(100);
for i:=1 to n-1 do add(stack,Random(100));
lst:=stack;
while lst<>nil do
 begin
  Writeln(lst^.x);
  lst:=lst^.next;
 end;
delete(stack);
Writeln('New stack:');
lst:=stack;
while lst<>nil do
 begin
  Writeln(lst^.x);
  lst:=lst^.next;
 end;
free(stack);
Readln;
end.

@volvo · 26.05.2014, 23:22

Сообщение от Новичок

Только что-то не все нечетные элементы удаляются, как это исправить?

Pascal

while ls<>nil do
begin
   next:=ls^.next;
   if next=nil then Break;
   if odd(next^.x) then 
   begin
      ls^.next:=next^.next;
      dispose(next);
   end
   else ls:=ls^.next;
end;

Кроме того, чтобы программа гарантированно (а не "в зависимости от положения Юпитера на небосклоне") не вылетала, надо сделать еще одно движение:

Pascal

56
57
58

Randomize;
stack^.x:=Random(100);
stack^.next := nil; // <--- Вот это

Новичок · 26.05.2014, 23:38 **[ТС]**

О, все понял. Спасибо большое! Как я понял утечки памяти нет? Вот исправленный код.

Pascal

type TList=^List;
     List=record
     x:Integer;
     next:TList;
     end;
 
procedure add(var st:TList;value:Integer);
var ls:TList;
begin
new(ls);
ls^.x:=value;
ls^.next:=st;
st:=ls;
end;
 
procedure free(var st:TList);
var ls:TList;
begin
while st<>nil do
 begin
  ls:=st;
  st:=st^.next;
  dispose(ls);
 end;
 
end;
 
procedure delete(var st:TList);
var ls,next:TList;
begin
ls:=st;
while ls<>nil do
begin
   next:=ls^.next;
   if next=nil then Break;
   if odd(next^.x) then 
   begin
      ls^.next:=next^.next;
      dispose(next);
   end
   else ls:=ls^.next;
end;
ls:=st;
if odd(ls^.x) then 
 begin
  st:=ls^.next;
  dispose(ls);
 end;
end;
 
var stack,lst:TList;
i,n:Integer;
begin
Write('n=');
Readln(n);
Writeln('Stack:');
new(stack);
Randomize;
stack^.x:=Random(100);
stack^.next:=nil;//И это буду теперь знать
for i:=1 to n-1 do add(stack,Random(100));
lst:=stack;
while lst<>nil do
 begin
  Writeln(lst^.x);
  lst:=lst^.next;
 end;
delete(stack);
Writeln('New stack:');
lst:=stack;
while lst<>nil do
 begin
  Writeln(lst^.x);
  lst:=lst^.next;
 end;
free(stack);
Readln;
end.

@volvo · 27.05.2014, 02:53

Сообщение от Новичок

Как я понял утечки памяти нет?

А самому проверить? В Options->Compiler->Additional compiler args вводишь -gh, жмешь Ok, и у тебя будет работать утилита heaptrc, отлавливающая утечки памяти. В твоем коде она ничего не нашла:

XML

Heap dump by heaptrc unit
10 memory blocks allocated : 80/80
10 memory blocks freed     : 80/80
0 unfreed memory blocks : 0
True heap size : 98304 (112 used in System startup)
True free heap : 98192

Новичок · 27.05.2014, 16:12 **[ТС]**

Попробовал, действительно удобно. Как я понял это

Сообщение от UI

10 memory blocks allocated :

должно быть равно этому

Сообщение от UI

10 memory blocks freed :

Работа со стеком - не все нечетные элементы удаляются

Решение

Решение

Новичок 1642 / 1091 / 487 Регистрация: 17.07.2012 Сообщений: 5,345
	27.05.2014, 16:12 [ТС]	5
	Попробовал, действительно удобно. Как я понял это Сообщение от UI 10 memory blocks allocated : должно быть равно этому Сообщение от UI 10 memory blocks freed : 0