duplicate an Object at run-time at its base class and call the constructor

[jamie]

Like it states there.

I need to duplicate an object at its base CLASS and call the constructor of the "ClassType"!

I can do that and the object gets created with the descendant classes and the overloads do get executed however,
I cannot get the constructor to execute at the top level; it only wants to execute starting at the base class.

I have a BASE class that is a proxy to all the descendant classes and these are all linked via virtual overrides so that all functions reach these
descendant's functions.

 The DUP function needs to recreate the class with its Descendants at the base class, and it does that.

 I've used the CLASSTYPE.Create, CLASSTYPE.Newinstance with the Initinstance etc, all work and when I execute the Assign override that also goes to the descendant class but none of the dynamic items have been created because the I can't get the top-level constructor to call.

 

Code: Pascal  [Select][+][-]

1.  
2.   Result :=TbaseObject(ClassType.NewInstance);
3.    Result :=TbaseObject(ClassType.InitInstance(Result));
4.    Result :=TBaseObject(Result).Create(Parent);
5.    Result.Assign(self);                                      
6.  

Only the TbaseObject.Constructor gets called when I do this, It will not start at the top.

Any Ideas?

Jamie

[Thaddy]

Code: Pascal  [Select][+][-]

1. // The classic solution
2. {$mode objfpc}
3. uses classes;
4. function Factory(const value:TClass):TObject;
5. begin
6.   Result := Value.Create;
7. end;
8.  
9. var
10.   l,S:TStringlist;
11. begin
12.   L := Factory(TStringlist) as TStringlist;
13.   L.Add('Test');
14.   S := Factory(L.Classtype) as TStringlist;
15.   S.Assign(L);
16.   Writeln(S.Text);
17.   L.Free;S.Free;
18. end.

Classtype is of type TClass so can be used above. It will not copy any contained data.
But it will create a class instance of a class type (any instance of any class wth a single constructor)
In your own hierarchy you can use:

Code: Pascal  [Select][+][-]

1. type TBaseClass = class of TBase;
2. function BaseFactory(const value:TBaseClass):TBase;

The RTTI generated is also from the real class type even if instantiated to TObject, the RTTI reveals the underlying class. Hence use the runtime softcasts As and Is. Content copy can be made with assign.

Your code was close.

If your base class has constructor with parameters and the derived classes have the same parameters, the second example can use parameterized constructors in the Factory function.

Code: Pascal  [Select][+][-]

1. // The classic solution 2.
2. {$mode delphi}
3. uses classes;
4. type
5.   TBase = class(Tpersistent) // for Assign
6.   Public
7.     constructor create(const value:string);virtual;
8.   end;
9.  
10.   TDerived = class(TBase)
11.   Public
12.     constructor create(const value:string);override;
13.   end;
14.  
15.   TBaseClass = class of TBase;
16.   TDerivedClass = class of TDerived;
17.  
18. constructor TBase.Create(const value:string);
19. begin
20.   inherited create;
21. end;
22.  
23. constructor TDerived.Create(const value:string);
24. begin
25.   inherited create(value);
26.   writeln(value);
27. end;
28.  
29. function Factory(const value:TBaseClass;param:string):TBase;
30. begin
31.   Result := Value.Create(param);
32. end;
33.  
34. var
35.   l,S:TDerived;
36. begin
37.   L := Factory(TDerived,'L') as TDerived;
38.   // must hardcast to accept TBaseClass instead of TClass: this is a quirk.
39.   S := Factory(TBaseClass(L.Classtype),'S') as TDerived;
40.   L.Free;S.Free;
41. end.

This is how it was done without interfaces or generics.
Last note: If you want to use TSomeClass.Assign, the root must derive from TPersistent AND you must implement and override Assign. Someting like so:

Code: Pascal  [Select][+][-]

1. procedure TBase.Assign(value:TPersistent);
2. begin
3.   if value is Tbase then
4.   begin
5.   // copy all fields with assignment operator :=
6.   // this ensures refcount on managed objects is correct.
7.   // don't use simply move. See example in TStrings sourcecode
8.   end
9.   else
10.     inherited Assign(Value);
11. end;

[marcov]

Is your baseobject constructor virtual ?

[Thaddy]

No. It is the non-virtual inherited create from TObject. But in the second example the constructor is virtual.

[marcov]

No. It is the non-virtual inherited create from TObject. But in the second example the constructor is virtual.

See also https://stackoverflow.com/questions/4041760/correct-way-to-duplicate-delphi-object/4041906#4041906

[Thaddy]

Basically the same. I took as example the TStrings.Assign.
Here's the example 3 after all remarks:

Code: Pascal  [Select][+][-]

1. // The classic solution 3.
2. {$mode delphi}
3. uses classes;
4. type
5.  
6.   TBase = class(Tpersistent)
7.   private
8.     AField1:string;
9.     AField2:integer;
10.   Public
11.     constructor create(const value:string);virtual;
12.     procedure Assign(value:TPersistent);override;
13.     property Field1:string read AField1 write AField1;
14.     property Field2:integer read AField2 write AField2;
15.   end;
16.  
17.   TDerived = class(TBase)
18.   Public
19.     constructor create(const value:string);override;
20.   end;
21.  
22.   TBaseClass = class of TBase;
23.   TDerivedClass = class of TDerived;
24.  
25.  
26. constructor TBase.Create(const value:string);
27. begin
28.   inherited create;
29.   AField1 := 'Something';
30.   AField2 := 100;
31. end;
32.  
33. procedure TBase.Assign(value:TPersistent);
34. begin
35.   if value is TBase then
36.   begin
37.     // copy all fields with assignment operator :=
38.     // this ensures refcount on managed objects is correct.
39.     // don't use simply move. See example in TStrings code
40.     AField1 := TBase(Value).AField1;
41.     AField2 := TBase(Value).AField2;
42.   end
43.   else
44.     inherited Assign(Value);
45. end;
46.  
47. constructor TDerived.Create(const value:string);
48. begin
49.   inherited create(value);
50.   writeln(value);
51. end;
52.  
53. function Factory(const value:TBaseClass;param:string):TBase;
54. begin
55.   Result := Value.Create(param);
56. end;
57.  
58. var
59.   l,S:TDerived;
60. begin
61.   L := Factory(TDerived,'L') as TDerived;
62.   // must hardcast since otherwise it complains. This is a known quirk of old school.
63.   S := Factory(TBaseClass(L.Classtype),'S') as TDerived;
64.   S.AField1 := 'Something different'; // after assign, will be 'Something'
65.   S.Assign(L);
66.   writeln(S.Field1,S.Field2:4);
67.   L.Free;S.Free;
68. end.

You should be able to use that pattern for your original question and it is pure, classic Object Pascal.

[jamie]

I figured out something.

It appears that only matching constructors will get called which I guess makes sense, So I may need to move the initial code in the same matching constructor at the top level and have non-matching constructors call the matching constructors since I do have additional constructors at the top with optional parameters.

 Those parameters I don't need to recreate but it looks like I need to reorder the way it's done. Type info at the top levels works fine for this but I need to move some things around so the matching constructors will get called which is fine because all the extra parameters are already known within the Class I am duplicating.

Below is a working simple example for others using matching constructors.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls;
9.  
10. type
11.  
12.   { Tbase }
13.  
14.   Tbase = class
15.     constructor Create(aValue: integer); virtual;
16.   public
17.     function dup: Tbase;
18.   private
19.     Fvalue: integer;
20.   end;
21.  
22.   { Tmain }
23.   Tmain = class(TBase)
24.     constructor Create(aValue: integer); override;
25.   end;
26.  
27.   { TForm1 }
28.  
29.   TForm1 = class(TForm)
30.     Button1: TButton;
31.     procedure Button1Click(Sender: TObject);
32.     procedure FormCreate(Sender: TObject);
33.     procedure FormDestroy(Sender: TObject);
34.   private
35.  
36.   public
37.     test: TMain;
38.   end;
39.  
40. var
41.   Form1: TForm1;
42.  
43. implementation
44.  
45. {$R *.lfm}
46.  
47. { Tbase }
48.  
49. constructor Tbase.Create(aValue: integer);
50. begin
51.   inherited Create;
52.   Fvalue := aValue;
53. end;
54.  
55. function Tbase.dup: Tbase;
56. begin
57.   Result := Tbase(ClassType.Create);
58.   Result.Create(fvalue);
59. end;
60.  
61. { Tmain }
62.  
63. constructor Tmain.Create(aValue: integer);
64. begin
65.   inherited Create(AValue);
66.   beep;
67. end;
68.  
69. { TForm1 }
70.  
71. procedure TForm1.FormCreate(Sender: TObject);
72. begin
73.   test := Tmain.Create(1);
74. end;
75.  
76. procedure TForm1.FormDestroy(Sender: TObject);
77. begin
78.   Test.Free;
79. end;
80.  
81. procedure TForm1.Button1Click(Sender: TObject);
82. var
83.   Main: Tmain;
84. begin
85.   Main := Tmain(Test.Dup);
86.   Main.Free;
87. end;
88.  
89. end.
90.  

Jamie

[Thaddy]

Yes, but that is compile time, not runtime, which you asked. A factory function can do just that.
It is TClass vs TObject. See example 3 that is pretty complete. You can add multiple constructors, btw, as long as they make sense for all derived classes.
It looks like much work, but you only have to do that for the base class and keep in mind the old school syntax.