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

问题描述

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,"ExampleString0","ExampleString1","ExampleString2","ExampleString3"]

在交互 1 之后，添加了三个字符串字段。

如果我现在用旧数据集面对 Delphi Sydney 的标准元帅（没有自定义转换器、还原器等），那么具体而言，对于数据 "AnalysisAdditionalData":[0,"ExampleString"]，Sydney 会抛出一个 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,attrRev,jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance,JSONToTValue(jsonFieldVal,recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance,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.

解决方法

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

• 复制标准库 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,attrRev,jsonFieldVal)
                  finally
                    attrRev.Free
                  end
                else
                 recField.SetValue(Instance,JSONToTValue(jsonFieldVal,recField.FieldType));
              end
            end
            else
              recField.SetValue(Instance,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;