| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Ошибка при очистке дерева объектов!

WondeRu ©   (2005-06-06 18:36:00) 

Здравствуйте, уважаемые!
Вот написал класс древовидной структуры. Дерево один раз заполняется с помощью AddChild, а затем анализируется GetChild.

Подскажите, почему при вызове Dispose возникает ошибка "Неверная работа с указателями"?

unit uTree2;

interface
uses Classes;

type
 TPNode = ^TNode;

 TNode = record
   Name: String[255];
   Value: Integer;
   Next: TPNode;
   Childs: TPNode;
   ChildCount: Integer;
 end;

 TTree = class
 private
   FTop: TPNode;
   procedure FreeContent(ANode: TPNode);
 public
   constructor Create;
   destructor Destroy; override;

   function AddChild(AParent: TPNode): TPNode;
   function GetChild(AParent: TPNode; Index: Integer): TPNode;
   property Top: TPNode read FTop;
 end;

implementation

{ TTree }

function TTree.AddChild(AParent: TPNode): TPNode;
begin
 New(Result);
 Result^.Name := '';
 Result^.Value := 0;
 Result^.Next := nil;
 if AParent^.ChildCount = 0
   then
     AParent^.Childs := Result
   else
     GetChild(AParent, AParent^.ChildCount)^.Next := Result;

 AParent^.ChildCount := AParent^.ChildCount + 1;
end;

constructor TTree.Create;
begin
 New(FTop);
 FTop^.Name := 'Main';
 FTop^.Value := 0;
 FTop^.Next := nil;
end;

destructor TTree.Destroy;
begin
 FreeContent(Top);
 inherited;
end;

procedure TTree.FreeContent(ANode: TPNode);
var
 i : Integer;
 ATempNode: TPNode;
begin
 for i := ANode^.ChildCount - 1 downto 0 do
   begin
     ATempNode := GetChild(ANode, i);
     if ATempNode <> nil then
       begin
         FreeContent(ATempNode);
         Dispose(ATempNode);
       end;
   end;  
end;

function TTree.GetChild(AParent: TPNode; Index: Integer): TPNode;
var
 i : Integer;
begin
 Result := AParent^.Childs;

 for i := 0 to Index - 2 do
   if Result <> nil then
     Result := Result^.Next;
end;

end.

---

WondeRu   (2005-06-07 15:46:00) [1]

Digitman ©   (07.06.05 15:40) [11]
угу.. пасиб!

---

Digitman   (2005-06-07 15:40:00) [2]

> Да и такая структура будет экономичнее память расходовать
> при 100000 узлах дерева


не факт.

тут недавно в "Общие" обсасывалась проблема, где автор жаловался на грабли вида Out of memory  .. найди эту ветку, почитай, вникни, где-что-как-почему экономится или наоборот

---

WondeRu   (2005-06-07 15:37:00) [3]

Digitman ©   (07.06.05 15:30) [9]
и с рекордом вместо класса слаще получается ?)

не слаще... но списки самопальные помучать никогда не мешает для самообразования :)

Да и такая структура будет экономичнее память расходовать при 100000 узлах дерева

---

Digitman   (2005-06-07 15:30:00) [4]

> ампутацией заниматься не охота


а геморрой себе наживать со связными списками и с рекордом вместо класса слаще получается ?)

---

WondeRu   (2005-06-07 15:25:00) [5]

Digitman ©   (07.06.05 15:18) [7]
а смысл, если данное дерево используется лишь два раза, когда заполняется и когда удаляется? :) Велосипед есть, но... глянул я на TCustomTreeView, больно уж много чего он тянет за собой: TWinControl, TList, TTreeNode... а ампутацией заниматься не охота: овчинка выделки не стоит

---

Digitman   (2005-06-07 15:18:00) [6]

> WondeRu ©   (07.06.05 15:10) [6]


можно же поступить проще - взять за основу готовыйкласс TCustomTreeView и повыкидывать из него все визуальные дела, коль они не нужны

---

WondeRu   (2005-06-07 15:10:00) [7]

Digitman ©   (07.06.05 13:57) [5]
если не учебная, то к чему этот новый велосипед, если есть готовый TCustomTreeView

не учебная...
TCustomTreeView - визуальный компонент... да и прибавит моей dll-ке еще 200 кило... смысла нет его пользовать...

---

Digitman   (2005-06-07 13:57:00) [8]

> WondeRu ©   (06.06.05 18:36)  


это что, учебная задача ?
если не учебная, то к чему этот новый велосипед, если есть готовый TCustomTreeView ?

---

WondeRu   (2005-06-07 13:50:00) [9]

учитывая замечания, переделываю:

function TTree.AddChild(AParent: TPNode): TPNode;
begin
New(Result);
Result^.Name := '';
Result^.Value := 0;
Result^.Next := nil;
Result^.Childs := nil;
Result^.ChildCount := 0;

if AParent^.ChildCount = 0
  then
    AParent^.Childs := Result
  else
    GetChild(AParent, AParent^.ChildCount)^.Next := Result;

AParent^.ChildCount := AParent^.ChildCount + 1;
end;

constructor TTree.Create;
begin
New(FTop);
FTop^.Name := 'Main';
FTop^.Value := 0;
FTop^.Next := nil;
FTop^.Childs := nil;
FTop^.ChildCount := 0;
end;

destructor TTree.Destroy;
begin
FreeContent(Top);
inherited;
end;

procedure TTree.FreeContent(ANode: TPNode);
var
i : Integer;
ATempNode: TPNode;
begin
for i := ANode^.ChildCount - 1 downto 0 do
  begin
    ATempNode := GetChild(ANode, i);
    if ATempNode <> nil then
      begin
        FreeContent(ATempNode);
        Dispose(ATempNode);
      end;
  end;  
end;

function TTree.GetChild(AParent: TPNode; Index: Integer): TPNode;
var
i : Integer;
begin
Result := AParent^.Childs;

for i := 1 to Index do
  if Result <> nil then
    Result := Result^.Next;
end;

end.

---

novice_man   (2005-06-07 08:30:00) [10]

В общем все уже сказано:

False_Delirium ©   (06.06.05 23:34) [1][Ответить]
> // где инициализируется ChildCount ?


 При вызове NEW распределяется память под указатель и весь мусор, который находился в ячейках памяти, будет в полях Вашей записи. Так если Вы не инициализировали ChildCount то там может быть например положительное число. При получении последующего элемента Вы не проверяете наличие его, а просто ищете по f or i := 0 to Index - 2 do ..., где Index ANode^.ChildCount, а там может быть что угодно и соответственно AV.
 Таким образом нет соответствия между реальными указателями и счетчиками их.
 Может лучше проверять не nil ли Childs у родителя и если указатель существует тогда выполнять Dispose&

---

ЮЮ   (2005-06-07 06:34:00) [11]

В GetChild Index предполагается в интервале 1 ... ChildCount,
а цикл в FreeContent задается в интервале от ChildCount - 1 до 0

---

False_Delirium   (2005-06-06 23:34:00) [12]

ЭТО работает ???

function TTree.AddChild(AParent: TPNode): TPNode;
begin
New(Result);
Result^.Name := '';
Result^.Value := 0;
Result^.Next := nil;
// где инициализируется ChildCount ?
if AParent^.ChildCount = 0
  then
    AParent^.Childs := Result
  else
    GetChild(AParent, AParent^.ChildCount)^.Next := Result;

AParent^.ChildCount := AParent^.ChildCount + 1; // какой здесь ChildCount ?
end;

До Dispose глаза не дошли ?

---

Наверх