Simple JSON deserialization of records incorrect (Delphi Sydney [10.4.1])

Question

What happened to the JSON deserializer of Delphi Sydney (10.4.1)? After the migration from Delphi Seattle to Sydney, the standard marshal has problems with the deserialization of simple records.

Here is an example and simplified representation of my problem:

Data structure - Interation 1:

TAnalysisAdditionalData=record {order important for marshaling}
  ExampleData0:Real;   {00}
  ExampleData1:Real;   {01}
  ExampleData2:String; {02} 
end;

JSON representation:

"AnalysisAdditionalData":[0,1,"ExampleString"]

Data structure - Interation x, 5 years later:

TAnalysisAdditionalData=record {order important for marshaling}
  ExampleData0:Real;   {00}
  ExampleData1:Real;   {01}
  ExampleData2:String; {02} 
  ExampleData3:String; {03} {since version 2016-01-01}  
  ExampleData4:String; {04} {since version 2018-01-01}  
  ExampleData5:String; {05} 
end;

JSON representation:

"AnalysisAdditionalData":[0,1,"ExampleString0","ExampleString1","ExampleString2","ExampleString3"]

After interation 1, three string fields have been added.

If I now confront the standard marshal of Delphi Sydney (no custom converter, reverter, etc.) with an old dataset, so concretely with the data "AnalysisAdditionalData":[0,1, "ExampleString"], Sydney throws an EArgumentOutOfBoundsException because the 3 strings are expected - the deserialization fails.

Exit point is in Data.DBXJSONReflect in method TJSONUnMarshal.JSONToTValue - location marked below:

function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue;
  rttiType: TRttiType): TValue;
var
  tvArray: array of TValue;
  Value: string;
  I: Integer;
  elementType: TRttiType;
  Data: TValue;
  recField: TRTTIField;
  attrRev: TJSONInterceptor;
  jsonFieldVal: TJSONValue;
  ClassType: TClass;
  Instance: Pointer;
begin
  // null or nil returns empty
  if (JsonValue = nil) or (JsonValue is TJSONNull) then
    Exit(TValue.Empty);

  // for each JSON value type
  if JsonValue is TJSONNumber then
    // get data "as is"
    Value := TJSONNumber(JsonValue).ToString
  else if JsonValue is TJSONString then
    Value := TJSONString(JsonValue).Value
  else if JsonValue is TJSONTrue then
    Exit(True)
  else if JsonValue is TJSONFalse then
    Exit(False)
  else if JsonValue is TJSONObject then
    // object...
    Exit(CreateObject(TJSONObject(JsonValue)))
  else
  begin
    case rttiType.TypeKind of
      TTypeKind.tkDynArray, TTypeKind.tkArray:
        begin
          // array
          SetLength(tvArray, TJSONArray(JsonValue).Count);
          if rttiType is TRttiArrayType then
            elementType := TRttiArrayType(rttiType).elementType
          else
            elementType := TRttiDynamicArrayType(rttiType).elementType;
          for I := 0 to Length(tvArray) - 1 do
            tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
              elementType);
          Exit(TValue.FromArray(rttiType.Handle, tvArray));
        end;
      TTypeKind.tkRecord, TTypeKind.tkMRecord:
        begin
          TValue.Make(nil, rttiType.Handle, Data);
          // match the fields with the array elements
          I := 0;
          for recField in rttiType.GetFields do
          begin
            Instance := Data.GetReferenceToRawData;
            jsonFieldVal := TJSONArray(JsonValue).Items[I]; <<<--- Exception here (EArgumentOutOfBoundsException)
            // check for type reverter
            ClassType := nil;
            if recField.FieldType.IsInstance then
              ClassType := recField.FieldType.AsInstance.MetaclassType;
            if (ClassType <> nil) then
            begin
              if HasReverter(ClassType, FIELD_ANY) then
                RevertType(recField, Instance,
                  Reverter(ClassType, FIELD_ANY),
                  jsonFieldVal)
              else
              begin
                attrRev := FieldTypeReverter(recField.FieldType);
                if attrRev = nil then
                   attrRev := FieldReverter(recField);
                if attrRev <> nil then
                  try
                    RevertType(recField, Instance, attrRev, jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                      recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                  recField.FieldType));
            Inc(I);
          end;
          Exit(Data);
        end;
    end;
  end;

  // transform value string into TValue based on type info
  Exit(StringToTValue(Value, rttiType.Handle));
end;

Of course, this may make sense for people who, for example, only work with Sydney, or at least with Delphi versions above Seattle, or have started with these versions. I, on the other hand, have only recently been able to make the transition from Seattle to Sydney (Update 1).

Delphi Seattle has no problems with the missing record fields. Why should it, when they can be left untouched as default? Absurdly, however, Sydney has no problems with excess data.

Is this a known Delphi Sydney bug? Can we expect a fix? Or can the problem be worked around in some other way, i.e. compiler directive, Data.DBXJSONReflect.TCustomAttribute, etc.? Or, is it possible to write a converter/reverter for records? If so, is there a useful guide or resource that explains how to do this?

I, for my part, have unfortunately not found any useful information in this regard, only many very poorly documented class descriptions.

Addendum: Yes, it looks like it is a Delphi bug, and in my opinion a very dangerous one. Luckily, and I'm just about to deploy a major release, I discovered the bug while testing after porting to Sydney. But that was only by chance, because I had to deal with old datasets. I could have easily overlooked the flaw.

You should check if your projects are also affected. For me, the problem is a neckbreaker right now.

I have just written a very simple test program for the Embarcadero support team. If you want, you can have a look at it and test if your code is also affected.

Below are the instructions and the code:

• Create a new project.
• Creates two buttons and a memo on the main form.
• Assign the two OnClick events for the buttons for load and save accordingly
• Runs the program and clicks the save button.
• Opens the .TXT in the application directory and delete e.g. the last entry of the record.
• Click the load button and an EArgumentOutOfBoundsException is thrown.

unit main;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Memo.Types, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox,
  FMX.Memo;

type
  TAnalysisAdditionalData=record {order important for marshaling}
    ExampleData0:Real;   {00}
    ExampleData1:Real;   {01}
    ExampleData2:String; {02}
    ExampleData3:String; {03} {since version 2016-01-01}
    ExampleData4:String; {04} {since version 2018-01-01}
    ExampleData5:String; {05}
  end;

  TSHCustomEntity=class(TPersistent)
  private
  protected
  public
    GUID:String;
  end;

  TSHAnalysis=class(TSHCustomEntity)
  private
  protected
  public
    AnalysisResult:String;
    AnalysisAdditionalData:TAnalysisAdditionalData;
  end;

  TMainform = class(TForm)
    Memo_Output: TMemo;
    Button_Save: TButton;
    Button_Load: TButton;
    procedure Button_SaveClick(Sender: TObject);
    procedure Button_LoadClick(Sender: TObject);
  private
    Analysis:TSHAnalysis;
    procedure Marshal(Filename:String);
    procedure Unmarshal(Filename:String);
    function GetApplicationPath: String;
    function GetFilename: String;
  protected
    procedure AfterConstruction;override;
  public
    Destructor Destroy;override;

    property ApplicationPath:String read GetApplicationPath;
    property Filename:String read GetFilename;
  end;

var
  Mainform: TMainform;

implementation

{$R *.fmx}

uses
  DBXJSON,
  DBXJSONReflect,
  System.JSON;

{ TMainform }

procedure TMainform.AfterConstruction;
begin
  inherited;
  self.Analysis:=TSHAnalysis.Create;
  self.Analysis.GUID:='6ed61388-cdd4-28dd-6efe-24461c4df3cd';
  self.Analysis.AnalysisAdditionalData.ExampleData0:=0.5;
  self.Analysis.AnalysisAdditionalData.ExampleData1:=0.9;
  self.Analysis.AnalysisAdditionalData.ExampleData2:='ExampleString0';
  self.Analysis.AnalysisAdditionalData.ExampleData3:='ExampleString1';
  self.Analysis.AnalysisAdditionalData.ExampleData4:='ExampleString2';
  self.Analysis.AnalysisAdditionalData.ExampleData5:='ExampleString3';
end;

destructor TMainform.Destroy;
begin
  self.Analysis.free;
  inherited;
end;

function TMainform.GetApplicationPath: String;
begin
  RESULT:=IncludeTrailingPathDelimiter(ExtractFilePath(paramStr(0)));
end;

function TMainform.GetFilename: String;
begin
  RESULT:=self.ApplicationPath+'6ed61388-cdd4-28dd-6efe-24461c4df3cd.txt';
end;

procedure TMainform.Button_SaveClick(Sender: TObject);
begin
  self.Marshal(self.Filename);
end;

procedure TMainform.Button_LoadClick(Sender: TObject);
begin
  if Analysis<>NIL then
    FreeAndNil(Analysis);
  self.Unmarshal(self.Filename);

  self.Memo_Output.Text:=
    self.Analysis.GUID+#13#10+
    FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData0)+#13#10+
    FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData1)+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData2+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData3+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData4+#13#10+
    self.Analysis.AnalysisAdditionalData.ExampleData5;
end;

procedure TMainform.Marshal(Filename:String);
var
  _Marshal:TJSONMarshal;
  _Strings:TStringlist;
  _Value:TJSONValue;
begin
  _Strings:=TStringlist.Create;
  try
    _Marshal:=TJSONMarshal.Create;
    try
      _Value:=_Marshal.Marshal(Analysis);
      _Strings.text:=_Value.ToString;
    finally
      if _Value<>NIL then
        _Value.free;
      _Marshal.free;
    end;
    _Strings.SaveToFile(Filename);
  finally
    _Strings.free;
  end;
end;

procedure TMainform.Unmarshal(Filename:String);
var
  _Strings:TStrings;
  _UnMarshal:TJSONUnMarshal;
  _Value:TJSONValue;
begin
  if FileExists(Filename) then begin
    _Strings:=TStringlist.create;
    try
      _Strings.LoadFromFile(Filename);
      try
        _Value:=TJSONObject.ParseJSONValue(_Strings.Text);
        _UnMarshal:=TJSONUnMarshal.Create;
        try
          try
            self.Analysis:=_UnMarshal.Unmarshal(_Value) as TSHAnalysis;
          except
            on e:Exception do
              self.Memo_Output.text:=e.Message;
          end;
        finally
          _UnMarshal.free;
        end;
      finally
        if _Value<>NIL then
          _Value.free;
      end;
    finally
      _Strings.free;
    end;
  end;
end;

end.

Answer 1

To solve the problem temporarily, I have the following quick solution for you:

• Make a copy of the standard library Data.DBXJSONReflect and name it e.g. Data.TempFix.DBXJSONReflect.
• Change all includes/uses in your project accordingly.

After that navigate in Data.TempFix.DBXJSONReflect to line 2993:

jsonFieldVal := TJSONArray(JsonValue).Items[I];

And replace it with the following code:

try
  jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
  on e:Exception do
    if e is EArgumentOutOfRangeException then
      continue
    else
      raise;
end;

After that the whole method should look like this:

function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue; rttiType: TRttiType): TValue;
var
  tvArray: array of TValue;
  Value: string;
  I: Integer;
  elementType: TRttiType;
  Data: TValue;
  recField: TRTTIField;
  attrRev: TJSONInterceptor;
  jsonFieldVal: TJSONValue;
  ClassType: TClass;
  Instance: Pointer;
begin
  // null or nil returns empty
  if (JsonValue = nil) or (JsonValue is TJSONNull) then
    Exit(TValue.Empty);

  // for each JSON value type
  if JsonValue is TJSONNumber then
    // get data "as is"
    Value := TJSONNumber(JsonValue).ToString
  else if JsonValue is TJSONString then
    Value := TJSONString(JsonValue).Value
  else if JsonValue is TJSONTrue then
    Exit(True)
  else if JsonValue is TJSONFalse then
    Exit(False)
  else if JsonValue is TJSONObject then
    // object...
    Exit(CreateObject(TJSONObject(JsonValue)))
  else
  begin
    case rttiType.TypeKind of
      TTypeKind.tkDynArray, TTypeKind.tkArray:
        begin
          // array
          SetLength(tvArray, TJSONArray(JsonValue).Count);
          if rttiType is TRttiArrayType then
            elementType := TRttiArrayType(rttiType).elementType
          else
            elementType := TRttiDynamicArrayType(rttiType).elementType;
          for I := 0 to Length(tvArray) - 1 do
            tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
              elementType);
          Exit(TValue.FromArray(rttiType.Handle, tvArray));
        end;
      TTypeKind.tkRecord, TTypeKind.tkMRecord:
        begin
          TValue.Make(nil, rttiType.Handle, Data);
          // match the fields with the array elements
          I := 0;
          for recField in rttiType.GetFields do
          begin
            Instance := Data.GetReferenceToRawData;
            try
              jsonFieldVal := TJSONArray(JsonValue).Items[I];
            except
              on e:Exception do
                if e is EArgumentOutOfRangeException then
                  continue
                else
                  raise;
            end;
            // check for type reverter
            ClassType := nil;
            if recField.FieldType.IsInstance then
              ClassType := recField.FieldType.AsInstance.MetaclassType;
            if (ClassType <> nil) then
            begin
              if HasReverter(ClassType, FIELD_ANY) then
                RevertType(recField, Instance,
                  Reverter(ClassType, FIELD_ANY),
                  jsonFieldVal)
              else
              begin
                attrRev := FieldTypeReverter(recField.FieldType);
                if attrRev = nil then
                   attrRev := FieldReverter(recField);
                if attrRev <> nil then
                  try
                    RevertType(recField, Instance, attrRev, jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                      recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
                  recField.FieldType));
            Inc(I);
          end;
          Exit(Data);
        end;
    end;
  end;

  // transform value string into TValue based on type info
  Exit(StringToTValue(Value, rttiType.Handle));
end;