为变体长度数组序列化SuperObject JSON可以在释放后对FastMM"进行修改"错误
我想知道为什么下一个测试(de)序列化变体长度数组的代码:
type
TSimpleVarArray = Array of Integer;
procedure TFrmJSONRTTI.TestSimpleVarArray;
var
VarArray,
NewVArray: TSimpleVarArray;
i : integer;
so : ISuperObject;
ctx : TSuperRttiContext;
begin
Log('');
Log('------------------------------');
Log('');
Log('SERIALIZING simple variant length array');
Log('');
SetLength(VarArray,6);
for i := 0 to Length(VarArray)-1 do VarArray[i] := i*i;
ctx := TSuperRttiContext.Create;
try
so := ctx.AsJson<TSimpleVarArray>(VarArray);
finally
ctx.Free;
end;
// We can stop here, the error is in the serialization
end;
给出了这个FastMM4&#34;一个块在被释放后被修改了#34;错误(关闭程序时 - 序列化+反序列化本身会给出预期的结果):
FastMM has detected an error during a free block scan operation. FastMM detected that a block has been modified after being freed.
Modified byte offsets (and lengths): 0(1)
The previous block size was: 28
This block was previously allocated by thread 0x604, and the stack trace (return addresses) at the time was:
404826 [System][@GetMem$qqri]
40539B [System][TObject.NewInstance$qqrv]
40A6C1 [System][TInterfacedObject.NewInstance$qqrv]
405A0A [System][@ClassCreate$qqrpvzc]
5280DF [System.Rtti][Rtti.TValueDataImpl.CreateWithoutCopy$qqrpvip24System.Typinfo.TTypeInfo]
40842F [System][@InitializeArray$qqrpvt1ui]
5293D6 [System.Rtti][Rtti.TValue.MakeWithoutCopy$qqrpvp24System.Typinfo.TTypeInfor18System.Rtti.TValue]
56D4C9 [SuperObject.pas][superobject][FromDynArray][6158]
56DE16 [SuperObject.pas][superobject][TSuperRttiContext.FromJson$qqrp24System.Typinfo.TTypeInfox52System.%DelphiInterface$t24Superobject.ISuperObject%r18System.Rtti.TValue][6339]
57DA05 [SuperObject.pas][uJSONRTTI][TSuperRttiContext.%AsType$24System.%DynamicArray$ti%%$qqrx52System.%DelphiInterface$t24Superobject.ISuperObject%$24System.%DynamicArray$ti%][5922]
56C6AC [SuperObject.pas][superobject][TSuperRttiContext.$bctr$qqrv][5888]
The block was previously used for an object of class: TValueDataImpl
The allocation number was: 1288
The block was previously freed by thread 0x604, and the stack trace (return addresses) at the time was:
404842 [System][@FreeMem$qqrpv]
4053B9 [System][TObject.FreeInstance$qqrv]
405A55 [System][@ClassDestroy$qqrp14System.TObject]
528169 [System.Rtti][Rtti.TValueDataImpl.$bdtr$qqrv]
40A727 [System][TInterfacedObject._Release$qqsv]
40857D [System][@FinalizeArray$qqrpvt1ui]
40846D [System][@FinalizeRecord$qqrpvt1]
40856D [System][@FinalizeArray$qqrpvt1ui]
40846D [System][@FinalizeRecord$qqrpvt1]
57DA47 [uJSONRTTI][TSuperRttiContext.%AsType$24System.%DynamicArray$ti%%$qqrx52System.%DelphiInterface$t24Superobject.ISuperObject%$24System.%DynamicArray$ti%]
56C6AC [SuperObject.pas][superobject][TSuperRttiContext.$bctr$qqrv][5888]
The current thread ID is 0x604, and the stack trace (return addresses) leading to this error is:
412924 [FastMM4.pas][FastMM4][CheckBlocksOnShutdown$qqro][9978]
4136CA [FastMM4.pas][FastMM4][FinalizeMemoryManager$qqrv][11077]
413742 [FastMM4.pas][FastMM4][Finalization$qqrv][11167]
406A48 [System][FinalizeUnits$qqrv]
406E12 [System][@Halt0$qqrv]
58628B
769933AA [BaseThreadInitThunk]
77849EF2 [Unknown function at RtlInitializeExceptionChain]
77849EC5 [Unknown function at RtlInitializeExceptionChain]
从单击按钮调用TestSimpleVarArray一次
我做错了还是SuperObject代码中有错误?
我尝试使用FastMM4错误日志跟踪它但丢失了(使用泛型,RTTI和接口的经验有限)。
我必须承认&#39;我修改了SuperObject代码以编译Delphi XE2(将FHeapData更改为FValueData):
function TSuperRttiContext.ToJson(var value: TValue; const index: ISuperObject): ISuperObject;
[snip]
procedure FromRecord;
var
f: TRttiField;
p: Pointer;
v: TValue;
begin
Result := True;
TValue.Make(nil, TypeInfo, Value);
for f in Context.GetType(TypeInfo).GetFields do
begin
if ObjectIsType(obj, stObject) and (f.FieldType <> nil) then
begin
p := IValueData(TValueData(Value).FValueData).GetReferenceToRawData; // Changed FHeapData to FValueData for XE2
Result := FromJson(f.FieldType.Handle, GetFieldDefault(f, obj.AsObject[GetFieldName(f)]), v);
if Result then
f.SetValue(p, v) else
Exit;
end else
begin
Result := False;
Exit;
end;
end;
end;
[snip]
procedure ToRecord;
var
f: TRttiField;
v: TValue;
begin
Result := TSuperObject.Create(stObject);
for f in Context.GetType(Value.TypeInfo).GetFields do
begin
v := f.GetValue(IValueData(TValueData(Value).FValueData).GetReferenceToRawData); //Changed FHeapData to FValueData for XE2
Result.AsObject[GetFieldName(f)] := ToJson(v, index);
end;
end;
[snip]
procedure ToInterface;
begin
if TValueData(Value).FValueData <> nil then // Changed FHeapData to FValueData for XE2
TValueData(Value).FValueData.QueryInterface(ISuperObject, Result) else // Changed FHeapData to FValueData for XE2
Result := nil;
end;
[snip]
任何线索?
TIA