2

为变长数组序列化 SuperObject JSON 会导致 FastMM“释放后修改”错误

我想知道为什么下一个测试（反）序列化变体长度数组的代码：

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“一个块在被释放后被修改”错误（关闭程序时 - 序列化+反序列化本身给出了预期的结果）：

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 和接口的经验有限）。

我必须“承认”我修改了 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

4

0 回答 0