* 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

@@ -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);
+    if ( arrayLen > 0 ) then begin
-    try
+      itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
-      if ( styl = asScoped ) then begin
+      AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(arrayLen)],styl);
-        itmName := GetItemName();
+      try
-      end else begin
+        if ( styl = asScoped ) then begin
-        itmName := AName;
+          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
+    end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
-        itm := nativObj.Item[i];
+      AStore.BeginArray(
-        AStore.Put(itmName,itmTypInfo,itm);
+        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);
+    if ( arrayLen > 0 ) then begin
-    try
+      AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(arrayLen)],styl);
-      if ( styl = asScoped ) then begin
+      try
-        itmName := GetItemName();
+        if ( styl = asScoped ) then begin
-      end else begin
+          itmName := GetItemName();
-        itmName := AName;
+        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
+    end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
-        nativObj.SaveItem(AStore,itmName,i);
+      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);
+    arrayLen := nativObj.Length;
-    try
+    if ( arrayLen > 0 ) then begin
-      if ( styl = asScoped ) then begin
+      itmTypInfo := PTypeInfo(GetItemClass().ClassInfo);
-        itmName := GetItemName();
+      AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,Pred(arrayLen)],styl);
-      end else begin
+      try
-        itmName := AName;
+        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
+    end else if ( styl = asScoped ) and ( ioAlwaysSerialize in nativObj.Options ) then begin
-        itm := nativObj.Item[i];
+      AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),itmTypInfo,[0,-1],styl);
-        AStore.Put(itmName,itmTypInfo,itm);
+      try
+        AStore.NilCurrentScope();
+      finally
+        AStore.EndScope();
       end;
-    finally
-      AStore.EndScope();
     end;
   end;
 end;

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;