generic recursive function which TRttiField SetValue on Record doesn't work

Question

I have a "parent" class which has a generic function to load a JSON string into the instance's properties called loadVals. I have two children with their own properties, and one of these props is a record. The function sets successfully all the props of the main instance, but fails on setting the values on the record's props, no errors, I can see it loops successfully through the record's props but doesn't set the values. wrote a small test console app, where you can see the behavior.

uses
  System.SysUtils, System.TypInfo, RTTI, Data.DBXJSON;

type
  TFieldValLoader = reference to procedure (const new_val: TValue);

  tRec1 = record
    x: integer;
    y: String;
  end;

  tRec2 = record
    a: integer;
    b: String;
    c: integer;
  end;

  TMyParent = class(TObject)
    procedure loadVals(json_obj: TJSONObject);
  end;

  TMyChild1 = class(TMyParent)
    h: integer;
    my_rec: tRec1;
  end;

  TMyChild2 = class(TMyParent)
    j: string;
    my_rec: tRec2;
  end;

{ TMyParent }
procedure TMyParent.loadVals(json_obj: TJSONObject);
   procedure loadObj(Obj : TObject; my_json_obj: TJSONObject); forward;
  procedure loadRecord(Obj : TValue; my_json_obj: TJSONObject);forward;

  Procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
  Begin
    case _val.TypeInfo.Kind of
      tkInteger:
        _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
      tkWChar, tkUString, tkVariant:
        _loader( TValue.From(my_json_val.JsonValue.Value));
      tkRecord:
        loadRecord(_val, my_json_val.JsonValue as TJSONObject);
    end;
  End;

  procedure loadRecord(obj : TValue; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.TypeInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('    - '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj.GetReferenceToRawData),
        procedure( const new_val: TValue )
        Begin
        // This does not work. (no feedback)!!!!
          my_field.SetValue(obj.GetReferenceToRawData, new_val);
        End
      );
    End;
  End;

  procedure loadObj(Obj : TObject; my_json_obj: TJSONObject);
  var
    i: Integer;
    json_pair: TJSONPair;

    ctx: TRttiContext;
    obj_type: TRttiType;
    my_field: TRttiField;
  begin
    ctx := TRttiContext.Create;
    obj_type := ctx.GetType(obj.ClassInfo);
    for I := 0 to my_json_obj.Size - 1 do
    Begin
      json_pair := my_json_obj.get(i);
      my_field := obj_type.GetField(json_pair.JsonString.value);
      WriteLn('* '+ my_field.Name);
      loadField(json_pair, my_field.GetValue(obj),
        procedure( const new_val: TValue )
        Begin
        // This does work
          my_field.SetValue(obj, new_val);
        End
      );
    End;
  End;
begin
  WriteLn('Loading  '+ self.ClassName);
  loadObj(self, json_obj);
end;

{ main Test Procedure }
var
  my_child1: TMyChild1;
  my_child2: TMyChild2;
begin
  try
    my_child1:= TMyChild1.Create;
    my_child2:= TMyChild2.Create;
    try
    // load the json objs
      my_child1.loadVals(TJSONObject.ParseJSONValue('{"h": 2, "my_rec": {"x": 4, "y": "test"}}') as TJSONObject);
      my_child2.loadVals(TJSONObject.ParseJSONValue('{"j": "some", "my_rec": {"a": 8, "b": "any", "c": 9}}') as TJSONObject);

    // print the loaded values
      WriteLn('child 1 vals are: h: '+ intToStr(my_child1.h) +'  my_rec.y= "'+ my_child1.my_rec.y +'" should equal to "test"');
      WriteLn('child 2 vals are: j: '+ my_child2.j +'  my_rec.b= "'+ my_child2.my_rec.b +'" should equal to "any"');

    finally
      my_child1.Free;
      my_child2.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  // don't close the window, wait for [Enter]
  Readln;
end.

I know records are different than classes, and I cannot find a way of getting this function to work; I really appreciate any help. Thanks

Stefan Glienke · Accepted Answer · 2013-02-27T07:40:12.293

Your problem is that a record is a value type.

This line

loadField(json_pair, my_field.GetValue(obj),

gets the value of the record field. Keep in mind, its a value type so we get a copy of it. Now you are setting the properties/fields on that copy which works. But then you never assign that back to the fields of your object.

So what you are doing here is basically like this:

my_child1:= TMyChild1.Create;
my_rec1 := my_child1.my_rec;
my_rec1.x := 4;
my_rec1.y := 'test';

So you can see that my_child1.my_rec never gets the values set to my_rec1.

You need to fix loadField as follows:

procedure loadField( my_json_val: TJSONPair; _val: TValue; _loader: TFieldValLoader );
begin
  case _val.TypeInfo.Kind of
    tkInteger:
      _loader( TValue.From<integer>(StrToInt(my_json_val.JsonValue.Value)));
    tkWChar, tkUString, tkVariant:
      _loader( TValue.From(my_json_val.JsonValue.Value));
    tkRecord:
    begin
      loadRecord(_val, my_json_val.JsonValue as TJSONObject);
      _loader( _val); // <- set the record back to the field
    end;
  end;
end;

generic recursive function which TRttiField SetValue on Record doesn't work

1 Answers1