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

[Ghaydn]

Всем привет.
Долго и старательно гуглил, нигде внятного ответа по Фрипаскалю не нашёл. Есть ответы по Делфи, но об этом позже...
Итак, проблема. Есть класс TFooBar, его экземпляры Foo и Bar. В моём случае они содержат внутри ещё и динамические массивы других определённых тут же классов, но это не меняет сути. Далее:
1. Проделываем всякие операции с Foo;
2. Bar := Foo;
3. Проделываем всякие операции с Bar.
В результате изменяется Foo. Оператор присвоения не создал копию Foo, а просто перевёл указатель Bar на его содержимое. И, как я понял, это норма.
А мне потом понадобятся оба экземпляра, каждый со своими полями. Пока что это пытаюсь решить костылём, через написание функции Clone. Но программа растёт, классов становится всё больше, к ним добавляются предки, родители... К Каждому дописывать по клону? Может быть, я, будучи самоучкой, чего-то не знаю? Как в таких случаях цивилизованные люди поступают?
...Да, на делфи-форумах решение таки есть - через Assign. Но к потомкам TObject оно не применяется, а кто такой TPersistent и зачем он нужен, я чего-то не понял.

[Mirage]

В вашем случае надо искать библиотеку, которая умеет deep copy объектов. Можно и самому с помощью RTTI написать, но раз TPersistent вызывает затруднения, то лучше не надо.

[daesher]

1. Проделываем всякие операции с Foo;
2. Bar := Foo;

С этого момента Bar стал ссылкой на Foo. Синонимом, пока это состояние не изменить.

В вашем случае надо искать библиотеку, которая умеет deep copy объектов. Можно и самому с помощью RTTI написать, но раз TPersistent вызывает затруднения, то лучше не надо.

RTTI.. DeepCopy. Это - низкоуровневый подход. Он может дать отличные результаты, но может привести к побочным эффектам. Есть ещё и правильный высокоуровневый подход

Код: Выделить всё

Bar:=TFooBar.Create;
Bar.Assign(Foo);

Вот это идеологически верно, и должно работать как надо, но будет так работать только если метод Assign правильно расписан и для TFooBar (и тогда он будет правильно уметь копировать указанные Вами динамические массивы), и для всех его значимых предков.

[sign]

Итак, проблема. Есть класс TFooBar, его экземпляры Foo и Bar. В моём случае они содержат внутри ещё и динамические массивы других определённых тут же классов, но это не меняет сути. Далее:
1. Проделываем всякие операции с Foo;

Имеем два разных экземпляра. Foo и Bar

2. Bar := Foo;

Bar, как уже было сказано выше, стал указателем на Foo
А Foo мы совсем потеряли, но сам экземпляр остался в памяти, но доступа к нему у Вас уже нет. Произошла утечка памяти.
Если вы в дальнейшем станете где-то далее освобождать память от экземпляра Bar - Bar.Free, то освободите не Bar, а Foo. Потом, обратившись к Foo получите дулю.

С классами иная работа. Bar и Foo - это указатели на сами экземпляры, а не сами экземпляры класса.
Поэтому, Assign наше всё. Для каждого класса не поленитесь аккуратно прописать Assign, тогда никаких проблем не будет.

[Ghaydn]

Assign

Assign

https://www.freepascal.org/docs-html/rtl/system/assign.html
Я чего-то не понимаю? Это же вообще для работы с файлами.

Для каждого класса не поленитесь аккуратно прописать Assign

НЯП, код должен быть примерно вот такой, как ниже? Ну то есть, если оно будет называться не Assign, а, скажем, Clone, - разницы ведь не будет?
И да, опять же, НЯП: Record'ы этой беде не подвержены, их можно присваивать сколько влезет, каждый раз будет выделяться новая область памяти.

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  TMassiv = class
      XY: Array of TPoint;
      NumXY: Integer;
      function Clone: TMassiv;
      procedure AddXY(X, Y: Integer);
  end;


  function MassivChange(Massiv: TMassiv): TMassiv;

var
  Form1: TForm1;
  Massiv1, Massiv2, Massiv3: TMassiv ;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormClick(Sender: TObject);
begin

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Massiv1 := TMassiv.Create;
  Massiv1.AddXY(20,30);
  Memo1.Lines.Add('1. Первый массив: ' + IntToStr(Massiv1.XY[0].X) + ', ' + IntToStr(Massiv1.XY[0].Y) + ', ' + IntToStr(Massiv1.NumXY));
  Massiv1.NumXY := 46;
  Massiv2 := MassivChange(Massiv1);
  Memo1.Lines.Add('2. Первый массив: ' + IntToStr(Massiv1.XY[0].X) + ', ' + IntToStr(Massiv1.XY[0].Y) + ', ' + IntToStr(Massiv1.NumXY));
  Memo1.Lines.Add('2. Второй массив: ' + IntToStr(Massiv2.XY[0].X) + ', ' + IntToStr(Massiv2.XY[0].Y) + ', ' + IntToStr(Massiv2.NumXY));
  Massiv3 := MassivChange(Massiv2);
  Massiv3.NumXY := 88;
  Memo1.Lines.Add('3. Первый массив: ' + IntToStr(Massiv1.XY[0].X) + ', ' + IntToStr(Massiv1.XY[0].Y) + ', ' + IntToStr(Massiv1.NumXY));
  Memo1.Lines.Add('3. Второй массив: ' + IntToStr(Massiv2.XY[0].X) + ', ' + IntToStr(Massiv2.XY[0].Y) + ', ' + IntToStr(Massiv2.NumXY));
  Memo1.Lines.Add('3. Третий массив: ' + IntToStr(Massiv3.XY[0].X) + ', ' + IntToStr(Massiv3.XY[0].Y) + ', ' + IntToStr(Massiv3.NumXY));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

procedure TMassiv.AddXY(X, Y: Integer);
begin
   SetLength(XY, NumXY + 1);
   XY[NumXY].X := X;
   XY[NumXY].Y := Y;
   NumXY := NumXY + 1;
end;

function TMassiv.Clone: TMassiv;
begin
   Clone := TMassiv.Create;
   Clone.XY := copy(XY);
   Clone.NumXY := NumXY;
end;

function MassivChange(Massiv: TMassiv): TMassiv;
begin
   MassivChange := Massiv.Clone;
   MassivChange.XY[0].X := Massiv.XY[0].X + 1;
   MassivChange.XY[0].Y := Massiv.XY[0].Y + 1;
end;

end.

Я сначала думал, что это велосипед на костыльной тяге. Но теперь меня терзают смутные сомнения, что именно так поступить и было нужно. Но напрягает вот что в таком подходе. Если я, скажем, напишу что-то типа Massiv1 := MassivChange(massiv1), то произойдёт утечка памяти (произойдёт ведь?). И вот как эту проблему обойти, что-то не очень понимаю. Что-то в теле функции хитрое прописать, нутром чую, а объяснить не могу.

[pupsik]

Добавить MassivOsnova. И в функции (процедуре) MassivChange(Massiv: TMassiv) заполнять его из требуемого.
Или хранить ваш объект в массиве. Т.е. array of TMassiv. И по индексу работать.

Я бы воспользовался TMyList = specialize TFPGObjectList<TMassiv>. Что бы не мудрить с обработкой.

[runewalsh]

Пиши свой Clone, в общем случае копирование может включать произвольно сложную логику (например, если есть поле TStream, его придётся переоткрыть или как-то по-другому это учесть) и другими способами не разрулится. С Assign (не тот Assign, а TPersistent.Assign) будет то же самое, он никакой магии не делает, разве что в библиотечных наследниках TPersistent прописан за тебя.

Есть смысл сделать публичный Clone и под капотом виртуальную CloneTo(target), чтобы работало с inherited:

Код: Выделить всё

type
   TBase = class
      function Clone: TObject;
   protected
      procedure CloneTo(target: TObject); virtual; abstract;
   end;

   TA = class(TBase)
      a: integer;
   protected
      procedure CloneTo(target: TObject); override;
   end;

   TB = class(TA)
      b: string;
   protected
      procedure CloneTo(target: TObject); override;
   end;

   function TBase.Clone: TObject;
   begin
      result := self.NewInstance;
      CloneTo(result);
   end;

   procedure TA.CloneTo(target: TObject);
   begin
      TA(target).a := self.a;
   end;

   procedure TB.CloneTo(target: TObject);
   begin
      inherited CloneTo(target);
      TB(target).b := self.b;
   end;

Правда, в моём варианте нужны приведения типов в реализациях CloneTo и при вызовах Clone :(

Собственно, такая CloneTo — эквивалент TPersistent.Assign, только аргументы местами изменены, т. е. a.CloneTo(b) в стиле Assign будет b.Assign(a), ну это по вкусу, можно и как в Assign сделать, чтобы не путаться.

>то произойдёт утечка памяти (произойдёт ведь?)
У тебя в коде и намёков на Free нет, чтобы задумываться о каких-то частных случаях. Включи в параметрах компиляции «-gh Использовать модуль heaptrc» и наслаждайся.

[pupsik]

упс: поздно заметил function Clone: TMassiv;...
Возник несколько наивный вопрос: зачем всё это?
Вы уверены что данная структура необходима?

п.с.

Т.е. я не уверен что для "старта" необходимо лезть в дебри. Вывод из "а кто такой TPersistent и зачем он нужен" и "Вообще, программа на данный момент является скорее тренировкой для ума, нежели чем-то прикладно-полезным.".

Кстати: "Как в таких случаях цивилизованные люди поступают?". Ответ: расширят свои знания за счёт чтения и постепенного понимания того что творишь.

[Ghaydn]

Т.е. я не уверен что для "старта" необходимо лезть в дебри. Вывод из

Так-то вывод верный. Программированием я занимаюсь набегами раз в год недели по две уже лет 15, а таких элементарных вещей не знаю. Каждый раз что-то новое по чуть-чуть узнаю. Вот добрался наконец-то до классов. Раньше максимум разве что записями баловался.

У тебя в коде и намёков на Free нет

Всё верно, в конце Button1Click прописываю: Massiv1.Free; Massiv2.Free; Massiv3.Free; и всё нормально, ничего не утекает.
Теперь добавляем где-то выше в теле баттон1клика: Massiv1 := MassivChange(Massiv1); - с каждым нажатием кнопки где-то заплачет один утёкший массив.
Вот тут моя логика пасует. В начале ченджа необходимо создать новый TMassiv, чтобы не менять старый. Но в конце нельзя просто так взять и отпустить. Если я там напишу Massiv.Free, то при Massiv2 := MassivChange(Massiv1) будет освобождаться Massiv1, а он ведь ещё нужен.
Метод чтения и постепенного понимания тут не работает, так как не очень понятно, что именно читать.

Вы уверены что данная структура необходима?

Окей, попробую более-менее внятно описать, что же у меня в реальном проекте происходит. Пример с массивами - это просто попытка разобраться в логике классов, проделывая то же самое, что приходится совершать на практике.
Есть рекорд TFloatPoint - это такой же TPoint, только X и Y у него типа Real. Есть класс TLine, внутри него массив из TFloatPoint'ов и несколько полей, описывающих её всякие качества (ну там, является ли это линией Безье, заливать ли её, вообще какого она цвета). Есть класс TVectorImage, внутри него массив из TLine'ов и тоже несколько вспомогательных полей попроще.
А к ним прилагается набор функций трансляции: сдвиг, поворот, масштабирование. Трансляция линии перебирает все точки и транслирует их. Трансляция картинки перебирает все линии и транслирует их. Всё это нужно в первую очередь чтобы отрисовывать такие вот картинки, а впоследствии их ещё и анимировать; ну и там мало ли для чего ещё трансляции пригодятся. И ещё есть функции TLine.AddPoint и TVectorImage.AddLine - понятно, думаю, для чего.

[runewalsh]

Ну естественно, ведь MassivChange создаёт новый объект и ничего не делает со старым, так что 1) вызывающий должен будет освободить оба (когда именно — его дело), 2) A := MassivChange(A) делать нельзя, не имея других ссылок на A.

TPoint и т. п. лучше сделать record'ами/object'ами, как раз чтобы не возиться с ручным управлением памятью.

[sign]

Есть рекорд TFloatPoint - это такой же TPoint, только X и Y у него типа Real. Есть класс TLine, внутри него массив из TFloatPoint'ов и несколько полей, описывающих её всякие качества (ну там, является ли это линией Безье, заливать ли её, вообще какого она цвета). Есть класс TVectorImage, внутри него массив из TLine'ов и тоже несколько вспомогательных полей попроще.
А к ним прилагается набор функций трансляции: сдвиг, поворот, масштабирование. Трансляция линии перебирает все точки и транслирует их. Трансляция картинки перебирает все линии и транслирует их. Всё это нужно в первую очередь чтобы отрисовывать такие вот картинки, а впоследствии их ещё и анимировать; ну и там мало ли для чего ещё трансляции пригодятся. И ещё есть функции TLine.AddPoint и TVectorImage.AddLine - понятно, думаю, для чего.

Всё придумано до нас.

Код: Выделить всё

unit Types; 
...
  { TPointF }
  TPointF =
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
  packed
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
  record
       x,y : Single;
       public
          function Add(const apt: TPoint): TPointF;
          function Add(const apt: TPointF): TPointF;
          function Distance(const apt : TPointF) : Single;
          function DotProduct(const apt : TPointF) : Single;
          function IsZero : Boolean;
          function Subtract(const apt : TPointF): TPointF;
          function Subtract(const apt : TPoint): TPointF;
          procedure SetLocation(const apt :TPointF);
          procedure SetLocation(const apt :TPoint);
          procedure SetLocation(ax,ay : Longint);
          procedure Offset(const apt :TPointF);
          procedure Offset(const apt :TPoint);
          procedure Offset(dx,dy : Longint);

          function  Scale (afactor:Single)  : TPointF;
          function  Ceiling : TPoint;
          function  Truncate: TPoint;
          function  Floor   : TPoint;
          function  Round   : TPoint;
          function  Length  : Single;
          class operator = (const apt1, apt2 : TPointF) : Boolean;
          class operator <> (const apt1, apt2 : TPointF): Boolean;
          class operator + (const apt1, apt2 : TPointF): TPointF;
          class operator - (const apt1, apt2 : TPointF): TPointF;
          class operator - (const apt1 : TPointF): TPointF;
          class operator * (const apt1, apt2: TPointF): Single; // scalar product
          class operator * (const apt1: TPointF; afactor: single): TPointF;
          class operator * (afactor: single; const apt1: TPointF): TPointF;
       end;
  { TRectF }   

и т.д.

[Ghaydn]

Всё придумано до нас.

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

КОД

И вот тут я выпадаю в некоторый осадок, ибо раньше был уверен, что рекорды от классов как раз тем и отличаются, что первым нельзя прописывать методы, а вторым можно.

Кстати. Что-то вот не получается у меня найти TPointF. В модуле Types его нет. Существует некоторая вероятность, что это Лазарь у меня криво установлен. Однако из-за этого могут отсутствовать некоторые файлы, но не куски файлов же.

[pupsik]

В модуле Types его нет.

В лазарус 1.8 есть. Это релиз с сайта лазаря. Если быть точнее: "fpc\3.0.4\source\rtl\objpas\types.pp"

[Ghaydn]

Так и знал, что будут какие-то проблемы из-за устаревшего Лазаря.
На 17.3 минт почему-то упорно не встаёт версия 1.8. Сначала мне подсовывал 1.4, потом я поставил репозиторий, но и оттуда выкачался только 1.6. Какие-то библиотеки в системе ему не нравятся, видимо.
Ну, значит буду собирать актуального Лазаря из сырцов и смотреть, что там и как по сравнению с 1.6.

[pupsik]

а пакеты скачать для минта не вариант? По идее деб файл с оф сайта.