简单JSON反序列化记录错误(Delphi Sydney[10.4.1])

Question

Delphi Sydney(10.4.1)的JSON反序列化器发生了什么?从Delphi Seattle迁移到Sydney之后，标准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的标准封送(没有自定义转换器，反转器等)与旧数据集，所以具体地说，对于数据"AnalysisAdditionalData":[0,1, "ExampleString"], Sydney抛出EArgumentOutOfBoundsException，因为预期有3个字符串-反序列化失败。

出口点在TJSONUnMarshal.JSONToTValue方法的Data.DBXJSONReflect-位置如下所示:

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;

当然，这可能对那些只使用Sydney，或者至少使用西雅图以上的Delphi版本，或者已经开始使用这些版本的人来说是有意义的。另一方面，我最近才从西雅图搬到悉尼(更新1)。

Delphi Seattle没有丢失记录字段的问题。既然它们可以作为违约而不受影响，为什么要这么做呢?然而，荒谬的是，悉尼没有数据过剩的问题。

这是一个已知的Delphi Sydney bug吗?我们可以期待修复吗?或者问题可以在一些其他的方式，即编译器指令，Data.DBXJSONReflect.TCustomAttribute等工作?或者，是否有可能为记录编写转换器/还原器?如果有，是否有有用的指南或资源来解释如何做到这一点?

就我而言，不幸的是，我没有找到这方面的任何有用的信息，只有许多非常缺乏文档的类描述。

附录:是的，它看起来像是一个Delphi bug，在我看来是一个非常危险的bug。幸运的是，当我正要部署一个主要版本时，我在移植到Sydney后的测试中发现了这个bug。但那只是偶然，因为我必须处理旧的数据集。我可以很容易地忽略这个缺陷。

您应该检查您的项目是否也受到影响。对我来说，现在的问题是一个破脖子。

我刚刚为Embarcadero支持团队写了一个非常简单的测试程序。如果您愿意，您可以查看它并测试您的代码是否也受到影响。

下面是说明和代码:

• 新建项目
• 在主表单上创建两个按钮和一个memo。
• 为加载和保存按钮分配两个OnClick事件
• 运行程序并点击保存按钮。
• 打开应用程序目录中的。txt文件，并删除例如记录的最后一项。
• 点击加载按钮，抛出argumentoutofboundsexception。

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。
• 相应地更改项目中的所有include/uses。

在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;