Клонирование объектов

← →
Омлет © (2012-07-10 13:26) [0]

Почему этого нет в Delphi?
Надоело вылавливать баги из-за недоделанных Assign-методов :(

← →
icelex © (2012-07-10 13:32) [1]

отож и рефлексии :(

← →
Компромисс © (2012-07-10 13:35) [2]

> Почему этого нет в Delphi?

Из-за отсутствия автоматического управления памятью, наверное.
Разве нельзя написать свой метод clone() или deepClone()?

← →
Омлет © (2012-07-10 13:43) [3]

> Разве нельзя написать свой метод clone() или deepClone()?

Через RTTI?

← →
Компромисс © (2012-07-10 13:54) [4]

Омлет © (10.07.12 13:43) [3]

Почему обязательно одну реализацию для всех классов и через RTTI? Можно написать вручную
Result := TMyClass.Create();
Result.MyField1 := Self.MyField1;
Result.MyField2 := Self.MyField2;

← →
Омлет © (2012-07-10 13:57) [5]

> Компромисс © (10.07.12 13:54) [4]

Хочется универсальное клонирование для произвольного объекта. Доступа к исходникам (т.е. к приватным полям) может и не быть.
[1] > Надоело вылавливать баги из-за недоделанных Assign-методов :(

← →
DevilDevil © (2012-07-10 14:03) [6]

{$ifdef fpc} Function fpc_Copy_internal (Src, Dest, TypeInfo : Pointer) : SizeInt;[external name "FPC_COPY"]; procedure CopyRecord(const dest, source, typeinfo: ptypeinfo); asm {внимание! очень плохо работает в FPC !!!} xchg eax, edx jmp fpc_Copy_internal end; {$else} procedure CopyRecord(dest, source, typeinfo: pointer); asm jmp System.@CopyRecord end; {$endif} procedure CopyObject(const Dest, Src: TObject); var InitTable: pointer; BaseSize, DestSize: integer; BaseClass, DestClass, SrcClass: TClass; begin if (Dest = nil) or (Src = nil) then exit; {по идее эксепшн} DestClass := TClass(pointer(Dest)^); SrcClass := TClass(pointer(Src)^); if (DestClass = SrcClass) then BaseClass := DestClass else if (DestClass.InheritsFrom(SrcClass)) then BaseClass := SrcClass else if (SrcClass.InheritsFrom(DestClass)) then BaseClass := DestClass else begin BaseClass := DestClass; while (BaseClass <> nil) and (not SrcClass.InheritsFrom(BaseClass)) do begin BaseClass := BaseClass.ClassParent; end; if (BaseClass = nil) then exit; {но такого не должно быть} end; // копирование DestSize := BaseClass.InstanceSize; while (BaseClass <> TObject) do begin InitTable := PPointer(Integer(BaseClass) + vmtInitTable)^; if (InitTable <> nil) then begin CopyRecord(pointer(Dest), pointer(Src), InitTable); break; end; BaseClass := BaseClass.ClassParent; end; BaseSize := BaseClass.InstanceSize; if (BaseSize <> DestSize) then Move(pointer(integer(Src)+BaseSize)^, pointer(integer(Dest)+BaseSize)^, DestSize-BaseSize); end;

← →
DevilDevil © (2012-07-10 14:13) [7]

Соответственно CloneObject будет типа такого

function CloneObject(const Src: TObject): TObject; var InitTable: pointer; BaseSize, DestSize: integer; BaseClass: TClass; Dest: pointer; begin if (Src = nil) then begin Result := nil; exit; end; BaseClass := TClass(pointer(Src)^); DestSize := BaseClass.NewInstance(); GetMem(Dest, DestSize); ZeroMemory(Dest, DestSize); TClass(Dest^) := BaseClass; Result := TObject(Dest); // копирование DestSize := BaseClass.InstanceSize; while (BaseClass <> TObject) do begin InitTable := PPointer(Integer(BaseClass) + vmtInitTable)^; if (InitTable <> nil) then begin CopyRecord(pointer(Dest), pointer(Src), InitTable); break; end; BaseClass := BaseClass.ClassParent; end; BaseSize := BaseClass.InstanceSize; if (BaseSize <> DestSize) then Move(pointer(integer(Src)+BaseSize)^, pointer(integer(Dest)+BaseSize)^, DestSize-BaseSize); end;

← →
DevilDevil © (2012-07-10 14:14) [8]

сори, очепятка

function CloneObject(const Src: TObject): TObject; var InitTable: pointer; BaseSize, DestSize: integer; BaseClass: TClass; Dest: pointer; begin if (Src = nil) then begin Result := nil; exit; end; BaseClass := TClass(pointer(Src)^); DestSize := BaseClass.InstanceSize; GetMem(Dest, DestSize); ZeroMemory(Dest, DestSize); TClass(Dest^) := BaseClass; Result := TObject(Dest); // копирование while (BaseClass <> TObject) do begin InitTable := PPointer(Integer(BaseClass) + vmtInitTable)^; if (InitTable <> nil) then begin CopyRecord(pointer(Dest), pointer(Src), InitTable); break; end; BaseClass := BaseClass.ClassParent; end; BaseSize := BaseClass.InstanceSize; if (BaseSize <> DestSize) then Move(pointer(integer(Src)+BaseSize)^, pointer(integer(Dest)+BaseSize)^, DestSize-BaseSize); end;

← →
Омлет © (2012-07-10 14:16) [9]

> DevilDevil ©

Интересно, спасибо!
Вроде работает, потестирую на досуге.

← →
Sapersky (2012-07-10 14:23) [10]

Ну если устраивает, что вложенные объекты и не-managed указатели скопируются как ссылки... (Assign вроде как подразумевает создание копий?)

← →
Омлет © (2012-07-10 14:25) [11]

> Sapersky (10.07.12 14:23) [10]

А вот об этом не подумал :(

> Омлет © (10.07.12 14:16) [9]

ага. скажи потом чё как.
потестируй на разных объектах (как сложных так и простых)
мож чё-то не скопируется

> Ну если устраивает, что вложенные объекты и не-managed указатели
> скопируются как ссылки... (Assign вроде как подразумевает
> создание копий?)

Все сложные типы (строки, варианты, динамические массивы, интерфейсы) - таким образом скопируются по правильному

> DevilDevil © (10.07.12 14:28) [13]
> Все сложные типы (строки, варианты, динамические массивы, интерфейсы) - таким образом скопируются по правильному

Но остается проблема с вложенными объектами..

ну значит допиливай функционал дополнительной "копией" вложенных объектов
иначе никак

* у меня в классе многие экземпляры класса - ссылки. Другим способом особо как-то копировать не приходилось

Омлет © (10.07.12 13:57) [5]

Если нет доступа к приватным полям, возможно, класс не поддерживает клонирование. В java CloneNotSupportedException как раз для таких случаев. То есть можно извратиться и скопировать/клонировать все поля, но в итоге объект может оказаться некорректным. Например, если у него ссылка на синглтон в каком-то поле.

Клонирование объектов Найти похожие ветки