Народ, я уже не могу, я щасойду сума

← →
dust © (2006-01-04 13:34) [0]

Я уже часа три бьюсь на сотней строчек кода. И не могу не могу понять почему я в деструкторе ошибку получаю.
Как можно вообще получить ошибку в деструкторе при вызове Inherited!??? Особенно учитывая, что объект наследовался от TObject, тем более эксцепшн Invalid Pointer Operation.

← →
Virgo_Style © (2006-01-04 13:37) [1]

dust © (04.01.06 13:34)
Как можно вообще

Программа твоя, тебе виднее. Покажешь деструктор - может и мы узнаем.

← →
umbra © (2006-01-04 13:38) [2]

а отладить с заходом в Inherited?

← →
Kerk © (2006-01-04 13:38) [3]

Отвечает Александр Друзь...

← →
Гаврила © (2006-01-04 13:40) [4]

вариантов много
может быть, объект уже разрушен
может быть, он и не был создан
Он у тебя виртуальный, деструктор?

← →
dust © (2006-01-04 13:42) [5]

Так что код показывать? Посмотрите свежим взглядом?

← →
Игорь Шевченко © (2006-01-04 13:47) [6]

> Так что код показывать?

Зачем ? Дай поупражняться в телепатии

← →
Virgo_Style © (2006-01-04 13:48) [7]

dust © (04.01.06 13:42) [5]

Предлагаю начать новую ветку под названием "стоит ли dust"у показывать свой код?"

P.S. Что-то злой я какой-то сегодня. Извини, если что :-) Покажи, конечно. Хотя зачем в "потрепаться" писал...

← →
Думкин © (2006-01-04 13:50) [8]

Остановите Землю. Я сойду.

Но вы на Луне.

А.. сойти то мне надо на Землю. И Луну остановите тоже.

← →
tesseract © (2006-01-04 13:50) [9]

> ошибку в деструкторе при вызове Inherited!???

Запросто если вызываешь в начале деструктора.

← →
dust © (2006-01-04 13:52) [10]

type aDword = packed array [0..31] of dword;
type aByte = packed array [0..1024*16-1] of byte;

procedure TForm1.Button1Click(Sender: TObject);
var
Chain1 : TChain;
i,j,k : INteger;
aData : aByte;
aDWD : ^aDword;
begin
aDWD := Pointer(@aData);
Chain1 := TChain.Create(1024*16);
k:=1;
for i:=1 to k do
begin
for j:= 0 to 30 do
aDWD^[j] := Random(513);
Chain1.Append(aData);
end;
chain1.Destroy;
end;

← →
dust © (2006-01-04 13:53) [11]

unit Chains;

interface
uses Windows, SysUtils;
type
PChainRec = ^TChainRec;
TChainRec = record
Prev,
Next : PChainRec;
Data : Pointer;
end;
//***********************************************************************
//***********************************************************************
//***********************************************************************
TChain = class(TObject)
private
{ Private declarations }
ItemSize : Integer;

First, //первый, последний и текущий элементы цепочки
Last,
Current,
//Bookmark
OldPosition : PChainRec;
FEmptyFlag : boolean;
//procedure GetLastBranch (var Branch : TChainRec)
function GetData(const item: Pointer): Pointer;
public
{ Public declarations }
Count : Integer; //текущее Колличество элементов в списке

{Конструктор и деструктор}
constructor Create (const DataSize : Integer);
destructor Destroy(); override;

procedure Append (const item); //добавляет в конец цепочки
procedure AddFirst (const item); //добавляет в начало цепочки
procedure Delete(); //удаляет текущий элемент делая текущим следующий
procedure Clear(); //очищает цепочку

//базовая Навигация по списку
procedure Prev(); //делает текущим предыдущий элемент
procedure Next(); //делает текущим следующий элемент
//расширенная навигация по списку
procedure GoFirst(); //делает текущим первый элемент
procedure GoLast(); //делает текущим последний элемент
procedure RememberPos(); //запоминает текущий элемент,,, (!)будьте осторожны(!)
procedure RestorePos(); //восстанавливает текущий элемент,,,(!)будьте осторожны(!)

function GetCurrent(): Pointer; //выдаёт указатель на текущий элемент в списке
function IsFirst() : boolean; //?????проверяет, является ли текущий списка последним
function IsLast() : boolean; //?????проверяет, является ли текущий списка последним
function IsEmpty() : boolean; //?????проверяет, является ли текущий списка последним
end;

implementation

{ TChain }
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

constructor TChain.Create (const DataSize : Integer);
begin
inherited Create();
ItemSize := DataSize;
FEmptyFlag:=true;
Count := 0;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.AddFirst(const item);
var tmpBranch : PChainRec;
begin
new(tmpBranch);
if FEmptyFlag then
begin
FEmptyFlag := false;
Last := tmpBranch;
Current := tmpBranch;
end;

tmpBranch.Prev := Last; //список циклический
tmpBranch.Next := First;
tmpBranch.Data := GetData(@item);
First.Prev := tmpBranch;
First := tmpBranch;
inc(Count);
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.Append(const item);
var tmpBranch : PChainRec;
tmpCurrent : PChainRec;
begin
new(tmpBranch);
tmpBranch.Data := GetData(@item);

if FEmptyFlag then
begin
FEmptyFlag := false;
First := tmpBranch;
Last := tmpBranch;
Current := tmpBranch;
end;

tmpCurrent := Last;
tmpCurrent.Next := tmpBranch; //Список циклический
tmpBranch.Prev := tmpCurrent;
inc(Count);
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.Clear;
var tmpBranch : PChainRec;
begin
if FEmptyFlag then Exit;
tmpBranch := First;
while assigned(tmpBranch.Next) do
begin
FreeMem(tmpBranch.Data); tmpBranch.Data := nil;

tmpBranch := tmpBranch.Next;

Dispose(tmpBranch.Prev); tmpBranch.Prev := nil;
// dec(count);
if tmpBranch = Last then
break;
end;
Count := 0;
Current := nil;
FEmptyFlag := true;
First := nil;
Last := nil;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.Delete;
var tmpBranch : PChainRec;
begin
if FEmptyFlag then exit;
if assigned(Current) then
begin
tmpBranch := Current.Next;
Dispose (Current);
Current :=tmpBranch;
dec(Count);
end
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

destructor TChain.Destroy;
begin
Clear();
inherited;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

function TChain.GetCurrent: Pointer;
begin
if not assigned(Current)then
Result := nil
else
Result := Current.Data;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

function TChain.IsEmpty: boolean;
begin
Result := FEmptyFlag;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

function TChain.IsFirst: boolean;
begin
Result := Current = First;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

function TChain.IsLast: boolean;
begin
Result := Current = Last;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.Next;
begin
if not assigned (Current) then
begin
MessageBox (0, "", nil, MB_OK or MB_ICONHAND);
Exit;
end;
if assigned(Current.Next) then
Current := Current.Next;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.Prev;
begin
if not assigned (Current) then
begin
MessageBox (0, "", nil, MB_OK or MB_ICONHAND);
Exit;
end;
if assigned(Current.Prev) then
Current := Current.Prev;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.RememberPos;
begin
OldPosition := Current;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.RestorePos;
begin
Current := OldPosition;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.GoFirst();
begin
Current := First;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

procedure TChain.GoLast();
begin
Current := Last;
end;
//=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*

function TChain.GetData(const item: Pointer): Pointer;

begin
Result := AllocMem(ItemSize);
Move (item^, Result^, ItemSize); // (source, destination, CountBites)
end;

end.

← →
tesseract © (2006-01-04 13:58) [12]

Не нравятся мне вызывы AllocMem и system.Move одновременно. Используй New/Dispose.

А точно нужно получать в GetData новый указатель? Возможны проблемы с утечкой.

← →
begin...end © (2006-01-04 13:59) [13]

> tesseract © (04.01.06 13:50) [9]

И что ужасного в вызове inherited в начале деструктора?

← →
tesseract © (2006-01-04 14:02) [14]

> И что ужасного в вызове inherited в начале деструктора?

Проблема была. С тех пор сначала освободжаю выделенную память до inherited.

← →
Marser © (2006-01-04 14:13) [15]

> И что ужасного в вызове inherited в начале деструктора?

По моему разумению в том, что объект освобождается в inherited destroy, после чего обращение к его полям и методам должно вызвать AV. Или я чего-то не учитываю?

← →
begin...end © (2006-01-04 14:14) [16]

> tesseract © (04.01.06 14:02) [14]

Ничего не понял.

type TAncestor = class FByte: PByte; constructor Create; destructor Destroy; override; end; TDescendant = class(TAncestor) FWord: PWord; constructor Create; destructor Destroy; override; end; { TAncestor } constructor TAncestor.Create; begin New(FByte) end; destructor TAncestor.Destroy; begin Dispose(FByte) end; { TDescendant } constructor TDescendant.Create; begin inherited; New(FWord) end; destructor TDescendant.Destroy; begin inherited; Dispose(FWord) end;

Создаём и уничтожаем экземпляры TDescendant до посинения. Ошибок, вопреки [9], не происходит.

← →
tesseract © (2006-01-04 14:21) [17]

Может и не происходить а может и происходить. Зависит от того сколько и чего освобождаешь. То что этот был косяк практически замечен - факт.

Насчёт AllocMem - ошибался. Он работает в данном контексте.

← →
Игорь Шевченко © (2006-01-04 14:25) [18]

> По моему разумению в том, что объект освобождается в inherited
> destroy, после чего обращение к его полям и методам должно
> вызвать AV. Или я чего-то не учитываю?

Какой объект ?

← →
umbra © (2006-01-04 14:28) [19]

ошибка вылетает где-то в GetMem.inc при освобождении памяти кучи и происходит это после выполнения метода Clear.

← →
begin...end © (2006-01-04 14:30) [20]

> Marser © (04.01.06 14:13) [15]

Объект как экземпляр класса уничтожается после отработки своего деструктора. Вызовы унаследованных деструкторов приводят лишь к исполнению их кода (между begin и end), но не к уничтожению объекта.

Другое дело, что если я вызвал какой-нибудь inherited-деструктор, в котором освободил некий ресурс (например, динамически выделенную память), то дальше я уже не могу этим ресурсом пользоваться. Например, в [16] после вызова унаследованного деструктора из TDescendant.Destroy я не могу обращаться к FByte^, потому что уже было Dispose(FByte), но само поле FByte, конечно, никуда не делось -- экземпляр класса пока не разрушен.

> tesseract © (04.01.06 14:21) [17]
> То что этот был косяк практически замечен - факт.

Косяк был из-за криворукости.

← →
tesseract © (2006-01-04 14:39) [21]

> Косяк был из-за криворукости.

Из-за многопоточности:-) Уничтожался другой объект - критическая секция.Которая кое-где в потоке ещё не сработала.

> ошибка вылетает где-то в GetMem.inc при освобождении памяти
> кучи и происходит это после выполнения метода Clear.

Я про то же.

begin...end © (04.01.06 14:30) [20]

> Объект как экземпляр класса уничтожается после отработки
> своего деструктора

Объект уничтожается процедурой FreeInstance, вызываемой в конце выполнения деструктора, если деструктор вызван явно, а не по inherited.

TObject.Destroy (Self: TObject, NotInherited: Integer);
begin
BeforeDestruction;
if NotInherited > 0 then
_ClassDestroy (Self);
end;

procedure _ClassDestroy (TObject: Instance);
begin
Instance.ClassType.FreeInstance (Instance);
end;

dust © (04.01.06 13:53) [11]
tmpCurrent.Next := tmpBranch; //Список циклический
Да не циклический это список. Это вообще ХЗ что. Last.Next - вообще указывает непонятно на что, потому что ты это поле не инициализируешь. В циклическом списке, последний элемент указывает на первый! Вот и всё. Зачем тебе в ЦИКЛИЧЕСКОМ списке поля First и Last - вообще не понятно. На вскидку - у тебя здесь не доделанный двухсвязный, не циклический список. Кольцом здесь не пахнет. Зачем поле здесь FEmptyFlag - тооже не понятно, нужно заменить его функцией function TChain.IsEmpty: boolean; begin Result := Assigned(First) end;
вобщем скорее всего проблема связана с неинициализацией поля Next твоей записи, разбираться подробнее - лень. Проще написать как должно быть:

procedure TChain.Append(const item); var tmpBranch: PChainRec; begin New(tmpBranch); tmpBranch.Data := GetData(@item); tmpBranch.Prev := Last; tmpBranch.Next := nil; if Assigned(Last) then Last.Next := tmpBranch; Last := tmpBranch; if not Assigned(First) then First := tmpBranch; Inc(Count); end; procedure TChain.Clear; var tmpBranch, nextBranch: PChainRec; begin tmpBranch := First; while Assigned(tmpBranch) do begin nextBranch := tmpBranch.Next; FreeMem(tmpBranch.Data); Dispose(tmpBranch); tmpBranch := nextBranch; end; Count := 0; First := nil; Last := nil; end;

PS названия всех полей должны начинаться в префикса F, а названия типов - в префикса T, а за использование такой конструкции - Chain1 := TChain.Create(1024*16); тебя зарезать тупым ножом мало - только SizeOf и никак иначе.

Так ктонить чтонить понял????? Я лично понять не могу... :(
Я уже дошёл до отладки модуля систем, и лично для меня загадка, почему

procedure _ClassDestroy(Instance: TObject);
begin
Instance.FreeInstance;
end;

вызывает ошибку.... притом такую странную
heapErrorCode := cBadNextBlock;

TChainRec = record
Prev, Next : PChainRec;
Data : Pointer;
end;

Не понял ???

Ссылку на себя через себя? Ты же можешь освободить память чему нибудь другому. Попробуй проверять перед освобождением Assigned.

а зачем метод Clear нужен, если есть несколько недоделанный Delete? Зачем в Clear проверять на Assigned, если есть прекрасное свойство Count?
Вот поправленные Clear и Delete. Ошибка не происходит

procedure TChain.Delete; var tmpBranch : PChainRec; begin if FEmptyFlag then exit; if assigned(Current) then begin tmpBranch := Current.Next; FreeMem(Current.Data); Dispose (Current); Current :=tmpBranch; dec(Count); end end; procedure TChain.Clear; var tmpBranch : PChainRec; begin if FEmptyFlag then Exit; Current := First; while Count > 0 do begin Delete; dec(count); end; FEmptyFlag := true; end;

Пардон, не досмотрел

procedure TChain.Clear; begin if FEmptyFlag then Exit; Current := First; while Count > 0 do Delete; FEmptyFlag := true; end;

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