Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Why does a deserialized TDictionary not work correctly?

I try serialize/deserialize standard delphi container using standard delphi serializer.

procedure TForm7.TestButtonClick(Sender: TObject);
var
    dict: TDictionary<Integer, Integer>;
    jsonValue: TJSONValue;
begin
    //serialization
    dict := TDictionary<Integer, Integer>.Create;
    dict.Add(1, 1);
    jsonValue := TJsonConverter.ObjectToJSON(dict);
    dict.Free;

    //deserialization
    dict := TJsonConverter.JSONToObject(jsonValue) as TDictionary<Integer, Integer>;
    try
        Assert(dict.ContainsKey(1), 'deserialization error - key not found');
    except
        Assert(false, 'deserialization error - dict object broken');
    end;
end;

There is a way I convert object to JSON and vice versa;

class function TJsonConverter.JSONToObject(AJSONValue: TJSONValue): TObject;
var
    lUnMarshal: TJSONUnMarshal;
begin
    lUnMarshal := TJSONUnMarshal.Create();
    try
        Result := lUnMarshal.Unmarshal(AJSONValue);
    finally
        lUnMarshal.Free;
    end;
end;

class function TJsonConverter.ObjectToJSON(AData: TObject): TJSONValue;
var
    lMarshal: TJSONMarshal;
begin
    lMarshal := TJSONMarshal.Create();

    try
        Result := lMarshal.Marshal(AData);
    finally
        lMarshal.Free;
    end;
end;

line:

dict := TJsonConverter.JSONToObject(jsonValue) as TDictionary<Integer, Integer>;

doesn't create dictionary correctly. Here is how looks dict create by constructor: [Dictionary created correctly[1]

and here is dict created by deserialization: Dictionary deserialized wrong

How can I fix it?

Edit: Here is JSON content

 {
       "type" : "System.Generics.Collections.TDictionary<System.Integer,System.Integer>",
       "id" : 1,
       "fields" : {
          "FItems" : [
             [ -1, 0, 0 ],
             [ -1, 0, 0 ],
             [ -1, 0, 0 ],
             [ 911574339, 1, 1 ]
          ],
          "FCount" : 1,
          "FGrowThreshold" : 3,
          "FKeyCollection" : null,
          "FValueCollection" : null
       }
    }
like image 376
aQuu Avatar asked Feb 10 '17 10:02

aQuu


1 Answers

The problem is that TJSONMarshal is instantiating the dictionary using RTTI. It does that by invoking the first parameterless constructor that it can find. And, sadly, that is the the constructor defined in TObject.

Let's take a look at the constructors declared in TDictionary<K,V>. They are, at least in my XE7 version:

constructor Create(ACapacity: Integer = 0); overload;
constructor Create(const AComparer: IEqualityComparer<TKey>); overload;
constructor Create(ACapacity: Integer; const AComparer: IEqualityComparer<TKey>); overload;
constructor Create(const Collection: TEnumerable<TPair<TKey,TValue>>); overload;
constructor Create(const Collection: TEnumerable<TPair<TKey,TValue>>; 
  const AComparer: IEqualityComparer<TKey>); overload;

All of these constructors have parameters.

Don't be fooled by the fact that you write

TDictionary<Integer, Integer>.Create

and create an instance with FComparer assigned. That resolves to the first overload above and so the compiler re-writes that code as

TDictionary<Integer, Integer>.Create(0)

filling in the default parameter.

What you need to do is make sure that you only use classes that have parameterless constructors that properly instantiate the class. Unfortunately TDictionary<K,V> does not fit the bill.

You can however derive a sub-class that introduces a parameterless constructor, and your code should work with that class.

The following code demonstrates:

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Generics.Collections,
  System.Rtti;

type
  TDictionary<K,V> = class(System.Generics.Collections.TDictionary<K,V>)
  public
    constructor Create;
  end;

{ TDictionary<K, V> }

constructor TDictionary<K, V>.Create;
begin
  inherited Create(0);
end;

type
  TInstance<T: class> = class
    class function Create: T; static;
  end;

class function TInstance<T>.Create: T;
// mimic the way that your JSON marshalling code instantiates objects
var
  ctx: TRttiContext;
  typ: TRttiType;
  mtd: TRttiMethod;
  cls: TClass;
begin
  typ := ctx.GetType(TypeInfo(T));
  for mtd in typ.GetMethods do begin
    if mtd.HasExtendedInfo and mtd.IsConstructor then
    begin
      if Length(mtd.GetParameters) = 0 then
      begin
        cls := typ.AsInstance.MetaclassType;
        Result := mtd.Invoke(cls, []).AsType<T>;
        exit;
      end;
    end;
  end;
  Result := nil;
end;

var
  Dict: TDictionary<Integer, Integer>;

begin
  Dict := TInstance<TDictionary<Integer, Integer>>.Create;
  Dict.Add(0, 0);
  Writeln(BoolToStr(Dict.ContainsKey(0), True));
  Readln;
end.
like image 138
David Heffernan Avatar answered Sep 20 '22 06:09

David Heffernan