diff --git a/wst/trunk/base_binary_formatter.pas b/wst/trunk/base_binary_formatter.pas index cbe5a3ccb..5b12b2bfe 100644 --- a/wst/trunk/base_binary_formatter.pas +++ b/wst/trunk/base_binary_formatter.pas @@ -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; diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index fd5814b39..4f0ec4271 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -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; diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 1b5022c5d..6a77b0db7 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -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; diff --git a/wst/trunk/object_serializer.pas b/wst/trunk/object_serializer.pas index 660fe9133..79964f4d5 100644 --- a/wst/trunk/object_serializer.pas +++ b/wst/trunk/object_serializer.pas @@ -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; diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index c48107190..55194d963 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -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}