Найдите, пожалуйста, ошибку в алгоритме особождения ресурсов

← →
Сатир (2002-11-06 19:24) [0]

есть такой конструктор и деструктор
constructor TColorMap.Create(AOwner: TComponent);
begin
inherited;
fColors := TSClrCollection.Create(Self);
fChilds := TList.Create;
end;

destructor TColorMap.Destroy;
begin
fUpdating := True;
ClearChilds;
fColors.Free;
fChilds.Free;
Base := nil;
inherited;
end;

деструктор вызывает ClearChilds, которая определена следующим образом:

procedure TColorMap.ClearChilds;
var C: TObject;
begin
while fChilds.Count>0 do
begin
C := TObject(fChilds.Last);
if C is TColorMap then TColorMap(C).Base := nil
else if C is TStyleColors then
TStyleColors(C).Map := nil;
end;
end;

При удалении объекта из форму путём нажатия клавиши Del присходит какая-то дикая ошибка в rtl60.bpl, которая влечет за собой кучу других страшных ошибок, вплоть до того, что невозможно даже сохранить текущий проект и вийди из IDE без Access violation.
Но когда я ремарю в деструкторе ClearChilds, всё работает нормально. Возникает подозрение, а не происходит ли где утечка памяти из-за не вызова последней?

ЗЫ. исходный код не мой

← →
Андрей Прокофьев (2002-11-06 19:31) [1]

while fChilds.Count>0 do
begin
C := TObject(fChilds.Last);

а как это цикл вообще заканчивается

← →
Alex4444444444 (2002-11-06 19:36) [2]

for I := 0 to fChildren.Count - 1 do begin ... TObject(fChildren[I]).Free; end;

← →
oomneeq (2002-11-06 19:39) [3]

ClearChilds как он написан, ничего не освобождает, если .Base и .Map не какие-нибудь интерфейсные, а просто объектные свойства, то посадка их на nil в смысле освобождения памяти ничего не дает.
Похоже, что вызывать необязательно.

теоретически, правда влияние может быть косвенным:
(где нибудь в каком-нибудь деструкторе какая-нибудь память освобождается условно, в зависимости от того nil или not nil эти самые .Base и .Map) ну очень теоретически..

← →
Сатир (2002-11-06 19:50) [4]

2Андрей Прокофьев © (06.11.02 19:31)
действительно, а как лучше всего в данном случае уменьшить число объектов в этом списке?

← →
Андрей Прокофьев (2002-11-06 19:53) [5]

ClearChilds вообще ничего не удаляет, а только бесконечно чистит ссылки на другие объекты у последненго элемента списка.Значит надо смотреть TColorMap.SetBase и TStyleColor.SetMap
Что там происходит при Value равной nil.

← →
Андрей Прокофьев (2002-11-06 20:00) [6]

procedure TColorMap.ClearChilds;
var C: TObject;
i : Integer
begin

for i:= 0 to fChilds.Count - 1 do
begin
C := TObject(fChilds.Last);

//Это по-моему особенно не нужно
{
if C is TColorMap then TColorMap(C).Base := nil
else if C is TStyleColors then
TStyleColors(C).Map := nil;
}

C.Free;
end;
fChilds.Clear;
end;

← →
Андрей Прокофьев (2002-11-06 20:00) [7]

procedure TColorMap.ClearChilds;
var C: TObject;
i : Integer
begin

for i:= 0 to fChilds.Count - 1 do
begin
C := TObject(fChilds.Items[i]);
//Это по-моему особенно не нужно
{
if C is TColorMap then TColorMap(C).Base := nil
else if C is TStyleColors then
TStyleColors(C).Map := nil;
}

C.Free;
end;
fChilds.Clear;
end;

← →
Сатир (2002-11-06 20:03) [8]

2Андрей Прокофьев © (06.11.02 19:53)
procedure TColorMap.SetBase(const Value: TColorMap);
begin
// if Value.Base = self then Exit;
if (fBase <> Value) and (Value<>Self) then
begin
if fBase<>nil then fBase.fChilds.Remove(Self);
fBase := Value;
if fBase<>nil then fBase.fChilds.Add(Self);
UpdateColors(0);
end;
end;

procedure TStyleColors.SetMap(const Value: TColorMap);
begin
if fMap <> Value then
begin
if fMap<>nil then fMap.fChilds.Remove(Self);
fMap := Value;
if fMap<>nil then fMap.fChilds.Add(Self);
CompileColors;
end;
end;

ЗЫ. но тем не менее, ведь условие fChilds.Count>0 не изменяется?

← →
Сатир (2002-11-06 20:06) [9]

2Андрей Прокофьев © (06.11.02 20:00)
>for i:= 0 to fChilds.Count - 1 do
кстати, а этот цикл, случайно, не сконца нужно проходить?
то есть
For i:= fChilds.Count - 1 downto 0 do?

← →
Андрей Прокофьев (2002-11-06 20:11) [10]

2 Сатир © (06.11.02 20:06)
>> кстати, а этот цикл, случайно, не сконца нужно проходить?
Не нужно, так как элементы списка не удаляются, а уничтожаются сами объекты, на которые ссылаются элементы списка.
А сам список чистится в List.Clear;

2 Сатир © (06.11.02 20:03)
UpdateColors(0);
CompileColors;
там fBase не участвует?

← →
Сатир (2002-11-06 20:15) [11]

2Андрей Прокофьев © (06.11.02 20:00)
неподходит
плюётся таким макаром:
Access violation at address 40005988 in module "rtl60.bpl".
Read of address 0B1A6B18.

← →
Сатир (2002-11-06 20:18) [12]

ладно, всем спасибо, а в особенности, Андрею Прокофьеву, бегу.
надеюсь, продолжим завтра...

← →
Alex4444444444 (2002-11-06 20:20) [13]

Vy dolzhny tochno ponyat", kto kem vladeet. (Naprimer, pozabotit"sya, chto NE proishodit ColorMap1.Base := ColorMap2 i ColorMap2.Base := ColorMap1, t.k. v etom sluchae Vy budete pytat"sya udalit" uzhe udalennuyu TColorMap.) Esli eto vse zhe neobhodimo, oni dolzhny drug druga opoveshat" ob udalenii.
E.g.,

destructor TColorMap.Destroy; begin ClearChildren; ... if Assigned(fBase) then fBase.fChildren.Extract(Self);... inherited; end;

← →
Alex4444444444 (2002-11-06 20:24) [14]

Pardon, dazhe, skoree, naoborot:

destructor TColorMap.Destroy; begin if Assigned(fBase) then fBase.fChildren.Extract(Self); ... ClearChildren; ... inherited; end;

t.k., esli fBase sredi fChildren, to ona nachnet osvobozhdat"sya i vyzivet Destroy snova ==> beskonechnyj cycle ili access violation.

← →
Alex4444444444 (2002-11-06 20:28) [15]

Eshe odno zamechanie: esli Vy sdelaete fBase...Extract, to potom mozhno (i dazhe NUZHNO) ispol"zovat" Vash podhod:

with fChildren do while Count > 0 do TObject(Last).Free;

← →
Андрей Прокофьев (2002-11-06 20:37) [16]

2 Alex4444444444 (06.11.02 20:28)
1 Call Extract to remove an item from the list. After the item is removed, all the objects that follow it are moved up in index position and Count is decremented.

with fChildren do
while Count > 0 do TObject(Last).Free;
TObject(Last).Free - не удаляет элемент из списка - цикл бесконечный

← →
Alex4444444444 (2002-11-06 20:45) [17]

T.k. my dogovorilis", chto Last---eto TColorMap i iz Destroy on vyzovet Extract, to Count budet umen"shat"sya. Voobshe, konechno, krugovye ssylki---poganaya vesh"...

← →
Набережных С. (2002-11-06 21:14) [18]

>Сатир ©

Выключи компьютер. Возьми лист бумаги и нарисуй. Нарисуй схему взаимодействия твоих компонентов. Что как, когда и на кого должно воздействовать и как тот должен реагировать. Попутно отметь, где какие ресурсы захватываются, и когда их нужно и можно освободить. Учти реакцию на сообщения. Пока не будет полной ясности - от запуска проги до завершения - не включай ящик. Если получится, то у тебя никогда больше не будет возникать подобных вопросов. Потом сможешь проделывать это в уме, но первый раз - ОБЯЗАТЕЛЬНО на бумаге!

← →
Юрий Зотов (2002-11-07 00:42) [19]

> Сатир

НА 100% присоединяюсь к "Набережных С. (06.11.02 21:14)".
Прислушайтесь, не пожалеете.

← →
Сатир (2002-11-07 13:49) [20]

2 Набережных С. (06.11.02 21:14) и Юрий Зотов © (07.11.02 00:42)
понятное дело, но ведь исходники не мои, и архитектуру взаимодейстия создавал не я. мне нужно всего лишь добавить два редактора свойств и попутно найти ошибки в этом пакете. А с выключенным компом без доступа к исходникам я это вряд ли сделаю. Ваш подход нужно применять на начальной стадии проектирования, когда ещё ничего нет, это да, самое главное - спланировать на бумажке, что ты хочешь на(ш)кодить, а потом, согласно нарисованной инструкции приниматься за работу. Но в данном случае, имхо, другая ситуация.
Но в любом случае, прийдётся выяснить, кто чей папа/мама/ребёнок и кто/что/кому говорит.
Ладно вернёмся к нашим баранам.

2Андрей Прокофьев © (06.11.02 20:11)
>UpdateColors(0);
>CompileColors;
>там fBase не участвует?
привожу исходный код

procedure TColorMap.UpdateColors(Index: Integer); var I,CC: Integer; begin if fUpdating then Exit; fColors.BeginUpdate; if Index=0 then CC := 0 else CC := 1; try for I:= Index to fColors.Count-1 do Inc(CC,CalculateColor(TStyleColor(fColors.Items[I]))); fUpdating := True; finally fColors.EndUpdate; fUpdating := False; end; // if CC>0 then with fChilds do for I:=0 to Count-1 do if TObject(Items[I]) is TColorMap then TColorMap(Items[I]).UpdateColors(0) else if TObject(Items[I]) is TStyleColors then TStyleColors(Items[I]).CompileColors; end; procedure TStyleColors.CompileColors; var I: Integer; L: TStringList; begin L := TStringList.Create; try L.CommaText := fFormulas; SetLength(fColors,L.Count); for I:=0 to L.Count-1 do fColors[I] := MakeColor(L[I]); finally L.Free; end; if Assigned(fOnChange) then OnChange(Self); end;

← →
Набережных С. (2002-11-07 16:57) [21]

>Сатир ©

А ты пробовал создавать объект в run-time и пройтись отладчиком по деструктору?

← →
Сатир (2002-11-07 17:14) [22]

2Набережных С. (07.11.02 16:57)
неплохая идея;)

← →
Набережных С. (2002-11-07 18:49) [23]

← →
Сатир (2002-11-07 19:41) [24]

2Набережных С. (07.11.02 18:49)
идея замечательная, но пока от неё толку мало, потому что при создании и удалении в run-time ничего страшного не происходит. насколько удалось выяснить, эта проблема касается взаимодействия с другими компонентами из этого же пакета, но с какими, пока неизвестно;(

← →
Набережных С. (2002-11-07 20:43) [25]

Уже лучше, чем ничего:) Постарайся сузить "круг подозреваемых".
И посмотри, нет ли где такого :
if csDesigning in ComponentState ...
Возможно, разгадка в этом.

← →
Shc (2002-11-09 15:51) [26]

Извините, ребят, за попутный вопрос, но где в коде
while fChilds.Count>0 do begin C := TObject(fChilds.Last); if C is TColorMap then TColorMap(C).Base := nil else if C is TStyleColors then TStyleColors(C).Map := nil; end;
переход на следующий элемент (не пойму, почему нет зацикливания)?

← →
Alex44 (2002-11-09 19:39) [27]

Po vidimomu, za eto otvechaet TColorMap.SetBase i TStyleColors.SetMap (sm. moj code naverhu): pri vystavlenii Base v nil oni ubirayut ssylku na sebya is Base.fChildren, i tem samym fCildren.Count umen"shaetsya i fChildren.Last stanovitsya predydushim elementom. Eto prosto neobhodimo, esli ne isklyucheny krugovye ssylki.

← →
Сатир (2002-11-10 20:12) [28]

короче, цикл
procedure TColorMap.ClearChilds; var C: TObject; begin while fChilds.Count>0 do begin C := TObject(fChilds.Last); if C is TColorMap then TColorMap(C).Base := nil else if C is TStyleColors then TStyleColors(C).Map := nil; end; end;
всё таки заканчивается, пробовал создавать и удалять в run-time
хотя, возникает вопрос: а не может случайно быть такого, чтоб ошибку design-time нельзя было бы выявить путём тестирования в режиме run-time?

← →
Alex44 (2002-11-10 21:46) [29]

Esli v run-time vse OK, to kakaya zhe eto oshibka? :)

← →
Сатир (2002-11-10 22:18) [30]

2Alex44 (10.11.02 21:46)
как какая? берёшь тестовую прогу, удаляешь с неё компонент в design-time"e, и всё. Куча багов, да причём таких, что без ошибки невозможно даже закрыть делфи нормально, не говоря уже о элементарной возможности сохранения и закрытия всего проекта...

Найдите, пожалуйста, ошибку в алгоритме особождения ресурсов Найти похожие ветки