Generics and Marshal / UnMarshal. What am I missing here? PART 2:-)

Question

Following my previous question: Generals and Marshal / UnMarshal. What am I missing here?

In the "part number 1" (link above) TOndrej provided a pleasant solution - it failed on XE2. Here I provide a corrected source to fix this.

And I feel the need to expand this problem a little more. Therefore, I would like to hear everything how to do it:

First. To get the source code that was started when upgrading XE2 and XE2, make the following changes:

Marshal.RegisterConverter(TTestObject, function (Data: TObject): String // <-- String here begin Result := T(Data).Marshal.ToString; // <-- ToString here end ); 

Why? The only reason I can see should be because XE2 has much more RTTI information. And therefore, it will try and marshal the returned TObject. Am I here on the right track? Please feel free to comment.

More important , the example does not implement the UnMarshal method. If someone can produce it and post it here, I would like it :-)

I hope you still have an interest in this matter.

Regards Bjarne

Answer 1

In addition to answering this question, I posted a workaround to your previous question here: Generics and Marshal / UnMarshal. What am I missing here?

For some reason, using the non-standard TJsonobject type constructor causes a problem in XE2 — using the default constructor "fixes" the problem.

Firstly, you need to transfer your TTestobject to your own module - otherwise RTTI will not be able to find / create its object when trying to cancel the exchange.

  unit uTestObject; interface uses SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections, DbxJson, DbxJsonReflect; type {$RTTI EXPLICIT METHODS([]) PROPERTIES([vcPublished]) FIELDS([vcPrivate])} TTestObject=class(TObject) private aList:TStringList; public constructor Create; overload; constructor Create(list: array of string); overload; constructor Create(list:TStringList); overload; destructor Destroy; override; function Marshal:TJSonObject; class function Unmarshal(value: TJSONObject): TTestObject; published property List: TStringList read aList write aList; end; implementation { TTestObject } constructor TTestObject.Create; begin inherited Create; aList:=TStringList.Create; end; constructor TTestObject.Create(list: array of string); var I:Integer; begin Create; for I:=low(list) to high(list) do begin aList.Add(list[I]); end; end; constructor TTestObject.Create(list:TStringList); begin Create; aList.Assign(list); end; destructor TTestObject.Destroy; begin aList.Free; inherited; end; function TTestObject.Marshal:TJSonObject; var Mar:TJSONMarshal; begin Mar:=TJSONMarshal.Create(); try Mar.RegisterConverter(TStringList, function(Data:TObject):TListOfStrings var I, Count:Integer; begin Count:=TStringList(Data).Count; SetLength(Result, Count); for I:=0 to Count-1 do Result[I]:=TStringList(Data)[I]; end); Result:=Mar.Marshal(Self) as TJSonObject; finally Mar.Free; end; end; class function TTestObject.Unmarshal(value: TJSONObject): TTestObject; var Mar: TJSONUnMarshal; L: TStringList; begin Mar := TJSONUnMarshal.Create(); try Mar.RegisterReverter(TStringList, function(Data: TListOfStrings): TObject var I, Count: Integer; begin Count := Length(Data); Result:=TStringList.Create; for I := 0 to Count - 1 do TStringList(Result).Add(string(Data[I])); end ); //UnMarshal will attempt to create a TTestObject from the TJSONObject data //using RTTI lookup - for that to function, the type MUST be defined in a unit Result:=Mar.UnMarshal(Value) as TTestObject; finally Mar.Free; end; end; end. 

Also note that the constructor is overloaded - this allows you to see that the code functions without preliminary processing of data in the object during creation.

Here is an implementation for a generic class list object

  unit uTestObjectList; interface uses SysUtils, Classes, Contnrs, Generics.Defaults, Generics.Collections, DbxJson, DbxJsonReflect, uTestObject; type {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} TTestObjectList<T:TTestObject,constructor> = class(TObjectList<T>) public function Marshal: TJSonObject; constructor Create; class function Unmarshal(value: TJSONObject): TTestObjectList<T>; static; end; //Note: this MUST be present and initialized/finalized so that //delphi will keep the RTTI information for the generic class available //also, it MUST be "project global" - not "module global" var X:TTestObjectList<TTestObject>; implementation { TTestObjectList<T> } constructor TTestObjectList<T>.Create; begin inherited Create; //removed the add for test data - it corrupts unmarshaling because the data is already present at creation end; function TTestObjectList<T>.Marshal: TJSonObject; var Marshal: TJsonMarshal; begin Marshal := TJSONMarshal.Create; try Marshal.RegisterConverter(TTestObjectList<T>, function(Data: TObject): TListOfObjects var I: integer; begin SetLength(Result,TTestObjectlist<T>(Data).Count); for I:=0 to TTestObjectlist<T>(Data).Count-1 do Result[I]:=TTestObjectlist<T>(Data)[I]; end ); Result := Marshal.Marshal(Self) as TJSONObject; finally Marshal.Free; end; end; class function TTestObjectList<T>.Unmarshal(value: TJSONObject): TTestObjectList<T>; var Mar: TJSONUnMarshal; L: TStringList; begin Mar := TJSONUnMarshal.Create(); try Mar.RegisterReverter(TTestObjectList<T>, function(Data: TListOfObjects): TObject var I, Count: Integer; begin Count := Length(Data); Result:=TTestObjectList<T>.Create; for I := 0 to Count - 1 do TTestObjectList<T>(Result).Unmarshal(TJSONObject(Data[I])); end ); //UnMarshal will attempt to create a TTestObjectList<TTestObject> from the TJSONObject data //using RTTI lookup - for that to function, the type MUST be defined in a unit, //and, because it is generic, there must be a GLOBAL VARIABLE instantiated //so that Delphi keeps the RTTI information avaialble Result:=Mar.UnMarshal(Value) as TTestObjectList<T>; finally Mar.Free; end; end; initialization //force delphi RTTI into maintaining the Generic class information in memory x:=TTestObjectList<TTestObject>.Create; finalization X.Free; end. 

There are several things that are important to note: If a universal class is created at runtime, the RTTI information is NOT stored if there is no public object reference to this class in memory. See here: Delphi: RTTI and TObjectList <TObject>

So, the unit described above creates such a variable and leaves it as an instance, as described in the related article.

The main procedure has been updated, which shows both marshaling and unmarshaling data for both objects:

  procedure Main; var aTestobj, bTestObj, cTestObj : TTestObject; aList, bList : TTestObjectList<TTestObject>; aJsonObject, bJsonObject, cJsonObject : TJsonObject; s: string; begin aTestObj := TTestObject.Create(['one','two','three','four']); aJsonObject := aTestObj.Marshal; s:=aJsonObject.ToString; Writeln(s); bJsonObject:=TJsonObject.Create; bJsonObject.Parse(BytesOf(s),0,length(s)); bTestObj:=TTestObject.Unmarshal(bJsonObject) as TTestObject; writeln(bTestObj.List.Text); writeln('TTestObject marshaling complete.'); readln; aList := TTestObjectList<TTestObject>.Create; aList.Add(TTestObject.Create(['one','two'])); aList.Add(TTestObject.Create(['three'])); aJsonObject := aList.Marshal; s:=aJsonObject.ToString; Writeln(s); cJSonObject:=TJsonObject.Create; cJSonObject.Parse(BytesOf(s),0,length(s)); bList:=TTestObjectList<TTestObject>.Unmarshal(cJSonObject) as TTestObjectList<TTestObject>; for cTestObj in bList do begin writeln(cTestObj.List.Text); end; writeln('TTestObjectList<TTestObject> marshaling complete.'); Readln; end; 

Answer 2

Here is my own decision.

Since I really love polymorphism, I also want the solution to be embedded in the hierarchy of objects. Let's say TTestObject and TTestObjectList are our base object. And from this we will go down to TMyObject, as well as TMyObjectList. In addition, I made changes to the properties of objects and the list added for Marshaller / UnMarshaller

 TMyObject = class(TTestObject) and TMyObjectList<T:TMyObject> = class(TTestObjectList) 

With this we will introduce some new problems. I.e. how to handle sorting of different types between rows in a hierarchy and how to handle TJsonMarshal and TJsonUnMarshal as properties in TTestObject and List.

This can be overcome by introducing two new methods at the TTestObject level. Two cool features called RegisterConverters and RegisterReverters. Then we go over and change the function of the marshal TTestObjectList to a more simpal sort.

Two classes of functions and properties for an object and a list.

 class procedure RegisterConverters(aClass: TClass; aMar: TJSONMarshal); virtual; class procedure RegisterReverters(aClass: TClass; aUnMar: TJSONUnMarshal); virtual; property Mar: TJSONMarshal read FMar write SetMar; property UnMar: TJSONUnMarshal read FUnMar write SetUnMar; 

Now the List marshal function can be executed as follows:

 function TObjectList<T>.Marshal: TJSONObject; begin if FMar = nil then FMar := TJSONMarshal.Create(); // thx. to SilverKnight try RegisterConverters; // Virtual class method !!!! try Result := FMar.Marshal(Self) as TJSONObject; except on e: Exception do raise Exception.Create('Marshal Error : ' + e.Message); end; finally ClearMarshal; // FreeAndNil FMar and FUnMar if assigned. end; end; 

Of course, we still have a marshaller for our TTestObject, but the marshal function TTestObjectList will NOT use it. Thus, only one marshaller will be created when the marshal TTestObjectList (or children) is called. And so we end up collecting ONLY the information we need to recreate our structure when we do it all back - UnMarshalling :-)

Now it really works - but I wonder if anyone has any comments on this?

Let's add the “TimeOfCreation” property to TMyTestObject: TimeOfCreation property: TDateTime read FTimeOfCreation write FTimeOfCreation;

And set the property in the constructor.

 FTimeofCreation := now; 

And then we need a converter, so we redefine the virtual RegisterConverters from TTestObject.

 class procedure TMyTestObject.RegisterConverters(aClass: TClass; aMar: TJSONMarshal); begin inherited; // instanciate marshaller and register TTestObject converters aMar.RegisterConverter(aClass, 'FTimeOfCreation', function(Data: TObject; Field: String): string var ctx: TRttiContext; date: TDateTime; begin date := ctx.GetType(Data.ClassType).GetField(Field).GetValue(Data).AsType<TDateTime>; Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', date); end); end; 

I get a very simple source, e.g. using TTestObject, i.e.

 aList := TMyTestObjectList<TMyTestObject>.Create; aList.Add(TMyTestObject.Create(['one','two'])); aList.Add(TMyTestObject.Create(['three'])); s := (aList.Marshal).ToString; Writeln(s); 

And now I have succeeded in marshalling with polymorphism :-)

This also works with UnMarshalling btw. And Im in the process of restoring my ORM FireBird to create a source for all my objects like this.

The current version of OLD can be found here: http://code.google.com/p/objectgenerator/ Remember that it works only for FireBird :-)