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

时间:2013-07-29 08:00:22

标签: delphi delphi-xe2 superobject

为变体长度数组序列化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

0 个答案:

没有答案