From abf1f15cdedd19f0f3c7be82c8d3850d01d3f7cb Mon Sep 17 00:00:00 2001 From: inoussa Date: Thu, 25 Jun 2009 13:54:10 +0000 Subject: [PATCH] * 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. * Test git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@861 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 121 +++++++------ .../tests/test_suite/testformatter_unit.pas | 160 ++++++++++++++++++ 2 files changed, 233 insertions(+), 48 deletions(-) diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index c55d7cb0b..e735e82f7 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 45d22a6dd..66f42ee21 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -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;