paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

* Serialization : array and collection now have a "Options" property that can be used to indicate that they should be serialized, empty or not. To do so just include "ioAlwaysSerialize" in the "Options" property of the instance you want to customize.

Browse Source 
* Test

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@861 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2009-06-25 13:54:10 +00:00
parent 02f81dec33
commit abf1f15cde
2 changed files with 233 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
wst/trunk/base_service_intf.pas
View File

@ -47,6 +47,8 @@ type
TScopeType = Integer;
TArrayStyle = ( asScoped, asEmbeded, asNone );
TInstanceOption = ( ioAlwaysSerialize );
TInstanceOptions = set of TInstanceOption;
THeaderDirection = ( hdOut, hdIn );
THeaderDirections = set of THeaderDirection;
const
@ -847,6 +849,7 @@ type
TObjectCollectionRemotable = class(TAbstractComplexRemotable)
private
FList : TObjectList;
FOptions : TInstanceOptions;
protected
function GetItem(AIndex : PtrInt) : TBaseRemotable;{$IFDEF USE_INLINE}inline;{$ENDIF}
class function GetItemName():string;virtual;
@ -883,6 +886,7 @@ type
property Item[AIndex:PtrInt] : TBaseRemotable read GetItem;default;
property Length : PtrInt read GetLength;
property Options : TInstanceOptions read FOptions write FOptions;
end;
TBaseArrayRemotableClass = class of TBaseArrayRemotable;
@ -890,6 +894,8 @@ type
{ TBaseArrayRemotable }
TBaseArrayRemotable = class(TAbstractComplexRemotable)
private
FOptions : TInstanceOptions;
protected
class function GetItemName():string;virtual;
class function GetStyle():TArrayStyle;virtual;
@ -901,6 +907,7 @@ type
procedure SetLength(const ANewSize : Integer);virtual;abstract;
property Length : Integer Read GetLength;
property Options : TInstanceOptions read FOptions write FOptions;
end;
{ TBaseObjectArrayRemotable
@ -2456,29 +2463,37 @@ Var
itmName : string;
styl : TArrayStyle;
begin
if Assigned(AObject) then begin
if ( AObject <> nil ) then begin
Assert(AObject.InheritsFrom(TBaseObjectArrayRemotable));
nativObj := AObject as TBaseObjectArrayRemotable;
arrayLen := nativObj.Length;
end else begin
arrayLen := 0;
end;
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;
if ( arrayLen > 0 ) then begin
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
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(arrayLen) do begin
itm := nativObj.Item[i];
AStore.Put(itmName,itmTypInfo,itm);
end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
AStore.BeginArray(
AName, PTypeInfo(Self.ClassInfo),
PTypeInfo(GetItemClass().ClassInfo),[0,-1],styl
);
try
AStore.NilCurrentScope();
finally
AStore.EndScope();
end;
finally
AStore.EndScope();
end;
end;
end;
@ -3313,23 +3328,28 @@ begin
Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable));
nativObj := AObject as TBaseSimpleTypeArrayRemotable;
arrayLen := nativObj.Length;
end else begin
arrayLen := 0;
end;
if ( arrayLen > 0 ) then begin
styl := GetStyle();
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(arrayLen)],styl);
try
if ( styl = asScoped ) then begin
itmName := GetItemName();
end else begin
itmName := AName;
if ( arrayLen > 0 ) then begin
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[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
nativObj.SaveItem(AStore,itmName,i);
end;
finally
AStore.EndScope();
end;
for i := 0 to Pred(arrayLen) do begin
nativObj.SaveItem(AStore,itmName,i);
end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,-1],styl);
try
AStore.NilCurrentScope();
finally
AStore.EndScope();
end;
finally
AStore.EndScope();
end;
end;
end;
@ -3519,26 +3539,31 @@ begin
if Assigned(AObject) then begin
Assert(AObject.InheritsFrom(TObjectCollectionRemotable));
nativObj := AObject as TObjectCollectionRemotable;
arrayLen := nativObj.Length;
end else begin
arrayLen := 0;
end;
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;
arrayLen := nativObj.Length;
if ( arrayLen > 0 ) then begin
itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
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(arrayLen) do begin
itm := nativObj.Item[i];
AStore.Put(itmName,itmTypInfo,itm);
end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,-1],styl);
try
AStore.NilCurrentScope();
finally
AStore.EndScope();
end;
finally
AStore.EndScope();
end;
end;
end;

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

@ -491,6 +491,7 @@ type
procedure Test_StringArray();
procedure Test_StringArray_Embedded();
procedure Test_StringArrayZeroLength();
procedure Test_StringArrayZeroLength_serializeOption();
procedure Test_BooleanArray();
procedure Test_Int8UArray();
@ -512,7 +513,9 @@ type
procedure Test_ObjectArray();
procedure Test_ObjectArray_ReadEmptyArray();
procedure Test_ObjectArrayZeroLength_serializeOption();
procedure Test_ObjectCollection();
procedure Test_ObjectCollectionZeroLength_serializeOption();
procedure Test_ObjectCollection_ReadEmptyCollection();
procedure Test_SimpleTypeArray_ReadEmptyArray();
@ -3215,6 +3218,61 @@ begin
end;
end;
procedure TTestFormatter.Test_StringArrayZeroLength_serializeOption();
var
a : TArrayOfStringRemotable;
f : IFormatterBase;
s : TMemoryStream;
x : string;
ls : TStringList;
begin
a := nil;
s := nil;
ls := TStringList.Create();
try
a := TArrayOfStringRemotable.Create();
CheckEquals(0,a.Length);
a.Options := [];
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TArrayOfStringRemotable),a);
f.EndScope();
s := TMemoryStream.Create();
f.SaveToStream(s);
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(0,f.GetScopeItemNames(ls));
f.EndScopeRead();
a.Options := [ioAlwaysSerialize];
s.Clear();
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TArrayOfStringRemotable),a);
f.EndScope();
f.SaveToStream(s);
f := CreateFormatter(TypeInfo(TClass_B));
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(1,f.GetScopeItemNames(ls));
CheckEquals('a',ls[0]);
f.EndScopeRead();
finally
ls.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_BooleanArray();
const AR_LEN = 5; VAL_AR : array[0..(AR_LEN-1)] of Boolean = (True,True,False,True,False);
var
@ -4009,6 +4067,57 @@ begin
end;
end;
procedure TTestFormatter.Test_ObjectArrayZeroLength_serializeOption();
var
a : TClass_A_Array;
f : IFormatterBase;
s : TMemoryStream;
x : string;
ls : TStringList;
begin
a := nil;
s := nil;
ls := TStringList.Create();
try
s := TMemoryStream.Create();
a := TClass_A_Array.Create();
a.SetLength(0);
a.Options := [];
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Array),a);
f.EndScope();
f.SaveToStream(s);
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(0, f.GetScopeItemNames(ls));
f.EndScopeRead();
a.Options := [ioAlwaysSerialize];
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Array),a);
f.EndScope();
s.Clear();
f.SaveToStream(s);
s.Position := 0;
f.LoadFromStream(s);
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(1, f.GetScopeItemNames(ls));
f.EndScopeRead();
CheckEquals('a', ls[0]);
finally
ls.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_ObjectCollection();
const AR_LEN = 5;
@ -4085,6 +4194,57 @@ begin
end;
end;
procedure TTestFormatter.Test_ObjectCollectionZeroLength_serializeOption();
var
a : TClass_A_Collection;
f : IFormatterBase;
s : TMemoryStream;
x : string;
ls : TStringList;
begin
a := nil;
s := nil;
ls := TStringList.Create();
try
s := TMemoryStream.Create();
a := TClass_A_Collection.Create();
a.Clear();
a.Options := [];
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Collection),a);
f.EndScope();
f.SaveToStream(s);
s.Position := 0;
f.LoadFromStream(s);
x := 'Root';
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(0, f.GetScopeItemNames(ls));
f.EndScopeRead();
a.Options := [ioAlwaysSerialize];
f := CreateFormatter(TypeInfo(TClass_B));
f.BeginObject('Root',TypeInfo(TClass_B));
f.Put('a',TypeInfo(TClass_A_Collection),a);
f.EndScope();
s.Clear();
f.SaveToStream(s);
s.Position := 0;
f.LoadFromStream(s);
f.BeginObjectRead(x,TypeInfo(TClass_B));
CheckEquals(1, f.GetScopeItemNames(ls));
f.EndScopeRead();
CheckEquals('a', ls[0]);
finally
ls.Free();
a.Free();
s.Free();
end;
end;
procedure TTestFormatter.Test_ObjectCollection_ReadEmptyCollection();
var
a, areaded : TClass_A_Collection;