Serializing SuperObject JSON for variant length arrays gives FastMM "modified after freed" error

1.1k Views Asked by At

Serializing SuperObject JSON for variant length arrays gives FastMM "modified after freed" error

I'm wondering why the next code for testing (de)serialization of variant length arrays:

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;

gives this FastMM4 "a block has been modified after being freed" error (when closing the program - the serialization+deserialization itself give the expected results):

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]

The TestSimpleVarArray gets called once from a button click.
Am I doing something wrong or is there a bug in the SuperObject code?
I tried to trace it using the FastMM4 error log but got lost (limited experience with generics, RTTI and interfaces).

I must 'confess' that I modified the SuperObject code to compile for Delphi XE2 (Changed FHeapData to 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]

Any clues?
TIA

0

There are 0 best solutions below