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 は、ボタンのクリックから 1 回呼び出されます。
何か間違ったことをしているのですか、それとも 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]

手がかりはありますか?
ティア

4

0 に答える 0