json - 记录的简单 JSON 反序列化不正确(Delphi Sydney [10.4.1])

Question

Delphi Sydney(10.4.1)的JSON反序列化器怎么了？
从 Delphi Seattle 迁移到悉尼后，标准 marshal 在简单记录的反序列化方面存在问题。
这是我的问题的示例和简化表示:
数据结构 - 交互 1:

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

JSON 表示:

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

数据结构 - 交互 x，5 年后:

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 表示:

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

在交互 1 之后，添加了三个字符串字段。
如果我现在用旧数据集面对 Delphi Sydney 的标准编码(marshal)(没有自定义转换器、还原器等)，那么具体来说就是数据 "AnalysisAdditionalData":[0,1, "ExampleString"] , 悉尼抛出 EArgumentOutOfBoundsException因为需要 3 个字符串 - 反序列化失败。
退出点在 Data.DBXJSONReflect在方法中 TJSONUnMarshal.JSONToTValue - 位置标记如下:

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;

当然，这对于那些只在悉尼工作，或者至少在西雅图以上的 Delphi 版本上工作，或者已经开始使用这些版本的人来说可能是有意义的。另一方面，我最近才能够从西雅图过渡到悉尼(更新 1)。
Delphi Seattle 没有丢失记录字段的问题。当它们可以保持不变作为默认值时，为什么要这样做？然而，荒谬的是，悉尼没有过多数据的问题。
这是一个已知的 Delphi Sydney 错误吗？我们可以期待修复吗？或者可以通过其他方式解决问题，即编译器指令， Data.DBXJSONReflect.TCustomAttribute ， 等等。？或者，是否可以为记录编写转换器/还原器？如果是这样，是否有有用的指南或资源来解释如何做到这一点？
就我而言，不幸的是，我在这方面没有找到任何有用的信息，只有许多记录很差的类描述。
附录:是的，它看起来像是一个 Delphi 错误，在我看来是一个非常危险的错误。幸运的是，我即将部署一个主要版本，我在移植到悉尼后进行测试时发现了这个错误。但这只是偶然，因为我必须处理旧数据集。我可以很容易地忽略这个缺陷。
您应该检查您的项目是否也受到影响。对我来说，问题是现在的瓶颈。
我刚刚为 Embarcadero 支持团队编写了一个非常简单的测试程序。如果需要，您可以查看它并测试您的代码是否也受到影响。
下面是说明和代码:

创建一个新项目。

在主窗体上创建两个按钮和一个备忘录。

为加载按钮分配两个 OnClick 事件并相应地保存

运行程序并单击保存按钮。

在应用程序目录中打开 .TXT 并删除例如记录的最后一个条目。

单击加载按钮并抛出 EArgumentOutOfBoundsException。

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

为了暂时解决问题，我为您提供了以下快速解决方案:

复制标准库 Data.DBXJSONReflect并命名，例如Data.TempFix.DBXJSONReflect .

相应地更改项目中的所有包含/使用。

之后导航到 Data.TempFix.DBXJSONReflect到第 2993 行:

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

并将其替换为以下代码:

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

之后整个方法应该是这样的:

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;