pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Complex objects serialization : serializer objects must be notified for external property name registration and update themself accordingly.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@817 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2009-05-31 19:00:10 +00:00
parent 1e2c9d67b0
commit 6315b87d48
5 changed files with 291 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
wst/trunk/base_binary_formatter.pas
View File

@ -1362,11 +1362,12 @@ var
begin
stk := StackTop();
locNode := stk.Find(AScopeName);
if not Assigned(locNode) then begin
Error('Scope not found : "%s"',[AScopeName]);
if ( locNode <> nil ) then begin
PushStack(locNode,stArray);
Result := StackTop().GetItemCount();
end else begin
Result := -1;
end;
PushStack(locNode,stArray);
Result := StackTop().GetItemCount();
end;
function TBaseBinaryFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer;

19
wst/trunk/base_json_formatter.pas
View File

@ -833,16 +833,17 @@ var
begin
stk := StackTop();
locNode := stk.FindNode(AScopeName);
if not Assigned(locNode) then begin
Error('Scope not found : "%s"',[AScopeName]);
if ( locNode <> nil ) then begin
case locNode.JSONType() of
jtArray : PushStack(locNode,stArray);
jtNull : PushStack(locNode,stNilScope);
else
Error('array or Nil expected, name : %s.',[AScopeName]);
end;
Result := StackTop().GetItemCount();
end else begin
Result := -1;
end;
case locNode.JSONType() of
jtArray : PushStack(locNode,stArray);
jtNull : PushStack(locNode,stNilScope);
else
Error('array or Nil expected, name : %s.',[AScopeName]);
end;
Result := StackTop().GetItemCount();
end;
function TJsonRpcBaseFormatter.GetScopeItemNames(const AReturnList : TStrings) : Integer;

41
wst/trunk/base_service_intf.pas
View File

@ -1504,7 +1504,7 @@ type
function IsSynonym(const APascalTypeName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
function IsExternalSynonym(const AExternalName : string):Boolean;{$IFDEF USE_INLINE}inline;{$ENDIF}
procedure RegisterExternalPropertyName(const APropName, AExtPropName : string);
procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); virtual;
function GetExternalPropertyName(const APropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
function GetInternalPropertyName(const AExtPropName : string) : string;{$IFDEF USE_INLINE}inline;{$ENDIF}
@ -2450,7 +2450,7 @@ class procedure TBaseObjectArrayRemotable.Save(
);
Var
itmTypInfo : PTypeInfo;
i,j : Integer;
i, arrayLen : Integer;
nativObj : TBaseObjectArrayRemotable;
itm : TObject;
itmName : string;
@ -2459,25 +2459,27 @@ begin
if Assigned(AObject) then begin
Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable));
nativObj := AObject as TBaseObjectArrayRemotable;
j := nativObj.Length;
arrayLen := nativObj.Length;
end else begin
j := 0;
arrayLen := 0;
end;
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
styl := GetStyle();
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(j)],styl);
try
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
if ( arrayLen > 0 ) then begin
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
styl := GetStyle();
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(arrayLen)],styl);
try
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
end;
for i := 0 to Pred(arrayLen) do begin
itm := nativObj.Item[i];
AStore.Put(itmName,itmTypInfo,itm);
end;
finally
AStore.EndScope();
end;
for i := 0 to Pred(j) do begin
itm := nativObj.Item[i];
AStore.Put(itmName,itmTypInfo,itm);
end;
finally
AStore.EndScope();
end;
end;
@ -2520,6 +2522,9 @@ begin
Finally
AStore.EndScopeRead();
End;
end else begin
if ( AObject <> nil ) then
(AObject as TBaseObjectArrayRemotable).SetLength(0);
end;
end;

39
wst/trunk/object_serializer.pas
View File

@ -72,6 +72,8 @@ type
FOptions : TObjectSerializerOptions;
private
procedure Prepare(ATypeRegistry : TTypeRegistry);
function FindInfo(const APropName : string) : TPropSerializationInfo;
procedure UpdateExternalName(const APropName, AExtPropName : string);
public
constructor Create(
ATargetClass : TBaseComplexRemotableClass;
@ -105,6 +107,7 @@ type
procedure Init(); override;
public
destructor Destroy();override;
procedure RegisterExternalPropertyName(const APropName, AExtPropName : string); override;
function GetSerializer() : TObjectSerializer;{$IFDEF USE_INLINE}inline;{$ENDIF}
end;
@ -1220,6 +1223,33 @@ begin
end;
end;
function TObjectSerializer.FindInfo(const APropName: string): TPropSerializationInfo;
var
i : Integer;
begin
Result := nil;
if ( FSerializationInfos.Count > 0 ) then begin
for i := 0 to Pred(FSerializationInfos.Count) do begin
if SameText(APropName,TPropSerializationInfo(FSerializationInfos[i]).ExternalName) then begin
Result := TPropSerializationInfo(FSerializationInfos[i]);
Break;
end;
end;
end;
end;
procedure TObjectSerializer.UpdateExternalName(
const APropName,
AExtPropName : string
);
var
itm : TPropSerializationInfo;
begin
itm := FindInfo(APropName);
if ( itm <> nil ) then
itm.FExternalName := AExtPropName;
end;
constructor TObjectSerializer.Create(
ATargetClass : TBaseComplexRemotableClass;
ATypeRegistry : TTypeRegistry
@ -1356,6 +1386,15 @@ begin
inherited Destroy();
end;
procedure TBaseComplexTypeRegistryItem.RegisterExternalPropertyName(
const APropName,
AExtPropName : string
);
begin
inherited RegisterExternalPropertyName(APropName, AExtPropName);
GetSerializer().UpdateExternalName(APropName,AExtPropName);
end;
function TBaseComplexTypeRegistryItem.GetSerializer() : TObjectSerializer;
begin
Result := FSerializer;

217
wst/trunk/tests/test_suite/testformatter_unit.pas
View File

@ -56,6 +56,14 @@ type
{$ENDIF WST_UNICODESTRING}
End;
TClass_A_Array = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TClass_A;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TClass_A Read GetItem;Default;
end;
{ TClass_B }
TClass_B = class(TBaseComplexRemotable)
@ -384,6 +392,17 @@ type
property ObjProperty : TTestSmallClass read FObjProperty write FObjProperty;
end;
{ TClassWithPropExtName }
TClassWithPropExtName = class(TBaseComplexRemotable)
private
FPropWithExtName: Integer;
FStrProp: string;
published
property StrProp : string read FStrProp write FStrProp;
property PropWithExtName : Integer read FPropWithExtName write FPropWithExtName;
end;
{ TTestFormatterSimpleType }
TTestFormatterSimpleType= class(TWstBaseTest)
@ -458,6 +477,7 @@ type
procedure Test_Object();
procedure Test_Object_Nil();
procedure Test_Object_ExternalPropertyName();
procedure Test_StringArray();
procedure Test_StringArray_Embedded();
procedure Test_StringArrayZeroLength();
@ -480,6 +500,9 @@ type
procedure Test_FloatExtendedArray();
procedure Test_FloatCurrencyArray();
procedure Test_ObjectArray();
procedure Test_ObjectArray_ReadEmptyArray();
procedure Test_ComplexInt32S();
procedure Test_Record_simple();
@ -1348,7 +1371,7 @@ begin
f.Get(TypeInfo(Int64),x,intVal_S);
f.EndScopeRead();
CheckEquals(VAL_1,intVal_U);
CheckEquals(QWord(VAL_1),intVal_U);
CheckEquals(VAL_2,intVal_S);
Finally
s.Free();
@ -2127,7 +2150,7 @@ begin
CheckEquals(CONST_Val_16S,a.Val_16S);
CheckEquals(CONST_Val_32U,a.Val_32U);
CheckEquals(CONST_Val_32S,a.Val_32S);
CheckEquals(CONST_Val_64U,a.Val_64U);
CheckEquals(QWord(CONST_Val_64U),a.Val_64U);
CheckEquals(CONST_Val_64S,a.Val_64S);
Finally
a.Free();
@ -2290,7 +2313,7 @@ begin
CheckEquals(True,a.Val_CplxInt64S.BoolSimpleAtt_Exemple);
CheckEquals(VAL_STR_X,a.Elt_Exemple);
CheckEquals(VAL_U,a.Val_CplxInt64U.Value);
CheckEquals(QWord(VAL_U),a.Val_CplxInt64U.Value);
CheckEquals(VAL_X,a.Val_CplxInt64U.IntSimpleAtt_Exemple);
CheckEquals(VAL_STR_U,a.Val_CplxInt64U.StrSimpleAtt_Exemple);
CheckEquals(False,a.Val_CplxInt64U.BoolSimpleAtt_Exemple);
@ -2910,6 +2933,62 @@ begin
end;
end;
procedure TTestFormatter.Test_Object_ExternalPropertyName();
var
f : IFormatterBase;
s : TMemoryStream;
a, areaded : TClassWithPropExtName;
x : string;
ls : TStringList;
begin
ls := nil;
s := nil;
a := TClassWithPropExtName.Create();
try
a.StrProp := 'wst string';
a.PropWithExtName := 123;
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('o1',TypeInfo(TClassWithPropExtName),a);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
//s.SaveToFile(wstExpandLocalFileName(ClassName + '.Test_Object_ExternalPropertyName.' + f.GetFormatName()));
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'o1';
f.BeginObjectRead(x,TypeInfo(TClassWithPropExtName));
ls := TStringList.Create();
CheckEquals(2, f.GetScopeItemNames(ls), 'Scope item names');
Check(ls.IndexOf('ExternalProperty') >= 0, '"ExternalProperty" not found');
f.EndScopeRead();
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
areaded := TClassWithPropExtName.Create();
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'o1';
f.Get(TypeInfo(TClassWithPropExtName),x,areaded);
f.EndScopeRead();
CheckEquals(a.StrProp, areaded.StrProp, 'StrProp');
CheckEquals(a.PropWithExtName, areaded.PropWithExtName, 'PropWithExtName');
finally
ls.Free();
a.Free();
areaded.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_StringArray();
const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of string = ('AzErTy','QwErTy','123456','','1');
var
@ -3740,6 +3819,121 @@ begin
end;
end;
procedure TTestFormatter.Test_ObjectArray();
const AR_LEN = 5;
procedure FillObject(AObject : TClass_A; const AIndex : Integer);
begin
AObject.Val_32S := AIndex * AR_LEN;
if ( ( AObject.Val_32S mod 3 ) = 0 ) then
AObject.Val_32S := -AObject.Val_32S;
AObject.Val_Bool := ( AObject.Val_32S < 0 );
AObject.Val_Enum := TTestEnum( ( AIndex * AR_LEN) mod ( 1 + Ord(High(TTestEnum)) ) );
AObject.FVal_String := Format('Sample string %d',[AIndex]);
end;
procedure CompareObject(AExpected, AActual : TClass_A; const AMsg : string);
begin
Check(
( ( AExpected = nil ) and ( AActual = nil ) ) or
( ( AExpected <> nil ) and ( AActual <> nil ) ),
AMsg
);
if ( AExpected <> nil ) then begin
CheckEquals(Ord(AExpected.Val_Enum), Ord(AActual.Val_Enum));
CheckEquals(AExpected.Val_Bool, AActual.Val_Bool);
CheckEquals(AExpected.Val_32S, AActual.Val_32S);
CheckEquals(AExpected.Val_String, AActual.Val_String);
CheckEquals(AExpected.Val_WideString, AActual.Val_WideString);
end;
end;
var
a, areaded : TClass_A_Array;
aitem : TClass_A;
i : Integer;
f : IFormatterBase;
s : TMemoryStream;
x : string;
begin
s := nil;
areaded := nil;
a := TClass_A_Array.Create();
try
a.SetLength(AR_LEN);
CheckEquals(AR_LEN,a.Length);
for i := 0 to Pred(AR_LEN) do begin
FillObject(a[i],i);
end;
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Array),a);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
//s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectArray.' + f.GetFormatName()));
areaded := TClass_A_Array.Create();
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TClass_A_Array),x,areaded);
f.EndScopeRead();
CheckEquals(AR_LEN,areaded.Length);
for i := 0 to Pred(AR_LEN) do
CompareObject(a[i],areaded[i], Format('Object at %d index',[i]));
finally
areaded.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_ObjectArray_ReadEmptyArray();
var
a, areaded : TClass_A_Array;
aitem : TClass_A;
i : Integer;
f : IFormatterBase;
s : TMemoryStream;
x : string;
begin
s := nil;
areaded := nil;
a := TClass_A_Array.Create();
try
a.SetLength(0);
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Array),a);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
//s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectArray.' + f.GetFormatName()));
areaded := TClass_A_Array.Create();
areaded.SetLength(12);
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
x := 'a';
f.Get(TypeInfo(TClass_A_Array),x,areaded);
f.EndScopeRead();
CheckEquals(0,areaded.Length);
finally
areaded.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_ComplexInt32S();
const VAL_1 = 121076; VAL_2 : LongInt = -101276;
var
@ -4201,6 +4395,18 @@ begin
end;
end;
{ TClass_A_Array }
function TClass_A_Array.GetItem(AIndex: Integer): TClass_A;
begin
Result := TClass_A(Inherited GetItem(AIndex));
end;
class function TClass_A_Array.GetItemClass(): TBaseRemotableClass;
begin
Result:= TClass_A;
end;
{ TClass_B }
procedure TClass_B.SetObjProp(const AValue: TClass_A);
@ -5430,6 +5636,9 @@ initialization
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Int),'TClass_Int').RegisterExternalPropertyName('Val_8U','U8');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Enum),'TClass_Enum');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_A),'TClass_A');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_A_Array),'TClass_A_Array');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TClass_A_Array)].RegisterExternalPropertyName(sARRAY_ITEM,'ArrayItem');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_B),'TClass_B');
GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Float),'TClass_Float');
@ -5456,6 +5665,8 @@ initialization
GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass2),'TTestSmallClass2');
GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TTestSmallClass),'TTestSmallClass');
GetTypeRegistry.Register('uri:test-namespace',TypeInfo(TClassWithPropExtName),'TClassWithPropExtName');
GetTypeRegistry.ItemByTypeInfo[TypeInfo(TClassWithPropExtName)].RegisterExternalPropertyName('PropWithExtName','ExternalProperty');
GetTypeRegistry().Register(sWST_BASE_NS,TypeInfo(TTestSmallRecord),'TTestSmallRecord').RegisterExternalPropertyName('__FIELDS__','fieldSmallint;fieldWord;fieldString');
{$IFNDEF WST_RECORD_RTTI}