Recent

Author Topic: Extrange behavior using Class of. What am I doing wwrong?  (Read 483 times)

garlar27

  • Hero Member
  • *****
  • Posts: 616
Extrange behavior using Class of. What am I doing wwrong?
« on: September 18, 2019, 01:16:43 am »
Playing with some code I stumble with something I didn't expected:

start a new project place 2 buttons and a memo. Then paste this code:
Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, fpjson, fpjsonrtti;
  9.  
  10. type
  11.  
  12.    { TForm1 }
  13.  
  14.    TForm1 = class(TForm)
  15.       Button1: TButton;
  16.       Button2: TButton;
  17.       Memo1: TMemo;
  18.       procedure Button1Click(Sender: TObject);
  19.       procedure Button2Click(Sender: TObject);
  20.    private
  21.  
  22.    public
  23.  
  24.    end;
  25.  
  26. var
  27.    Form1: TForm1;
  28.  
  29.  
  30. function PersistentToJSONStr(const TheObj: TPersistent; const SingleLine: Boolean = FALSE; const IndentSize: Integer = 3): TJSONStringType;
  31.  
  32. implementation
  33.  
  34. {$R *.lfm}
  35.  
  36. type
  37.    { TBasicWork }
  38.  
  39.    TBasicWork = Class(TPersistent)
  40.    private
  41.       FWorkName_1: string;
  42.    public
  43.       constructor Create;
  44.    published
  45.       property WorkName_1: string read FWorkName_1 write FWorkName_1;
  46.    end;
  47.    TBasicWorkClass = class of TBasicWork;
  48.  
  49.    { TMyWork }
  50.  
  51.    TMyWork = class(TBasicWork)
  52.    public
  53.       constructor Create;
  54.    end;
  55.  
  56.    { TBasicWork2 }
  57.  
  58.    TBasicWork2 = Class(TPersistent)
  59.    private
  60.       FWorkName_2: string;
  61.    public
  62.       constructor Create;
  63.    published
  64.       property WorkName_2: string read FWorkName_2 write FWorkName_2;
  65.    end;
  66.    TBasicWork2Class = class of TBasicWork2;
  67.  
  68.    { TMyWork2 }
  69.  
  70.    TMyWork2 = class(TBasicWork2)
  71.    public
  72.       constructor Create;
  73.    end;
  74.  
  75.  
  76.    { TBasicWork3 }
  77.  
  78.    TBasicWork3 = Class(TPersistent)
  79.    private
  80.       FWorkName_3: string;
  81.    public
  82.       constructor Create; virtual;
  83.    published
  84.       property WorkName_3: string read FWorkName_3 write FWorkName_3;
  85.    end;
  86.    TBasicWork3Class = class of TBasicWork3;
  87.  
  88.  
  89.    { TMyWork3 }
  90.  
  91.    TMyWork3 = class(TBasicWork3)
  92.    public
  93.       constructor Create; override;
  94.    end;
  95.  
  96. { TBasicWork }
  97.  
  98. constructor TBasicWork.Create;
  99. begin
  100.    WorkName_1 := '';
  101. end;
  102.  
  103. { TMyWork }
  104.  
  105. constructor TMyWork.Create;
  106. begin
  107.    WorkName_1 := 'MyWork';
  108. end;
  109.  
  110.  
  111. { TBasicWork2 }
  112.  
  113. constructor TBasicWork2.Create;
  114. begin
  115.    inherited Create;
  116.    WorkName_2 := '';
  117. end;
  118.  
  119. { TMyWork2 }
  120.  
  121. constructor TMyWork2.Create;
  122. begin
  123.    inherited Create;
  124.    WorkName_2 := 'MyWork2';
  125. end;
  126.  
  127. { TBasicWork3 }
  128.  
  129. constructor TBasicWork3.Create;
  130. begin
  131.    inherited Create;
  132.    WorkName_3 := '';
  133. end;
  134.  
  135. { TMyWork3 }
  136.  
  137. constructor TMyWork3.Create;
  138. begin
  139.    inherited Create;
  140.    WorkName_3 := 'MyWork3';
  141. end;
  142.  
  143.  
  144.  
  145. function PersistentToJSONStr(const TheObj: TPersistent; const SingleLine: Boolean; const IndentSize: Integer): TJSONStringType;
  146. var
  147.    JObj: TJSONObject;
  148.    FJStreamer: TJSONStreamer;
  149. begin
  150.    Result := '';
  151.    FJStreamer := nil;
  152.    JObj       := nil;
  153.    FJStreamer := TJSONStreamer.Create(nil);
  154.    try
  155.       //   CONFIGURACIONES PARA EL STREAMER DE JSON   //
  156.       //FJStreamer.ComponentStyle := [
  157.       //                              csInheritable
  158.       //                             //,csCheckPropAvail
  159.       //                             ,csSubComponent
  160.       //                             //,csTransient
  161.       //                             ];
  162.       //FJsonFormatOptions := [foSingleLineArray   // Array without CR/LF : all on one line
  163.       //                      ,foSingleLineObject  // Object without CR/LF : all on one line
  164.       //                      ,foDoNotQuoteMembers // Do not quote object member names.
  165.       //                      ,foUseTabchar        // Use tab characters instead of spaces.
  166.       //                      ,foSkipWhiteSpace    // Do not use whitespace at all
  167.       //                      ];
  168.  
  169.       FJStreamer.DateTimeFormat := 'YYYY-MM-DDTHH:NN:SS.ZZZ';
  170.       FJStreamer.Options := FJStreamer.Options + [jsoComponentsInline       // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
  171.                                                  ,jsoDateTimeAsString       // Format a TDateTime value as a string
  172.                                                  ];
  173.       //FJStreamer.Options := [
  174.       //                       jsoStreamChildren         // If set, children will be streamed in 'Children' Property
  175.       //                      //,jsoEnumeratedAsInteger    // Write enumerated as Integer. Default is string.
  176.       //                      ,jsoSetAsString            // Write Set as a string. Default is an array.
  177.       //                      //,jsoSetEnumeratedAsInteger // Write enumerateds in set array as integers.
  178.       //                      ,jsoSetBrackets            // Use brackets when creating set as array
  179.       //                      ,jsoComponentsInline       // Always stream components inline. Default is to stream name, unless csSubcomponent in ComponentStyle
  180.       //                      ,jsoTStringsAsArray        // Stream TStrings as an array of strings. Associated objects are not streamed.
  181.       //                      //,jsoTStringsAsObject       // Stream TStrings as an object : string = { object }
  182.       //                      ,jsoDateTimeAsString       // Format a TDateTime value as a string
  183.       //                      ,jsoUseFormatString        // Use FormatString when creating JSON strings.
  184.       //                      ,jsoCheckEmptyDateTime     // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
  185.       //                      ];
  186.       if SingleLine then begin
  187.          Result := FJStreamer.ObjectToJSONString(TheObj);
  188.          end
  189.       else begin
  190.          JObj := FJStreamer.ObjectToJSON(TheObj);
  191.          Result := JObj.FormatJSON(DefaultFormat, IndentSize);
  192.       end;
  193.    finally
  194.       FreeAndNil(JObj      );
  195.       FreeAndNil(FJStreamer);
  196.    end;
  197. end; {<--- PersistentToJSONStr }
  198.  
  199.  
  200.  
  201. function GetBasicWorkJsonStr(const AClass: TBasicWorkClass): string;
  202. var
  203.    AnObj: TBasicWork;
  204. begin
  205.    Result := '';
  206.    AnObj := AClass.Create;
  207.    try
  208.       Result := PersistentToJSONStr(AnObj, TRUE);
  209.    finally
  210.       FreeAndNil(AnObj);
  211.    end;
  212. end;
  213.  
  214.  
  215.  
  216. function GetBasicWork2JsonStr(const AClass: TBasicWork2Class): string;
  217. var
  218.    AnObj: TBasicWork2;
  219. begin
  220.    Result := '';
  221.    AnObj := AClass.Create;
  222.    try
  223.       Result := PersistentToJSONStr(AnObj, TRUE);
  224.    finally
  225.       FreeAndNil(AnObj);
  226.    end;
  227. end;
  228.  
  229.  
  230.  
  231. function GetBasicWork3JsonStr(const AClass: TBasicWork3Class): string;
  232. var
  233.    AnObj: TBasicWork3;
  234. begin
  235.    Result := '';
  236.    AnObj := AClass.Create;
  237.    try
  238.       Result := PersistentToJSONStr(AnObj, TRUE);
  239.    finally
  240.       FreeAndNil(AnObj);
  241.    end;
  242. end;
  243.  
  244.  
  245.  
  246. { TForm1 }
  247.  
  248. procedure TForm1.Button1Click(Sender: TObject);
  249. var
  250.    AnObj: TMyWork;
  251.    AnObj2: TMyWork2;
  252.    AnObj3: TMyWork3;
  253. begin
  254.    AnObj := TMyWork.Create;
  255.    AnObj2 := TMyWork2.Create;
  256.    AnObj3 := TMyWork3.Create;
  257.    try
  258.       Memo1.Lines.Add(PersistentToJSONStr(AnObj, TRUE));
  259.       Memo1.Lines.Add(PersistentToJSONStr(AnObj2, TRUE));
  260.       Memo1.Lines.Add(PersistentToJSONStr(AnObj3, TRUE));
  261.    finally
  262.       FreeAndNil(AnObj);
  263.       FreeAndNil(AnObj2);
  264.       FreeAndNil(AnObj3);
  265.    end;
  266. end;
  267.  
  268. procedure TForm1.Button2Click(Sender: TObject);
  269. begin
  270.    Memo1.Lines.Add(GetBasicWorkJsonStr(TMyWork));
  271.    Memo1.Lines.Add(GetBasicWork2JsonStr(TMyWork2));
  272.    Memo1.Lines.Add(GetBasicWork3JsonStr(TMyWork3));
  273. end;
  274.  
  275.  
  276. end.
  277.  

Press button1 and then press button2 you will have this output:
Quote
{ "WorkName_1" : "MyWork" }
{ "WorkName_2" : "MyWork2" }
{ "WorkName_3" : "MyWork3" }
{ "WorkName_1" : "" }
{ "WorkName_2" : "" }
{ "WorkName_3" : "MyWork3" }
Why does this happens ?

PascalDragon

  • Hero Member
  • *****
  • Posts: 617
  • Compiler Developer
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #1 on: September 18, 2019, 09:16:32 am »
The constructors of your TBasicWork and TBasicWork2 are not declared as virtual (and the corresponding ones in TMyWork and TMyWork2 not as override). Thus your .Create calls in your GetBasicWork*JsonStr methods will execute the TBasicWork* constructor, not the TMyWork* one. TBasicWork3 and TMyWork3 are declared correctly and thus behave as you intend it.

garlar27

  • Hero Member
  • *****
  • Posts: 616
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #2 on: September 18, 2019, 03:52:22 pm »
The constructors of your TBasicWork and TBasicWork2 are not declared as virtual (and the corresponding ones in TMyWork and TMyWork2 not as override). Thus your .Create calls in your GetBasicWork*JsonStr methods will execute the TBasicWork* constructor, not the TMyWork* one. TBasicWork3 and TMyWork3 are declared correctly and thus behave as you intend it.
Is that mandatory? AFAIK it only overwrites the ancestor creator.

And why it works fine when calling TMyWork.Create and it doesn't when using the class reference TBasicWorkClass (TBasicWorkClass = class of TBasicWork;)?

Remy Lebeau

  • Hero Member
  • *****
  • Posts: 665
    • Lebeau Software
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #3 on: September 19, 2019, 04:16:42 am »
And why it works fine when calling TMyWork.Create

Because you are constructing an object directly from the TMyWork class type, not from a class reference.  Calling a constructor on a specific class type will call that class's constructor, or the nearest matching ancestor constructor.

and it doesn't when using the class reference TBasicWorkClass (TBasicWorkClass = class of TBasicWork;)?

Because you are creating an object from a class reference, not from a specific class type, and the TBasicWorkClass constructor is not virtual, and no derived class overrides it, so any call to the constructor via a TBasicWorkClass variable will not be dispatched to any derived class constructor.

You need to study up on how virtual constructors actually work, especially in relation to class references.  Just like class methods can be virtual and overridden, so too can constructors, but virtual constructors are only really useful when constructing objects via class references.
« Last Edit: September 19, 2019, 04:20:13 am by Remy Lebeau »
Remy Lebeau
Lebeau Software - Owner, Developer
Internet Direct (Indy) - Admin, Developer (Support forum)

garlar27

  • Hero Member
  • *****
  • Posts: 616
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #4 on: September 19, 2019, 04:07:36 pm »
Well, here https://www.freepascal.org/docs-html/ref/refse34.html, in the class reference's part doesn't say anything about that. Maybe is an outdated doc.

I will start to play a little more with what you say to see how it behaves...

PascalDragon

  • Hero Member
  • *****
  • Posts: 617
  • Compiler Developer
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #5 on: September 20, 2019, 09:08:42 am »
Well, here https://www.freepascal.org/docs-html/ref/refse34.html, in the class reference's part doesn't say anything about that. Maybe is an outdated doc.
It's not outdated, but nobody said that the documentation is perfect and complete (we're only human after all as well). So you could file a bug report against the documentation to clarify this.

marcov

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 7432
Re: Extrange behavior using Class of. What am I doing wwrong?
« Reply #6 on: September 20, 2019, 11:17:31 am »
Yes, the documentation is not wrong, it just happens to demonstrate with classes that have virtual constructors. It might be better to explicitly state so, as Sven says, file a bug.