Delphi XE3
Есть такой класс:
| Код |
TFormator=class
private
FOwner:TFormList;
function Q:TADOQuery;
public
Id:Integer;
Id_Type:Integer;
Id_Div:Integer;
Row:Integer;
Num:Integer;
IP:String;
Status:Integer;
DeletedDate:TDate;
DblField1:Double;
DblField2:Double;
DblField3:Double;
IntFields:array[1..12] of Integer;
constructor Create(AOwner:TFormList);
destructor Destroy;override;
//Разные методы до кучи
end;
|
В общем ничего особенного не содержит кроме ссылки на владельца.
И есть контейнер.
| Код |
TFormList=class (TObjectList<TFormator>)
private
public
Q:TADOQuery;
procedure Fill(Q:TADOQuery; Deleted:Boolean);
constructor Create(AQuery:TADOQuery=nil);
destructor Destroy;override;
//Разного рода методы
end;
|
Контейнеры являются глобальными (их 2 шт) и создаются всего 1 раз.
| Код |
FVS:=TFormList.Create(Q);
FVS.OwnsObjects:=True;
|
Для заполнения контейнеров есть ф-ия. Больше нигде добавление, или исключение объектов не производится.
| Код |
procedure TFormList.Fill(Q: TADOQuery; Deleted: Boolean);
var i:Integer;
Del:Boolean;
F:TFormator;
begin
Clear;
Q.First;
for i:=0 to Q.RecordCount-1 do
begin
Del:=Q.Fields[6].Value<>NULL;
if Del=Deleted then
begin
F:=TFormator.Create(Self);
//Просто заполнили поля
F.Id:=Q.Fields[0].AsInteger;
F.Id_Div:=Q.Fields[1].AsInteger;
F.Id_Type:=Q.Fields[2].AsInteger;
F.Row:=Q.Fields[3].AsInteger;
F.Num:=Q.Fields[4].AsInteger;
F.IP:=Q.Fields[5].AsString;
if Del then F.DeletedDate:=Q.Fields[6].AsDateTime
else F.DeletedDate:=0;
//Засунули в контейнер, больше ничего интересного не делаем
Add(F);
end;
Q.Next;
end;
end;
|
Если контейнер не пустой, то на вызове Clear происходит AV по нулевому адресу. Значение OwnsObjects, или предварительное уничтожение объектов в контейнере роли не играют, до их деструктора просто не доходит. Аналогичная проблема происходит при попытке уничтожения контейнера. Если включить debug dcu's, то все падает в
| Код |
procedure TList<T>.DeleteRange(AIndex, ACount: Integer);
var
oldItems: array of T;
tailCount, I: Integer;
begin
if (AIndex < 0) or (ACount < 0) or (AIndex + ACount > Count)
or (AIndex + ACount < 0) then
raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
if ACount = 0 then
Exit;
SetLength(oldItems, ACount);
FArrayManager.Move(FItems, oldItems, AIndex, 0, ACount);{На вот этой строке}
tailCount := Count - (AIndex + ACount);
if tailCount > 0 then
begin
FArrayManager.Move(FItems, AIndex + ACount, AIndex, tailCount);
FArrayManager.Finalize(FItems, Count - ACount, ACount);
end else
FArrayManager.Finalize(FItems, AIndex, ACount);
Dec(FCount, ACount);
for I := 0 to Length(oldItems) - 1 do
Notify(oldItems[I], cnRemoved);
end;
|
Проблему можно обойти, если заменить вызов Clear на
| Код |
for i:=Count-1 downto 0 do Delete(i);
|
Однако это не отменяет вопроса, что я делаю не так. Вопрос, как подойти к проблеме, судя по нулевому адресу похоже на обращение к несуществующему объекту, но как этот вызов отловить? Просмотр ассемблерного кода в FArrayManager.Move не много дал, хотя скажем прямо с асмом мне работать не приходилось. |
)