diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 6a77b0db7..49d94f6df 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -3304,7 +3304,7 @@ class procedure TBaseSimpleTypeArrayRemotable.Save( const ATypeInfo : PTypeInfo ); var - i,j : Integer; + i, arrayLen : Integer; nativObj : TBaseSimpleTypeArrayRemotable; itmName : string; styl : TArrayStyle; @@ -3312,23 +3312,25 @@ begin if Assigned(AObject) then begin Assert(AObject.InheritsFrom(TBaseSimpleTypeArrayRemotable)); nativObj := AObject as TBaseSimpleTypeArrayRemotable; - j := nativObj.Length; + arrayLen := nativObj.Length; end else begin - j := 0; + arrayLen := 0; end; - styl := GetStyle(); - AStore.BeginArray(AName,PTypeInfo(Self.ClassInfo),GetItemTypeInfo(),[0,Pred(j)],styl); - try - if ( styl = asScoped ) then begin - itmName := GetItemName(); - end else begin - itmName := AName; + 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; + end; + for i := 0 to Pred(arrayLen) do begin + nativObj.SaveItem(AStore,itmName,i); + end; + finally + AStore.EndScope(); end; - for i := 0 to Pred(j) do begin - nativObj.SaveItem(AStore,itmName,i); - end; - finally - AStore.EndScope(); end; end; @@ -3351,7 +3353,7 @@ begin itmName := AName; end; len := AStore.BeginArrayRead(AName,ATypeInfo, GetStyle(),itmName); - if ( len >= 0 ) then begin + if ( len > 0 ) then begin try if not Assigned(AObject) then AObject := Create(); @@ -3365,6 +3367,9 @@ begin finally AStore.EndScopeRead(); end; + end else begin + if ( AObject <> nil ) then + TBaseSimpleTypeArrayRemotable(AObject).SetLength(0); end; end; @@ -3505,7 +3510,7 @@ class procedure TObjectCollectionRemotable.Save( ); Var itmTypInfo : PTypeInfo; - i,j : Integer; + i, arrayLen : Integer; nativObj : TObjectCollectionRemotable; itm : TObject; itmName : string; @@ -3514,25 +3519,27 @@ begin if Assigned(AObject) then begin Assert(AObject.InheritsFrom(TObjectCollectionRemotable)); nativObj := AObject as TObjectCollectionRemotable; - 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; @@ -3575,6 +3582,9 @@ begin Finally AStore.EndScopeRead(); End; + end else begin + if ( AObject <> nil ) then + TObjectCollectionRemotable(AObject).Clear(); end; end; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 55194d963..4fdf1cb65 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -64,6 +64,16 @@ type property Item[AIndex:Integer] : TClass_A Read GetItem;Default; end; + TClass_A_Collection = class(TObjectCollectionRemotable) + private + function GetItem(AIndex: Integer): TClass_A; + public + class function GetItemClass():TBaseRemotableClass;override; + function Add(): TClass_A; {$IFDEF USE_INLINE}inline;{$ENDIF} + function AddAt(const APosition : Integer) : TClass_A; {$IFDEF USE_INLINE}inline;{$ENDIF} + property Item[AIndex:Integer] : TClass_A Read GetItem;Default; + end; + { TClass_B } TClass_B = class(TBaseComplexRemotable) @@ -502,6 +512,10 @@ type procedure Test_ObjectArray(); procedure Test_ObjectArray_ReadEmptyArray(); + procedure Test_ObjectCollection(); + procedure Test_ObjectCollection_ReadEmptyCollection(); + + procedure Test_SimpleTypeArray_ReadEmptyArray(); procedure Test_ComplexInt32S(); @@ -3135,8 +3149,20 @@ begin f.EndScope(); s := TMemoryStream.Create(); f.SaveToStream(s); - FreeAndNil(a); + + FreeAndNil(a); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_B)); + x := 'a'; + f.Get(TypeInfo(TArrayOfStringRemotable),x,a); + f.EndScopeRead(); + CheckNull(a); + + a := TArrayOfStringRemotable.Create(); f := CreateFormatter(TypeInfo(TClass_B)); s.Position := 0; f.LoadFromStream(s); @@ -3902,7 +3928,9 @@ var f : IFormatterBase; s : TMemoryStream; x : string; + ls : TStringList; begin + ls := nil; s := nil; areaded := nil; a := TClass_A_Array.Create(); @@ -3927,7 +3955,204 @@ begin f.Get(TypeInfo(TClass_A_Array),x,areaded); f.EndScopeRead(); CheckEquals(0,areaded.Length); + + ls := TStringList.Create(); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_B)); + f.GetScopeItemNames(ls); + CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); + f.EndScopeRead(); + CheckEquals(0,areaded.Length); finally + ls.Free(); + areaded.Free(); + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_ObjectCollection(); +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_Collection; + aitem : TClass_A; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; +begin + s := nil; + areaded := nil; + a := TClass_A_Collection.Create(); + try + for i := 1 to AR_LEN do + a.Add(); + 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_Collection),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectCollection.' + f.GetFormatName())); + + areaded := TClass_A_Collection.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_Collection),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_ObjectCollection_ReadEmptyCollection(); +var + a, areaded : TClass_A_Collection; + aitem : TClass_A; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; + ls : TStringList; +begin + ls := nil; + s := nil; + areaded := nil; + a := TClass_A_Collection.Create(); + try + a.Clear(); + f := CreateFormatter(TypeInfo(TClass_B)); + f.BeginObject('Root',TypeInfo(TClass_B)); + f.Put('a',TypeInfo(TClass_A_Collection),a); + f.EndScope(); + s := TMemoryStream.Create(); + f.SaveToStream(s); + //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_ObjectCollection_ReadEmptyCollection.' + f.GetFormatName())); + + areaded := TClass_A_Collection.Create(); + areaded.Add(); + areaded.Add(); + 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_Collection),x,areaded); + f.EndScopeRead(); + CheckEquals(0,areaded.Length); + + ls := TStringList.Create(); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_B)); + f.GetScopeItemNames(ls); + CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); + f.EndScopeRead(); + CheckEquals(0,areaded.Length); + finally + ls.Free(); + areaded.Free(); + a.Free(); + s.Free(); + end; +end; + +procedure TTestFormatter.Test_SimpleTypeArray_ReadEmptyArray(); +var + a, areaded : TArrayOfStringRemotable; + aitem : TClass_A; + i : Integer; + f : IFormatterBase; + s : TMemoryStream; + x : string; + ls : TStringList; +begin + ls := nil; + s := nil; + areaded := nil; + a := TArrayOfStringRemotable.Create(); + try + a.SetLength(0); + 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); + //s.SaveToFile(wstExpandLocalFileName('TTestFormatter.Test_SimpleTypeArray_ReadEmptyArray.' + f.GetFormatName())); + + areaded := TArrayOfStringRemotable.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(TArrayOfStringRemotable),x,areaded); + f.EndScopeRead(); + CheckEquals(0,areaded.Length); + + ls := TStringList.Create(); + f := CreateFormatter(TypeInfo(TClass_B)); + s.Position := 0; + f.LoadFromStream(s); + x := 'Root'; + f.BeginObjectRead(x,TypeInfo(TClass_B)); + f.GetScopeItemNames(ls); + CheckEquals(-1, ls.IndexOf('a'), 'empty array should not be streamed'); + f.EndScopeRead(); + CheckEquals(0,areaded.Length); + finally + ls.Free(); areaded.Free(); a.Free(); s.Free(); @@ -4407,6 +4632,28 @@ begin Result:= TClass_A; end; +{ TClass_A_Collection } + +function TClass_A_Collection.GetItem(AIndex: Integer): TClass_A; +begin + Result := TClass_A(Inherited GetItem(AIndex)); +end; + +class function TClass_A_Collection.GetItemClass(): TBaseRemotableClass; +begin + Result:= TClass_A; +end; + +function TClass_A_Collection.Add() : TClass_A; +begin + Result := TClass_A(inherited Add()); +end; + +function TClass_A_Collection.AddAt(const APosition : Integer) : TClass_A; +begin + Result := TClass_A(inherited AddAt(APosition)); +end; + { TClass_B } procedure TClass_B.SetObjProp(const AValue: TClass_A); @@ -5638,6 +5885,8 @@ initialization 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_A_Collection),'TClass_A_Collection'); + GetTypeRegistry().ItemByTypeInfo[TypeInfo(TClass_A_Collection)].RegisterExternalPropertyName(sARRAY_ITEM,'Item'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_B),'TClass_B'); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TClass_Float),'TClass_Float');