diff --git a/wst/trunk/base_json_formatter.pas b/wst/trunk/base_json_formatter.pas index c33ed1a17..f9e78c98b 100644 --- a/wst/trunk/base_json_formatter.pas +++ b/wst/trunk/base_json_formatter.pas @@ -179,6 +179,8 @@ type implementation +uses jsonparser; + { TJsonRpcBaseFormatter } @@ -287,7 +289,7 @@ end; procedure TJsonRpcBaseFormatter.AddScopeAttribute(const AName, AValue : string); begin - + Put(AName,TypeInfo(string),AValue); end; function TJsonRpcBaseFormatter.BeginObjectRead(var AScopeName : string; @@ -362,13 +364,26 @@ begin end; procedure TJsonRpcBaseFormatter.SaveToStream(AStream : TStream); +var + locBuffer : string; begin - + CheckScope(); + locBuffer := StackTop().ScopeObject.AsJSON; + AStream.WriteBuffer(locBuffer[1],Length(locBuffer)); end; procedure TJsonRpcBaseFormatter.LoadFromStream(AStream : TStream); +var + locParser : TJSONParser; begin - + ClearStack(); + FSerializationStyle := Low(TSerializationStyle); + locParser := TJSONParser.Create(AStream); + try + //f locParser.Parse; + finally + locParser.Free(); + end; end; procedure TJsonRpcBaseFormatter.Error(const AMsg : string); diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 795b50a16..eba1b23cc 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -19,7 +19,7 @@ interface uses Classes, SysUtils, TypInfo, Contnrs, syncobjs, semaphore, wst_types -{$IFNDEF FPC} +{$IFDEF WST_DELPHI} ,Windows {$ENDIF} ; @@ -239,6 +239,7 @@ type var AName : String; const ATypeInfo : PTypeInfo );virtual;abstract; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;virtual; End; TAbstractSimpleRemotableClass = class of TAbstractSimpleRemotable; @@ -265,6 +266,7 @@ type );override; procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; property Data : string read FData write FData; end; @@ -295,6 +297,7 @@ type class function ParseDate(const ABuffer : string):TDateTime;virtual;abstract; procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; property AsDate : TDateTime read FDate write SetDate; property Year : Integer read FYear; @@ -342,6 +345,7 @@ type class function IsAttributeProperty(const AProperty : shortstring):Boolean; procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; end; TBaseComplexRemotableClass = class of TBaseComplexRemotable; @@ -624,6 +628,7 @@ type constructor Create();override; procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; procedure SetLength(Const ANewSize : Integer);override; Property Item[AIndex:Integer] : TBaseRemotable Read GetItem;Default; @@ -680,6 +685,8 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; + function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; property Item[AIndex:Integer] : ansistring read GetItem write SetItem; default; end; @@ -704,6 +711,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Boolean read GetItem write SetItem; default; end; @@ -728,6 +736,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Byte read GetItem write SetItem; default; end; @@ -752,6 +761,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : ShortInt read GetItem write SetItem; default; end; @@ -776,6 +786,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : SmallInt read GetItem write SetItem; default; end; @@ -800,6 +811,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Word read GetItem write SetItem; default; end; @@ -824,6 +836,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : LongWord read GetItem write SetItem; default; end; @@ -848,6 +861,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : LongInt read GetItem write SetItem; default; end; @@ -872,6 +886,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Int64 read GetItem write SetItem; default; end; @@ -895,6 +910,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : QWord read GetItem write SetItem; default; end; @@ -919,6 +935,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Single read GetItem write SetItem; default; end; @@ -943,6 +960,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Double read GetItem write SetItem; default; end; @@ -967,6 +985,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Extended read GetItem write SetItem; default; end; @@ -991,6 +1010,7 @@ type public class function GetItemTypeInfo():PTypeInfo;override; procedure SetLength(const ANewSize : Integer);override; + procedure Assign(Source: TPersistent); override; property Item[AIndex:Integer] : Currency read GetItem write SetItem; default; end; @@ -1458,6 +1478,11 @@ constructor TBaseRemotable.Create(); begin end; +function TBaseRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +begin + Result := ( Self = ACompareTo ); +end; + { TBaseComplexRemotable } Type TEnumBuffer = Record @@ -1665,7 +1690,7 @@ begin typRegItem := GetTypeRegistry().ItemByTypeInfo[ATypeInfo]; for i := 0 to Pred(propCount) do begin p := propList^[i]; - pt := p^.PropType{$IFNDEF FPC}^{$ENDIF}; + pt := p^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; if IsStoredProp(AObject,p) then begin if IsAttributeProperty(p^.Name) then begin if ( ss <> ssAttibuteSerialization ) then @@ -1702,7 +1727,7 @@ begin {$ENDIF} tkEnumeration,tkInteger : begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -1743,7 +1768,7 @@ begin AStore.Put(prpName,pt,enumData.ULongIntData); end; end; - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} end; @@ -1837,7 +1862,7 @@ begin p := propList^[i]; persistType := IsStoredPropClass(objTypeData^.ClassType,p); If ( persistType in [pstOptional,pstAlways] ) Then Begin - pt := p^.PropType{$IFNDEF FPC}^{$ENDIF}; + pt := p^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; propName := typRegItem.GetExternalPropertyName(p^.Name); if IsAttributeProperty(p^.Name) then begin ss := ssAttibuteSerialization; @@ -1880,7 +1905,7 @@ begin End; tkEnumeration,tkInteger : Begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -1922,7 +1947,7 @@ begin End; End; SetOrdProp(AObject,p^.Name,int64Data); - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} End; @@ -2103,6 +2128,32 @@ begin end; end; +function TBaseObjectArrayRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +var + i, c : PtrInt; + dst : TBaseObjectArrayRemotable; +begin + if ( Self = ACompareTo ) then begin + Result := True; + end else begin + Result := ( Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TBaseObjectArrayRemotable) and + ( Self.Length = TBaseObjectArrayRemotable(ACompareTo).Length ) and + ( TBaseObjectArrayRemotable(ACompareTo).GetItemClass().InheritsFrom(Self.GetItemClass()) ) + ) ; + if Result and ( Self.Length > 0 ) then begin + dst := TBaseObjectArrayRemotable(ACompareTo); + c := Self.Length; + for i := 0 to Pred(c) do begin + if not Self.Item[i].Equal(dst.Item[i]) then begin + Result := False; + Break; + end; + end; + end; + end; +end; + procedure TBaseObjectArrayRemotable.SetLength(const ANewSize: Integer); var i,oldLen : Integer; @@ -2777,14 +2828,53 @@ begin end; procedure TArrayOfStringRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfStringRemotable.Assign(Source: TPersistent); +var + src : TArrayOfStringRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfStringRemotable) then begin + src := TArrayOfStringRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; +end; + +function TArrayOfStringRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +var + i, c : Ptrint; + dst : TArrayOfStringRemotable; +begin + if ( Self = ACompareTo ) then begin + Result := True; + end else begin + Result := Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TArrayOfStringRemotable) and + ( Self.Length = TArrayOfStringRemotable(ACompareTo).Length ); + if Result then begin + c := Self.Length; + dst := TArrayOfStringRemotable(ACompareTo); + for i := 0 to Pred(c) do begin + if ( Self.Item[i] <> dst.Item[i] ) then begin + Result := False; + Break; + end; + end; + end; + end; end; { TBaseArrayRemotable } @@ -2863,14 +2953,29 @@ begin end; procedure TArrayOfBooleanRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfBooleanRemotable.Assign(Source: TPersistent); +var + src : TArrayOfBooleanRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfBooleanRemotable) then begin + src := TArrayOfBooleanRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt8URemotable } @@ -2912,14 +3017,29 @@ begin end; procedure TArrayOfInt8URemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt8URemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt8URemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt8URemotable) then begin + src := TArrayOfInt8URemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt8SRemotable } @@ -2961,14 +3081,29 @@ begin end; procedure TArrayOfInt8SRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt8SRemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt8SRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt8SRemotable) then begin + src := TArrayOfInt8SRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt16SRemotable } @@ -3010,14 +3145,29 @@ begin end; procedure TArrayOfInt16SRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt16SRemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt16SRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt16SRemotable) then begin + src := TArrayOfInt16SRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt16URemotable } @@ -3059,14 +3209,29 @@ begin end; procedure TArrayOfInt16URemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt16URemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt16URemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt16URemotable) then begin + src := TArrayOfInt16URemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt32URemotable } @@ -3108,14 +3273,29 @@ begin end; procedure TArrayOfInt32URemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt32URemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt32URemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt32URemotable) then begin + src := TArrayOfInt32URemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt32SRemotable } @@ -3157,14 +3337,29 @@ begin end; procedure TArrayOfInt32SRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt32SRemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt32SRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt32SRemotable) then begin + src := TArrayOfInt32SRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt64SRemotable } @@ -3206,14 +3401,29 @@ begin end; procedure TArrayOfInt64SRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt64SRemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt64SRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt64SRemotable) then begin + src := TArrayOfInt64SRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfInt64URemotable } @@ -3255,14 +3465,29 @@ begin end; procedure TArrayOfInt64URemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfInt64URemotable.Assign(Source: TPersistent); +var + src : TArrayOfInt64URemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfInt64URemotable) then begin + src := TArrayOfInt64URemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfFloatSingleRemotable } @@ -3304,14 +3529,29 @@ begin end; procedure TArrayOfFloatSingleRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfFloatSingleRemotable.Assign(Source: TPersistent); +var + src : TArrayOfFloatSingleRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfFloatSingleRemotable) then begin + src := TArrayOfFloatSingleRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfFloatDoubleRemotable } @@ -3353,14 +3593,29 @@ begin end; procedure TArrayOfFloatDoubleRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfFloatDoubleRemotable.Assign(Source: TPersistent); +var + src : TArrayOfFloatDoubleRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfFloatDoubleRemotable) then begin + src := TArrayOfFloatDoubleRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfFloatExtendedRemotable } @@ -3402,14 +3657,29 @@ begin end; procedure TArrayOfFloatExtendedRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfFloatExtendedRemotable.Assign(Source: TPersistent); +var + src : TArrayOfFloatExtendedRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfFloatExtendedRemotable) then begin + src := TArrayOfFloatExtendedRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; { TArrayOfFloatCurrencyRemotable } @@ -3451,14 +3721,29 @@ begin end; procedure TArrayOfFloatCurrencyRemotable.SetLength(const ANewSize: Integer); -var - i : Integer; begin if ( ANewSize < 0 ) then - i := 0 - else - i := ANewSize; - System.SetLength(FData,i); + raise EBaseRemoteException.CreateFmt('Invalid array length : %d',[ANewSize]); + System.SetLength(FData,ANewSize); +end; + +procedure TArrayOfFloatCurrencyRemotable.Assign(Source: TPersistent); +var + src : TArrayOfFloatCurrencyRemotable; + i, c : PtrInt; +begin + if Assigned(Source) and Source.InheritsFrom(TArrayOfFloatCurrencyRemotable) then begin + src := TArrayOfFloatCurrencyRemotable(Source); + c := src.Length; + Self.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + Self[i] := src[i]; + end; + end; + end else begin + inherited Assign(Source); + end; end; @@ -3634,7 +3919,9 @@ begin Assigned(p^.SetProc) then begin case p^.PropType^.Kind of - tkInt64{$IFDEF HAS_QWORD} ,tkQWord{$ENDIF} {$IFDEF FPC} ,tkBool{$ENDIF}, tkEnumeration,tkInteger : + tkInt64{$IFDEF HAS_QWORD} ,tkQWord{$ENDIF} : + SetInt64Prop(Self,p,GetInt64Prop(Source,p^.Name)); + {$IFDEF FPC}tkBool,{$ENDIF} tkEnumeration, tkInteger : SetOrdProp(Self,p,GetOrdProp(Source,p^.Name)); tkLString{$IFDEF FPC}, tkAString{$ENDIF} : SetStrProp(Self,p,GetStrProp(Source,p^.Name)); @@ -3669,6 +3956,61 @@ begin end; end; +function TAbstractComplexRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +var + propList : PPropList; + i, propCount, propListLen : Integer; + p, sp : PPropInfo; + selfTypeInfo : PTypeInfo; + srcObj, dstObj : TObject; + ok : Boolean; +begin + Result := False; + if not Assigned(ACompareTo) then + Exit; + if not ACompareTo.InheritsFrom(Self.ClassType) then + Exit; + + ok := True; + selfTypeInfo := Self.ClassInfo; + propCount := GetTypeData(selfTypeInfo)^.PropCount; + if ( propCount > 0 ) then begin + propListLen := GetPropList(selfTypeInfo,propList); + try + for i := 0 to Pred(propCount) do begin + p := propList^[i]; + sp := GetPropInfo(Self,p^.Name); + if Assigned(sp) and Assigned(sp^.GetProc) then begin + case p^.PropType^.Kind of + tkInt64{$IFDEF HAS_QWORD} ,tkQWord{$ENDIF} : + ok := ( GetInt64Prop(Self,p^.Name) = GetInt64Prop(ACompareTo,p^.Name) ); + {$IFDEF FPC}tkBool,{$ENDIF} tkEnumeration, tkInteger : + ok := ( GetOrdProp(Self,p^.Name) = GetOrdProp(ACompareTo,p^.Name) ); + tkLString{$IFDEF FPC}, tkAString{$ENDIF} : + ok := ( GetStrProp(Self,p^.Name) = GetStrProp(ACompareTo,p^.Name) ); + tkClass : + begin + if GetTypeData(p^.PropType{$IFDEF WST_DELPHI}^{$ENDIF})^.ClassType.InheritsFrom(TBaseRemotable) then begin + srcObj := GetObjectProp(Self,p^.Name); + dstObj := GetObjectProp(ACompareTo,p^.Name); + ok := ( Assigned(srcObj) and TBaseRemotable(srcObj).Equal(TBaseRemotable(dstObj)) ) or + ( ( srcObj = nil ) and ( dstObj = nil ) ) ; + end; + end; + tkFloat : + ok := ( GetFloatProp(Self,p^.Name) = GetFloatProp(ACompareTo,p^.Name) ); + end; + if not ok then + Break; + end; + end; + finally + Freemem(propList,propListLen*SizeOf(Pointer)); + end; + end; + Result := ok; +end; + { TBaseComplexSimpleContentRemotable } class procedure TBaseComplexSimpleContentRemotable.Save( @@ -3708,7 +4050,7 @@ begin AStore.SetSerializationStyle(ssAttibuteSerialization); for i := 0 to Pred(propCount) do begin p := propList^[i]; - pt := p^.PropType{$IFNDEF FPC}^{$ENDIF}; + pt := p^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; propName := tr.ItemByTypeInfo[pt].GetExternalPropertyName(p^.Name); if IsStoredProp(AObject,p) then begin case pt^.Kind of @@ -3736,7 +4078,7 @@ begin {$ENDIF} tkEnumeration,tkInteger : begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -3777,7 +4119,7 @@ begin AStore.Put(propName,pt,enumData.ULongIntData); end; end; - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} end; @@ -3871,7 +4213,7 @@ begin p := propList^[i]; persistType := IsStoredPropClass(objTypeData^.ClassType,p); If ( persistType in [pstOptional,pstAlways] ) Then Begin - pt := p^.PropType{$IFNDEF FPC}^{$ENDIF}; + pt := p^.PropType{$IFDEF WST_DELPHI}^{$ENDIF}; propName := tr.ItemByTypeInfo[pt].GetExternalPropertyName(p^.Name); try Case pt^.Kind Of @@ -4172,6 +4514,8 @@ begin DecodeDate(ADate,y,m,d); s := IntToStr(y); buffer := IntToStr(m); + if ( Length(s) < 4 ) then + s := StringOfChar('0', ( 4 - Length(s) ) ) + s; if ( m < 10 ) then buffer := '0' + buffer; s := Format('%s-%s',[s,buffer]); @@ -4263,7 +4607,10 @@ begin ss := ReadInt(); - Result := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0); + if ( ( y + m + d + hh + mn + ss ) = 0 ) then + Result := 0 + else + Result := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0); end else begin Result := 0; end; @@ -4329,6 +4676,15 @@ begin end; end; +function TBaseDateRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +begin + Result := ( Self = ACompareTo ) or + ( Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TBaseDateRemotable) and + ( Self.AsDate = TBaseDateRemotable(ACompareTo).AsDate ) + ); +end; + { TComplexInt8SContentRemotable } class procedure TComplexInt8SContentRemotable.SaveValue( @@ -4643,6 +4999,15 @@ begin end; end; +function TStringBufferRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; +begin + Result := ( Self = ACompareTo ) or + ( Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TStringBufferRemotable) and + ( Self.Data = TStringBufferRemotable(ACompareTo).Data ) + ); +end; + { TRemotableRecordEncoder } class procedure TRemotableRecordEncoder.Save( @@ -4706,7 +5071,7 @@ begin {$ENDIF} tkEnumeration,tkInteger : begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -4721,7 +5086,7 @@ begin otSLong : AStore.Put(prpName,pt,PLongint(recFieldAddress)^); otULong : AStore.Put(prpName,pt,PLongWord(recFieldAddress)^); end; - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} end; @@ -4809,7 +5174,7 @@ begin tkRecord : AStore.Get(pt,propName,Pointer(recFieldAddress)^); tkEnumeration,tkInteger : Begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( pt^.Kind = tkEnumeration ) and ( GetTypeData(pt)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -4824,7 +5189,7 @@ begin otSLong : AStore.Get(pt,propName,PLongint(recFieldAddress)^); otULong : AStore.Get(pt,propName,PLongWord(recFieldAddress)^); end; - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} End; diff --git a/wst/trunk/base_soap_formatter.pas b/wst/trunk/base_soap_formatter.pas index d875b7316..6eae32661 100644 --- a/wst/trunk/base_soap_formatter.pas +++ b/wst/trunk/base_soap_formatter.pas @@ -17,7 +17,7 @@ interface uses Classes, SysUtils, TypInfo, Contnrs, - {$IFNDEF FPC}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF}, + {$IFDEF WST_DELPHI}xmldom, wst_delphi_xml{$ELSE}DOM{$ENDIF}, base_service_intf; const @@ -42,7 +42,7 @@ const type - TwstXMLDocument = {$IFNDEF FPC}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF}; + TwstXMLDocument = {$IFDEF WST_DELPHI}wst_delphi_xml.TXMLDocument{$ELSE}TXMLDocument{$ENDIF}; TEnumIntType = Int64; @@ -358,7 +358,7 @@ type implementation -Uses {$IFNDEF FPC}XMLDoc,XMLIntf,{$ELSE}XMLWrite, XMLRead,wst_fpc_xml,{$ENDIF} +Uses {$IFDEF WST_DELPHI}XMLDoc,XMLIntf,{$ELSE}XMLWrite, XMLRead,wst_fpc_xml,{$ENDIF} StrUtils, imp_utils; { TStackItem } @@ -409,7 +409,7 @@ end; function TObjectStackItem.FindNode(var ANodeName: string): TDOMNode; begin -{$IFNDEF FPC} +{$IFDEF WST_DELPHI} Result := wst_delphi_xml.FindNode(ScopeObject,ANodeName); {$ELSE} Result := ScopeObject.FindNode(ANodeName); @@ -847,7 +847,7 @@ procedure TSOAPBaseFormatter.GetEnum( Var locBuffer : String; begin - locBuffer := Trim(GetNodeValue(AName)); + locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName)); If IsStrEmpty(locBuffer) Then AData := 0 Else @@ -1429,7 +1429,7 @@ begin {$ENDIF} tkInteger, tkEnumeration : begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( ATypeInfo^.Kind = tkEnumeration ) and ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -1450,7 +1450,7 @@ begin PutInt64(AName,ATypeInfo,enumData) Else PutEnum(AName,ATypeInfo,enumData); - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} end; @@ -1642,7 +1642,7 @@ begin {$ENDIF} tkInteger, tkEnumeration : begin - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} if ( ATypeInfo^.Kind = tkEnumeration ) and ( GetTypeData(ATypeInfo)^.BaseType^ = TypeInfo(Boolean) ) then begin @@ -1664,7 +1664,7 @@ begin otSLong, otULong : LongInt(AData) := enumData; End; - {$IFNDEF FPC} + {$IFDEF WST_DELPHI} end; {$ENDIF} end; @@ -1850,7 +1850,7 @@ end; function TEmbeddedArrayStackItem.CreateList(const ANodeName: string): TDOMNodeList; begin if ScopeObject.HasChildNodes() then begin -{$IFNDEF FPC} +{$IFDEF WST_DELPHI} Result := FilterList(ScopeObject.childNodes,ANodeName); {$ELSE} Result := {$IFNDEF FPC_211}TDOMNodeList{$ELSE}TDOMElementList{$ENDIF}.Create(ScopeObject,ANodeName); diff --git a/wst/trunk/base_xmlrpc_formatter.pas b/wst/trunk/base_xmlrpc_formatter.pas index 4d2c5880c..a91b364bb 100644 --- a/wst/trunk/base_xmlrpc_formatter.pas +++ b/wst/trunk/base_xmlrpc_formatter.pas @@ -867,7 +867,7 @@ procedure TXmlRpcBaseFormatter.GetEnum( Var locBuffer : String; begin - locBuffer := Trim(GetNodeValue(AName)); + locBuffer := GetTypeRegistry().ItemByTypeInfo[ATypeInfo].GetInternalPropertyName(GetNodeValue(AName)); If IsStrEmpty(locBuffer) Then AData := 0 Else diff --git a/wst/trunk/indy_http_server.pas b/wst/trunk/indy_http_server.pas index ad21d6837..f00a26586 100644 --- a/wst/trunk/indy_http_server.pas +++ b/wst/trunk/indy_http_server.pas @@ -102,6 +102,14 @@ uses server_service_intf, server_service_imputils, metadata_wsdl; +{$IFDEF WST_DBG} +procedure Display(const AMsg : string); +begin + if IsConsole then + WriteLn(AMsg); +end; +{$ENDIF} + function ExtractNextPathElement(var AFullPath : string):string; var i : SizeInt; diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.cfg b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.cfg new file mode 100644 index 000000000..3215ee3f4 --- /dev/null +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.cfg @@ -0,0 +1,43 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-N"obj" +-LE"c:\program files\borland\delphi7\Projects\Bpl" +-LN"c:\program files\borland\delphi7\Projects\Bpl" +-U"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-O"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-I"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-R"..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof new file mode 100644 index 000000000..a40901640 --- /dev/null +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dof @@ -0,0 +1,160 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir=obj +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOfficeXP;Rave70VCL;Rave70CLX;Jcl;JclVcl;JvCoreD7R;JvSystemD7R;JvStdCtrlsD7R;JvAppFrmD7R;JvBandsD7R;JvDBD7R;JvDlgsD7R;JvBDED7R;JvCmpD7R;JvCryptD7R;JvCtrlsD7R;JvCustomD7R;JvDockingD7R;JvDotNetCtrlsD7R;JvEDID7R;JvGlobusD7R;JvHMID7R;JvInterpreterD7R;JvJansD7R;JvManagedThreadsD7R;JvMMD7R;JvNetD7R;JvPageCompsD7R;JvPluginD7R;JvPrintPreviewD7R;JvRuntimeDesignD7R;JvTimeFrameworkD7R;JvUIBD7R;JvValidatorsD7R;JvWizardD7R;JvXPCtrlsD7R;FIBDBMidas7;daADPhysADSD7;daADPhysODBCD7;daADPhysD7;daADComID7;daADPhysDBExpD7;daADPhysASAD7;daADPhysOraclD7;daADPhysMySQLD7;daADPhysDb2D7;daADPhysMSSQLD7;daADPhysMSAccD7;daADGUIxFormsD7;daADCompD7;CRControls70;dac70;dacvcl70;odacvcl70;odac70;oraprov70;dxGDIPlusD7;cxLibraryVCLD7;dxsbD7;dxComnD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridD7;cxSchedulerVCLD7;cxTreeListVCLD7;cxVerticalGridVCLD7;cxPivotGridD7;cxSpreadSheetVCLD7;dxDockingD7;dxNavBarD7;dxLayoutControlD7;dxLayoutControlcxEditAdaptersD7;cxWebD7;cxWebPascalScriptD7;cxWebSnapD7;cxWebTeeChartD7;dxMasterViewD7;dxmdsD7;dxdbtrD7;dxtrmdD7;dxorgcD7;dxdborD7;dxFlowChartD7;dxPSCoreD7;dxPSLnksD7;dxPScxCommonD7;dxPScxGrid6LnkD7;dxPScxPCProdD7;dxPScxPivotGridLnkD7;dxPScxScheduler2LnkD7;dxPScxSSLnkD7;dxPScxTLLnkD7;dxPScxVGridLnkD7;dxPSTeeChartD7;dxPSdxOCLnkD7;dxPSdxDBTVLnkD7;dxPSdxFCLnkD7;dxPSdxLCLnkD7;dxPSdxMVLnkD7;dxPSdxDBOCLnkD7;dxPScxExtCommonD7;dxPsPrVwAdvD7;dxBarExtItemsD7;dxBarD7;dxPSDBTeeChartD7;cxBarEditItemD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxRibbonD7;S403_r70;S403br70 +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1036 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlConditionals] +Count=1 +Item0=DUnit +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=13 +Item0=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;..\..\..\ws_helper;..\..\..\wst_rtti_filter;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item1=..\;..\..\;..\..\..\;..\..\..\fcl-units\fcl-passrc\src;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\ws_helper +Item2=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;..\..\..\fcl-units\fcl-passrc\src +Item3=..\;..\..\;..\..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item4=..\;..\..\;..\..\..\;C:\Programmes\lazarus\wst\trunk\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item5=..\;..\..\;..\..\..\;..\..\ws_helper;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item6=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item7=..\;..\..\;..\..\..\;..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src;C:\Programmes\lazarus\wst\trunk\ws_helper +Item8=..\;..\..\;..\..\..\;..\..\..\ws_helper\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item9=..\;..\..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item10=..\;C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item11=C:\Program Files\Borland\Delphi7\plate_forme\dunit\dunit-9.3.0\src +Item12=..\ +[HistoryLists\hlUnitOutputDirectory] +Count=1 +Item0=obj diff --git a/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr new file mode 100644 index 000000000..be84781f0 --- /dev/null +++ b/wst/trunk/tests/test_suite/delphi/gui_wst_test_suite.dpr @@ -0,0 +1,21 @@ +program gui_wst_test_suite; + +uses + TestFramework, + Forms, + GUITestRunner, + TextTestRunner, + delphi_init_com, + testmetadata_unit in '..\testmetadata_unit.pas', + test_parsers in '..\test_parsers.pas', + test_support in '..\test_support.pas', + test_utilities in '..\test_utilities.pas', + testformatter_unit in '..\testformatter_unit.pas', + base_service_intf in '..\..\..\base_service_intf.pas'; + +{$R *.res} + +begin + Application.Initialize; + GUITestRunner.RunRegisteredTests; +end. diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof index 769818b54..d83f6c45d 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dof @@ -134,14 +134,6 @@ OriginalFilename= ProductName= ProductVersion=1.0.0.0 Comments= -[Excluded Packages] -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBTLLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumDBTreeList by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxDBGrLnkD7.bpl=ExpressPrinting System ReportLink for ExpressQuantumGrid by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxInsLnkD7.bpl=ExpressPrinting System ReportLink for ExpressInspector by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxOILnkD7.bpl=ExpressPrinting System ReportLink for ExpressRTTIInspector by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxMVLnkD7.bpl=ExpressPrinting System ReportLink for ExpressMasterView by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPSdxFCLnkD7.bpl=ExpressPrinting System ReportLinks for ExpressFlowChart by Developer Express Inc. -C:\Program Files\Developer Express Inc\ExpressPrinting System\Delphi 7\Lib\dxPScxSSLnkD7.bpl=ExpressPrinting System ReportLink for ExpressSpreadSheet by Developer Express Inc. [HistoryLists\hlConditionals] Count=1 Item0=DUnit diff --git a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr index 4d095845e..e1175ae6c 100644 --- a/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr +++ b/wst/trunk/tests/test_suite/delphi/wst_test_suite.dpr @@ -8,7 +8,8 @@ uses test_utilities in '..\test_utilities.pas', testformatter_unit in '..\testformatter_unit.pas', test_parsers in '..\test_parsers.pas', - testmetadata_unit; + testmetadata_unit, + test_support in '..\test_support.pas'; {$R *.res} diff --git a/wst/trunk/tests/test_suite/test_support.pas b/wst/trunk/tests/test_suite/test_support.pas new file mode 100644 index 000000000..df6d54520 --- /dev/null +++ b/wst/trunk/tests/test_suite/test_support.pas @@ -0,0 +1,2321 @@ +{ This file is part of the Web Service Toolkit + Copyright (c) 2006, 2007 by Inoussa OUEDRAOGO + + This file is provide under modified LGPL licence + ( the files COPYING.modifiedLGPL and COPYING.LGPL). + + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +} +{$INCLUDE wst_global.inc} +unit test_support; + +interface + +uses + Classes, SysUtils, +{$IFDEF FPC} + fpcunit, testregistry, +{$ELSE} + TestFrameWork, +{$ENDIF} + TypInfo, + wst_types, base_service_intf; + +type + + TTestEnum = ( teOne, teTwo, teThree, teFour ); + + { TClass_B } + + TClass_B = class(TBaseComplexRemotable) + private + FVal_32S: LongInt; + FVal_32U: LongWord; + FVal_64S: Int64; + FVal_64U: QWord; + FVal_8S: ShortInt; + FVal_8U: Byte; + FVal_16S: SmallInt; + FVal_16U: Word; + FVal_Bool: Boolean; + FVal_Enum: TTestEnum; + FVal_String: string; + Published + property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + + property Val_8U : Byte Read FVal_8U Write FVal_8U; + property Val_8S : ShortInt Read FVal_8S Write FVal_8S; + property Val_16U : Word Read FVal_16U Write FVal_16U; + property Val_16S : SmallInt Read FVal_16S Write FVal_16S; + property Val_32U : LongWord Read FVal_32U Write FVal_32U; + property Val_32S : LongInt Read FVal_32S Write FVal_32S; + property Val_64U : QWord Read FVal_64U Write FVal_64U; + property Val_64S : Int64 Read FVal_64S Write FVal_64S; + End; + + { TClass_A } + + TClass_A = class(TBaseComplexRemotable) + private + FVal_32S: LongInt; + FVal_32U: LongWord; + FVal_64S: Int64; + FVal_64U: QWord; + FVal_8S: ShortInt; + FVal_8U: Byte; + FVal_16S: SmallInt; + FVal_16U: Word; + FVal_Bool: Boolean; + FVal_Enum: TTestEnum; + FVal_Obj: TClass_B; + FVal_String: string; + FVal_StringArray: TArrayOfStringRemotable; + public + constructor Create();override; + destructor Destroy();override; + Published + property Val_Enum : TTestEnum Read FVal_Enum Write FVal_Enum; + property Val_Bool : Boolean Read FVal_Bool Write FVal_Bool; + property Val_String : string Read FVal_String Write FVal_String; + + property Val_8U : Byte Read FVal_8U Write FVal_8U; + property Val_8S : ShortInt Read FVal_8S Write FVal_8S; + property Val_16U : Word Read FVal_16U Write FVal_16U; + property Val_16S : SmallInt Read FVal_16S Write FVal_16S; + property Val_32U : LongWord Read FVal_32U Write FVal_32U; + property Val_32S : LongInt Read FVal_32S Write FVal_32S; + property Val_64U : QWord Read FVal_64U Write FVal_64U; + property Val_64S : Int64 Read FVal_64S Write FVal_64S; + + property Val_Obj : TClass_B read FVal_Obj write FVal_Obj; + property Val_StringArray : TArrayOfStringRemotable read FVal_StringArray write FVal_StringArray; + End; + + TArrayOfClass_A = 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; + + { TTest_TBaseComplexRemotable } + + TTest_TBaseComplexRemotable = class(TTestCase) + protected + procedure Compare(const a,b : TClass_A);overload; + procedure Compare(const a,b : TClass_B);overload; + published + procedure test_Assign(); + procedure Equal(); + end; + + { TTest_TBaseArrayRemotable } + + TTest_TBaseArrayRemotable = class(TTestCase) + protected + class function CreateArray() : TBaseArrayRemotable;virtual;abstract; + class function GetTypeInfo() : PTypeInfo;virtual;abstract; + published + procedure Length_procs(); + procedure GetItemTypeInfo(); + end; + + { TTest_TArrayOfStringRemotable } + + TTest_TArrayOfStringRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + procedure Equal(); + end; + + { TTest_TArrayOfBooleanRemotable } + + TTest_TArrayOfBooleanRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt8URemotable } + + TTest_TArrayOfInt8URemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt8SRemotable } + + TTest_TArrayOfInt8SRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt16SRemotable } + + TTest_TArrayOfInt16SRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt16URemotable } + + TTest_TArrayOfInt16URemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt32URemotable } + + TTest_TArrayOfInt32URemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt32SRemotable } + + TTest_TArrayOfInt32SRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt64SRemotable } + + TTest_TArrayOfInt64SRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfInt64URemotable } + + TTest_TArrayOfInt64URemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfFloatSingleRemotable } + + TTest_TArrayOfFloatSingleRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfFloatDoubleRemotable } + + TTest_TArrayOfFloatDoubleRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfFloatExtendedRemotable } + + TTest_TArrayOfFloatExtendedRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TArrayOfFloatCurrencyRemotable } + + TTest_TArrayOfFloatCurrencyRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + published + procedure test_Assign(); + procedure GetItemAndSetItem(); + end; + + { TTest_TBaseObjectArrayRemotable } + + TTest_TBaseObjectArrayRemotable = class(TTest_TBaseArrayRemotable) + protected + class function CreateArray() : TBaseArrayRemotable;override; + class function GetTypeInfo() : PTypeInfo;override; + class procedure FillRandomItem(const AItem : TBaseRemotable); + procedure CompareItem(const A,B : TBaseRemotable); + procedure Compare(const a,b : TClass_A);overload; + procedure Compare(const a,b : TClass_B);overload; + published + procedure test_Assign(); + procedure Equal(); + end; + + { TTest_TDateRemotable } + + TTest_TDateRemotable = class(TTestCase) + published + procedure FormatDate(); + procedure FormatDate_ZERO(); + procedure ParseDate(); + procedure Assign(); + procedure Equal(); + end; + + { TTest_TDurationRemotable } + + TTest_TDurationRemotable = class(TTestCase) + published + procedure FormatDate(); + procedure ParseDate(); + end; + + { TTest_TTimeRemotable } + + TTest_TTimeRemotable = class(TTestCase) + published + procedure FormatDate(); + procedure ParseDate(); + end; + + { TTest_TStringBufferRemotable } + + TTest_TStringBufferRemotable = class(TTestCase) + published + procedure test_Assign(); + procedure Equal(); + end; + +implementation +uses Math; + +function RandomValue(const AMaxlen: Integer): ansistring; +var + k : Integer; +begin + SetLength(Result,AMaxlen); + for k := 1 to AMaxlen do begin + Result[k] := Char((Random(Ord(High(Char))))); + end; +end; + +{ TArrayOfClass_A } + +function TArrayOfClass_A.GetItem(AIndex: Integer): TClass_A; +begin + Result := Inherited GetItem(AIndex) As TClass_A; +end; + +class function TArrayOfClass_A.GetItemClass(): TBaseRemotableClass; +begin + Result:= TClass_A; +end; + +{ TTest_TBaseArrayRemotable } + +procedure TTest_TBaseArrayRemotable.Length_procs(); +const ITER : Integer = 1000; +var + localObj : TBaseArrayRemotable; + i : Integer; + ok : Boolean; +begin + localObj := CreateArray(); + try + CheckEquals(0,localObj.Length); + CheckEquals(0,localObj.Length); + + localObj.SetLength(0); + CheckEquals(0,localObj.Length); + + ok := False; + try + localObj.SetLength(-10); + except + on e : EBaseRemoteException do + ok := True; + end; + CheckEquals(True,ok); + + localObj.SetLength(ITER); + CheckEquals(ITER,localObj.Length); + + for i := 0 to ITER do begin + localObj.SetLength(i); + CheckEquals(i,localObj.Length); + end; + finally + FreeAndNil(localObj); + end; +end; + +procedure TTest_TBaseArrayRemotable.GetItemTypeInfo(); +var + localObj : TBaseArrayRemotable; + a, b : PTypeInfo; +begin + localObj := CreateArray(); + try + a := GetTypeInfo(); + b := localObj.GetItemTypeInfo(); + CheckEquals(a^.Name,b^.Name); + CheckEquals(Ord(a^.Kind),Ord(b^.Kind)); + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfStringRemotable } + +class function TTest_TArrayOfStringRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfStringRemotable.Create(); +end; + +class function TTest_TArrayOfStringRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(ansistring); +end; + +procedure TTest_TArrayOfStringRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfStringRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfStringRemotable.Create(); + try + b := TArrayOfStringRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := RandomValue(Random(500)); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfStringRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfStringRemotable; + i, j, k : Integer; + a : array of ansistring; +begin + localObj := TArrayOfStringRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := RandomValue(Random(500)); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +procedure TTest_TArrayOfStringRemotable.Equal(); +const ITER : Integer = 100; +var + a, b : TArrayOfStringRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfStringRemotable.Create(); + try + b := TArrayOfStringRemotable.Create(); + + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + b.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := RandomValue(1 + Random(500)); + CheckEquals(False,a.Equal(b)); + CheckEquals(False,b.Equal(a)); + b[k] := a[k]; + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +{ TTest_TBaseComplexRemotable } + +procedure TTest_TBaseComplexRemotable.Compare(const a, b: TClass_A); +var + i, c : Integer; +begin + CheckEquals(True, a.Val_64S = b.Val_64S); + CheckEquals(True, a.Val_64U = b.Val_64U); + + CheckEquals(a.Val_32S,b.Val_32S); + CheckEquals(a.Val_32U,b.Val_32U); + + CheckEquals(a.Val_16S,b.Val_16S); + CheckEquals(a.Val_16U,b.Val_16U); + + CheckEquals(a.Val_8S,b.Val_8S); + CheckEquals(a.Val_8U,b.Val_8U); + + CheckEquals(a.Val_String,b.Val_String); + CheckEquals(a.Val_Bool,b.Val_Bool); + CheckEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); + + Compare(a.Val_Obj,b.Val_Obj); + Check( + ( ( a.Val_StringArray <> nil ) and ( b.Val_StringArray <> nil ) ) or + ( ( a.Val_StringArray = nil ) and ( b.Val_StringArray = nil ) ) + ); + if ( a.Val_StringArray <> nil ) then begin + c := a.Val_StringArray.Length; + for i := 0 to Pred(c) do begin + CheckEquals(a.Val_StringArray[i],b.Val_StringArray[i]); + end; + end; +end; + +procedure TTest_TBaseComplexRemotable.Compare(const a, b: TClass_B); +begin + CheckEquals(a.Val_64S,b.Val_64S); + CheckEquals(a.Val_64U,b.Val_64U); + + CheckEquals(a.Val_32S,b.Val_32S); + CheckEquals(a.Val_32U,b.Val_32U); + + CheckEquals(a.Val_16S,b.Val_16S); + CheckEquals(a.Val_16U,b.Val_16U); + + CheckEquals(a.Val_8S,b.Val_8S); + CheckEquals(a.Val_8U,b.Val_8U); + + CheckEquals(a.Val_String,b.Val_String); + CheckEquals(a.Val_Bool,b.Val_Bool); + CheckEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); +end; + +procedure TTest_TBaseComplexRemotable.test_Assign(); +const ITER = 100; +var + a, b : TClass_A; + i : Integer; +begin + a := TClass_A.Create(); + try + b := TClass_A.Create(); + b.Assign(a); + Compare(a,b); + + a.Val_64S := Random(1210); + a.Val_64U := Random(1210); + + a.Val_32S := Random(1210); + a.Val_32U := Random(1210); + + a.Val_16S := Random(1210); + a.Val_16U := Random(1210); + + a.Val_8S := Random(123); + a.Val_8U := Random(123); + + a.Val_Enum := teThree; + a.Val_Bool := True; + a.Val_String := RandomValue(100); + + a.Val_Obj.Val_64S := Random(1210); + a.Val_Obj.Val_64U := Random(1210); + + a.Val_Obj.Val_32S := Random(1210); + a.Val_Obj.Val_32U := Random(1210); + + a.Val_Obj.Val_16S := Random(1210); + a.Val_Obj.Val_16U := Random(1210); + + a.Val_Obj.Val_8S := Random(123); + a.Val_Obj.Val_8U := Random(123); + + a.Val_Obj.Val_Enum := teTwo; + a.Val_Obj.Val_Bool := True; + a.Val_Obj.Val_String := RandomValue(250); + + a.Val_StringArray.SetLength(ITER); + for i := 0 to Pred(ITER) do begin + a.Val_StringArray[i] := RandomValue(Random(123)); + end; + + b.Assign(a); + Compare(a,b); + finally + FreeAndNil(b); + FreeAndNil(a); + end; +end; + +procedure TTest_TBaseComplexRemotable.Equal(); +const ITER = 100; +var + a, b : TClass_A; + cc : TClass_B; + i : Integer; +begin + b:= nil; + cc := nil; + a := TClass_A.Create(); + try + b := TClass_A.Create(); + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + CheckEquals(False,a.Equal(nil)); + + cc := TClass_B.Create(); + CheckEquals(False,a.Equal(cc)); + CheckEquals(False,cc.Equal(a)); + + a.Val_64S := Random(1210); + a.Val_64U := Random(1210); + b.Val_64S := a.Val_64S; + b.Val_64U := a.Val_64U; + + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + + a.Val_32S := Random(1210); + a.Val_32U := Random(1210); + + a.Val_16S := Random(1210); + a.Val_16U := Random(1210); + + a.Val_8S := Random(123); + a.Val_8U := Random(123); + + a.Val_Enum := teThree; + a.Val_Bool := True; + a.Val_String := RandomValue(100); + + a.Val_Obj.Val_64S := Random(1210); + a.Val_Obj.Val_64U := Random(1210); + + a.Val_Obj.Val_32S := Random(1210); + a.Val_Obj.Val_32U := Random(1210); + + a.Val_Obj.Val_16S := Random(1210); + a.Val_Obj.Val_16U := Random(1210); + + a.Val_Obj.Val_8S := Random(123); + a.Val_Obj.Val_8U := Random(123); + + a.Val_Obj.Val_Enum := teTwo; + a.Val_Obj.Val_Bool := True; + a.Val_Obj.Val_String := RandomValue(250); + + a.Val_StringArray.SetLength(ITER); + for i := 0 to Pred(ITER) do begin + a.Val_StringArray[i] := RandomValue(Random(123)); + end; + CheckEquals(False,a.Equal(b)); + CheckEquals(False,b.Equal(a)); + + b.Assign(a); + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + finally + FreeAndNil(cc); + FreeAndNil(b); + FreeAndNil(a); + end; +end; + +{ TClass_A } + +constructor TClass_A.Create(); +begin + inherited; + FVal_Obj := TClass_B.Create(); + FVal_StringArray := TArrayOfStringRemotable.Create(); +end; + +destructor TClass_A.Destroy(); +begin + FreeAndNil(FVal_StringArray); + FreeAndNil(FVal_Obj); + inherited Destroy(); +end; + +{ TTest_TBaseObjectArrayRemotable } + +class function TTest_TBaseObjectArrayRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfClass_A.Create(); +end; + +class function TTest_TBaseObjectArrayRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(TClass_A); +end; + +class procedure TTest_TBaseObjectArrayRemotable.FillRandomItem(const AItem: TBaseRemotable); +var + a : TClass_A; + i, c : Integer; +begin + Randomize(); + a := AItem as TClass_A; + + a.Val_64S := Random(1210); + a.Val_64U := Random(1210); + + a.Val_32S := Random(1210); + a.Val_32U := Random(1210); + + a.Val_16S := Random(1210); + a.Val_16U := Random(1210); + + a.Val_8S := Random(123); + a.Val_8U := Random(123); + + a.Val_Enum := teThree; + a.Val_Bool := True; + a.Val_String := RandomValue(100); + + a.Val_Obj.Val_64S := Random(1210); + a.Val_Obj.Val_64U := Random(1210); + + a.Val_Obj.Val_32S := Random(1210); + a.Val_Obj.Val_32U := Random(1210); + + a.Val_Obj.Val_16S := Random(1210); + a.Val_Obj.Val_16U := Random(1210); + + a.Val_Obj.Val_8S := Random(123); + a.Val_Obj.Val_8U := Random(123); + + a.Val_Obj.Val_Enum := teTwo; + a.Val_Obj.Val_Bool := True; + a.Val_Obj.Val_String := RandomValue(250); + + c := Random(200); + a.Val_StringArray.SetLength(c); + if ( c > 0 ) then begin + for i := 0 to Pred(c) do begin + a.Val_StringArray[i] := RandomValue(Random(500)); + end; + end; +end; + +procedure TTest_TBaseObjectArrayRemotable.CompareItem(const A, B: TBaseRemotable); +begin + Compare(A as TClass_A, B as TClass_A); +end; + +procedure TTest_TBaseObjectArrayRemotable.Compare(const a, b: TClass_A); +var + i, c : Integer; +begin + CheckEquals(a.Val_64S,b.Val_64S); + CheckEquals(a.Val_64U,b.Val_64U); + + CheckEquals(a.Val_32S,b.Val_32S); + CheckEquals(a.Val_32U,b.Val_32U); + + CheckEquals(a.Val_16S,b.Val_16S); + CheckEquals(a.Val_16U,b.Val_16U); + + CheckEquals(a.Val_8S,b.Val_8S); + CheckEquals(a.Val_8U,b.Val_8U); + + CheckEquals(a.Val_String,b.Val_String); + CheckEquals(a.Val_Bool,b.Val_Bool); + CheckEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); + + Compare(a.Val_Obj,b.Val_Obj); + Check( + ( ( a.Val_StringArray <> nil ) and ( b.Val_StringArray <> nil ) ) or + ( ( a.Val_StringArray = nil ) and ( b.Val_StringArray = nil ) ) + ); + if ( a.Val_StringArray <> nil ) then begin + c := a.Val_StringArray.Length; + for i := 0 to Pred(c) do begin + CheckEquals(a.Val_StringArray[i],b.Val_StringArray[i]); + end; + end; +end; + +procedure TTest_TBaseObjectArrayRemotable.Compare(const a, b: TClass_B); +begin + CheckEquals(a.Val_64S,b.Val_64S); + CheckEquals(a.Val_64U,b.Val_64U); + + CheckEquals(a.Val_32S,b.Val_32S); + CheckEquals(a.Val_32U,b.Val_32U); + + CheckEquals(a.Val_16S,b.Val_16S); + CheckEquals(a.Val_16U,b.Val_16U); + + CheckEquals(a.Val_8S,b.Val_8S); + CheckEquals(a.Val_8U,b.Val_8U); + + CheckEquals(a.Val_String,b.Val_String); + CheckEquals(a.Val_Bool,b.Val_Bool); + CheckEquals(Ord(a.Val_Enum),Ord(b.Val_Enum)); +end; + +procedure TTest_TBaseObjectArrayRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TBaseObjectArrayRemotable; + i, j, k : Integer; +begin + Randomize(); + a := CreateArray() as TBaseObjectArrayRemotable; + try + b := CreateArray() as TBaseObjectArrayRemotable; + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(20); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + FillRandomItem(a.Item[k]); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CompareItem(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CompareItem(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TBaseObjectArrayRemotable.Equal(); +const ITER : Integer = 100; +var + a, b : TBaseObjectArrayRemotable; + aa : TClass_A; + i, j, k : Integer; +begin + Randomize(); + aa := nil; + a := CreateArray() as TBaseObjectArrayRemotable; + try + b := CreateArray() as TBaseObjectArrayRemotable; + aa := TClass_A.Create(); + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + CheckEquals(False,a.Equal(nil)); + CheckEquals(False,a.Equal(aa)); + CheckEquals(False,aa.Equal(a)); + + for i := 1 to ITER do begin + Randomize(); + j := Random(20); + FreeAndNil(a); + FreeAndNil(b); + a := CreateArray() as TBaseObjectArrayRemotable; + b := CreateArray() as TBaseObjectArrayRemotable; + a.SetLength(j); + b.SetLength(j); + if ( j > 0 ) then begin + TClass_A(b.Item[0]).Val_String := 'azertyqwerty'; + for k := 0 to Pred(j) do begin + //FillRandomItem(a.Item[k]); + //FillRandomItem(b.Item[k]); + //CheckEquals(False,b.Equal(a), '1111'); + //CheckEquals(False,a.Equal(b), '2222'); + b.Item[k].Assign(a.Item[k]); + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + end; + end; + end; + finally + FreeAndNil(aa); + FreeAndNil(a); + FreeAndNil(b); + end; +end; + + +{ TTest_TArrayOfBooleanRemotable } + +class function TTest_TArrayOfBooleanRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result:= TArrayOfBooleanRemotable.Create(); +end; + +class function TTest_TArrayOfBooleanRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Boolean); +end; + +procedure TTest_TArrayOfBooleanRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfBooleanRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfBooleanRemotable.Create(); + try + b := TArrayOfBooleanRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := ( ( k mod 3 ) = 0 ); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfBooleanRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfBooleanRemotable; + i, j, k : Integer; + a : array of Boolean; +begin + localObj := TArrayOfBooleanRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := ( ( k mod 5 ) = 1 ); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt8URemotable } + +class function TTest_TArrayOfInt8URemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt8URemotable.Create(); +end; + +class function TTest_TArrayOfInt8URemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Byte); +end; + +procedure TTest_TArrayOfInt8URemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt8URemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt8URemotable.Create(); + try + b := TArrayOfInt8URemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Byte) - 1); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt8URemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt8URemotable; + i, j, k : Integer; + a : array of Byte; +begin + Randomize(); + localObj := TArrayOfInt8URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Byte) - 1 ); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt8SRemotable } + +class function TTest_TArrayOfInt8SRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt8SRemotable.Create(); +end; + +class function TTest_TArrayOfInt8SRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(ShortInt); +end; + +procedure TTest_TArrayOfInt8SRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt8SRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt8SRemotable.Create(); + try + b := TArrayOfInt8SRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(ShortInt) - 1) + else + a[k] := -Random(High(ShortInt) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt8SRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt8SRemotable; + i, j, k : Integer; + a : array of ShortInt; +begin + Randomize(); + localObj := TArrayOfInt8SRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(ShortInt) -1); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt16SRemotable } + +class function TTest_TArrayOfInt16SRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt16SRemotable.Create(); +end; + +class function TTest_TArrayOfInt16SRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(SmallInt); +end; + +procedure TTest_TArrayOfInt16SRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt16SRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt16SRemotable.Create(); + try + b := TArrayOfInt16SRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(SmallInt) -1) + else + a[k] := -Random(High(SmallInt) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt16SRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt16SRemotable; + i, j, k : Integer; + a : array of SmallInt; +begin + Randomize(); + localObj := TArrayOfInt16SRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(SmallInt) -1 ) + else + a[k] := -Random(High(SmallInt) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt16URemotable } + +class function TTest_TArrayOfInt16URemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt16URemotable.Create(); +end; + +class function TTest_TArrayOfInt16URemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Word); +end; + +procedure TTest_TArrayOfInt16URemotable.test_Assign(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt16URemotable; + i, j, k : Integer; + a : array of Word; +begin + Randomize(); + localObj := TArrayOfInt16URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Word)-1); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +procedure TTest_TArrayOfInt16URemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt16URemotable; + i, j, k : Integer; + a : array of Word; +begin + Randomize(); + localObj := TArrayOfInt16URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Word)-1); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt32URemotable } + +class function TTest_TArrayOfInt32URemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt32URemotable.Create(); +end; + +class function TTest_TArrayOfInt32URemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(LongWord); +end; + +procedure TTest_TArrayOfInt32URemotable.test_Assign(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt32URemotable; + i, j, k : Integer; + a : array of LongWord; +begin + Randomize(); + localObj := TArrayOfInt32URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(LongWord)-2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +procedure TTest_TArrayOfInt32URemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt32URemotable; + i, j, k : Integer; + a : array of LongWord; +begin + Randomize(); + localObj := TArrayOfInt32URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(LongWord)-1); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt32SRemotable } + +class function TTest_TArrayOfInt32SRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt32SRemotable.Create(); +end; + +class function TTest_TArrayOfInt32SRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(LongInt); +end; + +procedure TTest_TArrayOfInt32SRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt32SRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt32SRemotable.Create(); + try + b := TArrayOfInt32SRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(LongInt) -1) + else + a[k] := -Random(High(LongInt) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(a[k],b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + CheckEquals(b[k],a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt32SRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt32SRemotable; + i, j, k : Integer; + a : array of LongInt; +begin + Randomize(); + localObj := TArrayOfInt32SRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(LongInt) -1 ) + else + a[k] := -Random(High(LongInt) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + CheckEquals(a[k],localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt64SRemotable } + +class function TTest_TArrayOfInt64SRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt64SRemotable.Create(); +end; + +class function TTest_TArrayOfInt64SRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Int64); +end; + +procedure TTest_TArrayOfInt64SRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt64SRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt64SRemotable.Create(); + try + b := TArrayOfInt64SRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1) + else + a[k] := -Random(High(Int64) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(a[k] = b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(b[k] = a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt64SRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt64SRemotable; + i, j, k : Integer; + a : array of Int64; +begin + Randomize(); + localObj := TArrayOfInt64SRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1 ) + else + a[k] := -Random(High(Int64) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(a[k] = localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfInt64URemotable } + +class function TTest_TArrayOfInt64URemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfInt64URemotable.Create(); +end; + +class function TTest_TArrayOfInt64URemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(QWord); +end; + +procedure TTest_TArrayOfInt64URemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfInt64URemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfInt64URemotable.Create(); + try + b := TArrayOfInt64URemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Integer) -1); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(a[k] = b[k]); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(b[k] = a[k]); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfInt64URemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfInt64URemotable; + i, j, k : Integer; + a : array of QWord; +begin + Randomize(); + localObj := TArrayOfInt64URemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + a[k] := Random(High(Integer) -1 ); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(a[k] = localObj[k]); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfFloatSingleRemotable } + +class function TTest_TArrayOfFloatSingleRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfFloatSingleRemotable.Create(); +end; + +class function TTest_TArrayOfFloatSingleRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Single); +end; + +procedure TTest_TArrayOfFloatSingleRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfFloatSingleRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfFloatSingleRemotable.Create(); + try + b := TArrayOfFloatSingleRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1) + else + a[k] := -Random(High(Int64) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(a[k],b[k])); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(b[k],a[k])); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfFloatSingleRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfFloatSingleRemotable; + i, j, k : Integer; + a : array of Single; +begin + Randomize(); + localObj := TArrayOfFloatSingleRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1 ) + else + a[k] := -Random(High(Int64) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(SameValue(a[k], localObj[k])); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfFloatDoubleRemotable } + +class function TTest_TArrayOfFloatDoubleRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfFloatDoubleRemotable.Create(); +end; + +class function TTest_TArrayOfFloatDoubleRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Double); +end; + +procedure TTest_TArrayOfFloatDoubleRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfFloatDoubleRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfFloatDoubleRemotable.Create(); + try + b := TArrayOfFloatDoubleRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1) + else + a[k] := -Random(High(Int64) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(a[k],b[k])); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(b[k],a[k])); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfFloatDoubleRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfFloatDoubleRemotable; + i, j, k : Integer; + a : array of Double; +begin + Randomize(); + localObj := TArrayOfFloatDoubleRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1 ) + else + a[k] := -Random(High(Int64) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(SameValue(a[k], localObj[k])); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfFloatExtendedRemotable } + +class function TTest_TArrayOfFloatExtendedRemotable.CreateArray(): TBaseArrayRemotable; +begin + Result := TArrayOfFloatExtendedRemotable.Create(); +end; + +class function TTest_TArrayOfFloatExtendedRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Extended); +end; + +procedure TTest_TArrayOfFloatExtendedRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfFloatExtendedRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfFloatExtendedRemotable.Create(); + try + b := TArrayOfFloatExtendedRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1) + else + a[k] := -Random(High(Int64) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(a[k],b[k])); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(b[k],a[k])); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfFloatExtendedRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfFloatExtendedRemotable; + i, j, k : Integer; + a : array of Extended; +begin + Randomize(); + localObj := TArrayOfFloatExtendedRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Int64) -1 ) + else + a[k] := -Random(High(Int64) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(SameValue(a[k], localObj[k])); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TArrayOfFloatCurrencyRemotable } + +class function TTest_TArrayOfFloatCurrencyRemotable.CreateArray( ): TBaseArrayRemotable; +begin + Result := TArrayOfFloatCurrencyRemotable.Create(); +end; + +class function TTest_TArrayOfFloatCurrencyRemotable.GetTypeInfo(): PTypeInfo; +begin + Result := TypeInfo(Currency); +end; + +procedure TTest_TArrayOfFloatCurrencyRemotable.test_Assign(); +const ITER : Integer = 100; +var + a, b : TArrayOfFloatCurrencyRemotable; + i, j, k : Integer; +begin + Randomize(); + a := TArrayOfFloatCurrencyRemotable.Create(); + try + b := TArrayOfFloatCurrencyRemotable.Create(); + a.Assign(nil); + + for i := 1 to ITER do begin + j := Random(ITER); + a.SetLength(j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Integer) -1) + else + a[k] := -Random(High(Integer) - 2); + end; + end; + b.Assign(a); + CheckEquals(a.Length,b.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(a[k],b[k],0.0001)); + end; + end; + + a.SetLength(0); + a.Assign(b); + CheckEquals(b.Length,a.Length, 'Length'); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + Check(SameValue(b[k],a[k],0.0001)); + end; + end; + end; + finally + FreeAndNil(a); + FreeAndNil(b); + end; +end; + +procedure TTest_TArrayOfFloatCurrencyRemotable.GetItemAndSetItem(); +const ITER : Integer = 100; +var + localObj : TArrayOfFloatCurrencyRemotable; + i, j, k : Integer; + a : array of Currency; +begin + Randomize(); + localObj := TArrayOfFloatCurrencyRemotable.Create() ; + try + for i := 1 to ITER do begin + j := Random(ITER); + SetLength(a,j); + if ( j > 0 ) then begin + for k := 0 to Pred(j) do begin + if ( ( k mod 2 ) = 0 ) then + a[k] := Random(High(Integer) -1 ) + else + a[k] := -Random(High(Integer) -2); + end; + + localObj.SetLength(j); + for k := 0 to Pred(j) do begin + localObj[k] := a[k]; + end; + for k := 0 to Pred(j) do begin + Check(SameValue(a[k], localObj[k], 0.0001)); + end; + end; + end; + finally + FreeAndNil(localObj); + end; +end; + +{ TTest_TDateRemotable } + +procedure TTest_TDateRemotable.FormatDate(); +const + sDATE_1 = '1976-10-12T23:34:56'; + sDATE_2 = '0987-06-12T20:34:56'; +var + d : TDateTime; +begin + //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? + d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,0); + CheckEquals(sDATE_1, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE_1))); + + d := EncodeDate(987,06,12) - EncodeTime(20,34,56,0); + CheckEquals(sDATE_2, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE_2))); +end; + +procedure TTest_TDateRemotable.ParseDate(); +const sDATE = '1976-10-12T23:34:56'; +var + s : string; + objd : TDateRemotable; + d : TDateTime; + y,m,dy : Word; + hh,mn,ss, ssss : Word; +begin + //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? + s := '1976-10-12T23:34:56'; + d := TDateRemotable.ParseDate(s); + DecodeDate(d,y,m,dy); + CheckEquals(y,1976,'Year'); + CheckEquals(m,10,'Month'); + CheckEquals(dy,12,'Day'); + + DecodeTime(d,hh,mn,ss,ssss); + CheckEquals(hh,23,'Hour'); + CheckEquals(mn,34,'Minute'); + CheckEquals(ss,56,'Second'); + + objd := TDateRemotable.Create(); + try + objd.AsDate := d; + CheckEquals(objd.Year,1976,'Year'); + CheckEquals(objd.Month,10,'Month'); + CheckEquals(objd.Day,12,'Day'); + CheckEquals(objd.Hour,23,'Hour'); + CheckEquals(objd.Minute,34,'Minute'); + CheckEquals(objd.Second,56,'Second'); + finally + FreeAndNil(objd); + end; +end; + +procedure TTest_TDateRemotable.Assign(); +var + a, b : TDateRemotable; +begin + b := nil; + a := TDateRemotable.Create(); + try + b := TDateRemotable.Create(); + Check(IsZero(a.AsDate - b.AsDate)); + + a.AsDate := Now(); + b.Assign(a); + Check(IsZero(a.AsDate - b.AsDate)); + + a.AsDate := Now() + 1; + a.Assign(b); + Check(IsZero(a.AsDate - b.AsDate)); + finally + b.Free(); + a.Free(); + end; +end; + +procedure TTest_TDateRemotable.Equal(); +var + a, b : TDateRemotable; + c : TClass_A; +begin + c := nil; + b := nil; + a := TDateRemotable.Create(); + try + b := TDateRemotable.Create(); + c := TClass_A.Create(); + + CheckEquals(False,a.Equal(nil)); + CheckEquals(False,a.Equal(c)); + + a.AsDate := Now(); + b.AsDate := a.AsDate; + CheckEquals(True,a.Equal(b)); + CheckEquals(True,b.Equal(a)); + + a.AsDate := a.AsDate + 1; + CheckEquals(False,a.Equal(b)); + CheckEquals(False,b.Equal(a)); + finally + c.Free(); + b.Free(); + a.Free(); + end; +end; + +procedure TTest_TDateRemotable.FormatDate_ZERO(); +const sDATE = '1899-12-30T00:00:00'; +var + d : TDateTime; +begin + //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? + d := 0; + CheckEquals(sDATE, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE))); +end; + +{ TTest_TDurationRemotable } + +procedure TTest_TDurationRemotable.FormatDate(); +begin + Fail('Write me!'); +end; + +procedure TTest_TDurationRemotable.ParseDate(); +begin + Fail('Write me!'); +end; + +{ TTest_TTimeRemotable } + +procedure TTest_TTimeRemotable.FormatDate(); +begin + Fail('Write me!'); +end; + +procedure TTest_TTimeRemotable.ParseDate(); +begin + Fail('Write me!'); +end; + +{ TTest_TStringBufferRemotable } + +procedure TTest_TStringBufferRemotable.test_Assign(); +const ITER = 100; +var + i : Integer; + a, b : TStringBufferRemotable; +begin + b := nil; + a := TStringBufferRemotable.Create(); + try + b := TStringBufferRemotable.Create(); + for i := 1 to ITER do begin + a.Data := RandomValue(Random(500)); + b.Assign(a); + CheckEquals(a.Data, b.Data); + end; + finally + FreeAndNil(b); + FreeAndNil(a); + end; +end; + +procedure TTest_TStringBufferRemotable.Equal(); +const ITER = 100; +var + i : Integer; + a, b : TStringBufferRemotable; + c : TClass_A; +begin + c := nil; + b := nil; + a := TStringBufferRemotable.Create(); + try + b := TStringBufferRemotable.Create(); + CheckEquals(False, a.Equal(nil)); + c := TClass_A.Create(); + CheckEquals(False, a.Equal(c)); + a.Data := 'wst'; + b.Data := 'azerty'; + CheckEquals(False, a.Equal(b)); + CheckEquals(False, b.Equal(a)); + + for i := 1 to ITER do begin + a.Data := RandomValue(Random(500)); + b.Data := a.Data; + CheckEquals(True, a.Equal(b)); + CheckEquals(True, b.Equal(a)); + end; + finally + FreeAndNil(c); + FreeAndNil(b); + FreeAndNil(a); + end; +end; + +initialization + RegisterTest('Support',TTest_TBaseComplexRemotable.Suite); + RegisterTest('Support',TTest_TStringBufferRemotable.Suite); + RegisterTest('Support-Date',TTest_TDateRemotable.Suite); + RegisterTest('Support-Date',TTest_TDurationRemotable.Suite); + RegisterTest('Support-Date',TTest_TTimeRemotable.Suite); + + RegisterTest('Support',TTest_TArrayOfStringRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfBooleanRemotable.Suite); + + RegisterTest('Support',TTest_TArrayOfInt8URemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt8SRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt16SRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt16URemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt32URemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt32SRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt64SRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfInt64URemotable.Suite); + + RegisterTest('Support',TTest_TArrayOfFloatSingleRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfFloatDoubleRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfFloatExtendedRemotable.Suite); + RegisterTest('Support',TTest_TArrayOfFloatCurrencyRemotable.Suite); + + RegisterTest('Support',TTest_TBaseObjectArrayRemotable.Suite); + +end. + diff --git a/wst/trunk/tests/test_suite/testformatter_unit.pas b/wst/trunk/tests/test_suite/testformatter_unit.pas index 75b20da76..9be2983ac 100644 --- a/wst/trunk/tests/test_suite/testformatter_unit.pas +++ b/wst/trunk/tests/test_suite/testformatter_unit.pas @@ -471,30 +471,6 @@ type procedure Test_Assign(); end; - { TTest_TDateRemotable } - - TTest_TDateRemotable = class(TTestCase) - published - procedure FormatDate(); - procedure ParseDate(); - end; - - { TTest_TDurationRemotable } - - TTest_TDurationRemotable = class(TTestCase) - published - procedure FormatDate(); - procedure ParseDate(); - end; - - { TTest_TTimeRemotable } - - TTest_TTimeRemotable = class(TTestCase) - published - procedure FormatDate(); - procedure ParseDate(); - end; - { TTest_SoapFormatterExceptionBlock } TTest_SoapFormatterExceptionBlock = class(TTestCase) @@ -532,6 +508,14 @@ type procedure ExceptBlock_client(); end; + { TTest_TStringBufferRemotable } + + TTest_TStringBufferRemotable = class(TTestCase) + published + procedure Assign(); + end; + + implementation uses base_binary_formatter, base_soap_formatter, base_xmlrpc_formatter, record_rtti, Math, imp_utils @@ -691,6 +675,16 @@ begin end; end; +function RandomValue(const AMaxlen: Integer): ansistring; +var + k : Integer; +begin + SetLength(Result,AMaxlen); + for k := 1 to AMaxlen do begin + Result[k] := Char((Random(Ord(High(Char))))); + end; +end; + function TTestFormatterSimpleType.Support_ComplextType_with_SimpleContent( ): Boolean; begin Result := True; @@ -3599,78 +3593,6 @@ begin inherited Destroy(); end; -{ TTest_TDateRemotable } - -procedure TTest_TDateRemotable.FormatDate(); -const sDATE = '1976-10-12T23:34:56'; -var - d : TDateTime; -begin - //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? - d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,0); - Check(AnsiPos(TDateRemotable.FormatDate(d),sDATE) = 1); -end; - -procedure TTest_TDateRemotable.ParseDate(); -const sDATE = '1976-10-12T23:34:56'; -var - s : string; - objd : TDateRemotable; - d : TDateTime; - y,m,dy : Word; - hh,mn,ss, ssss : Word; -begin - //'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)? - s := '1976-10-12T23:34:56'; - d := TDateRemotable.ParseDate(s); - DecodeDate(d,y,m,dy); - CheckEquals(y,1976,'Year'); - CheckEquals(m,10,'Month'); - CheckEquals(dy,12,'Day'); - - DecodeTime(d,hh,mn,ss,ssss); - CheckEquals(hh,23,'Hour'); - CheckEquals(mn,34,'Minute'); - CheckEquals(ss,56,'Second'); - - objd := TDateRemotable.Create(); - try - objd.AsDate := d; - CheckEquals(objd.Year,1976,'Year'); - CheckEquals(objd.Month,10,'Month'); - CheckEquals(objd.Day,12,'Day'); - CheckEquals(objd.Hour,23,'Hour'); - CheckEquals(objd.Minute,34,'Minute'); - CheckEquals(objd.Second,56,'Second'); - finally - FreeAndNil(objd); - end; -end; - -{ TTest_TDurationRemotable } - -procedure TTest_TDurationRemotable.FormatDate(); -begin - Fail('Write me!'); -end; - -procedure TTest_TDurationRemotable.ParseDate(); -begin - Fail('Write me!'); -end; - -{ TTest_TTimeRemotable } - -procedure TTest_TTimeRemotable.FormatDate(); -begin - Fail('Write me!'); -end; - -procedure TTest_TTimeRemotable.ParseDate(); -begin - Fail('Write me!'); -end; - { TTestXmlRpcFormatterAttributes } function TTestXmlRpcFormatterAttributes.CreateFormatter(ARootType: PTypeInfo): IFormatterBase; @@ -4255,9 +4177,38 @@ begin CheckEquals(Self.GetFormaterName(),f.GetFormatName()); end; +{ TTest_TStringBufferRemotable } + +procedure TTest_TStringBufferRemotable.Assign(); +const ITER = 100; +var + a, b : TStringBufferRemotable; + i : Integer; +begin + b := nil; + a := TStringBufferRemotable.Create(); + try + b := TStringBufferRemotable.Create(); + CheckEquals(a.Data,b.Data); + for i := 0 to ITER do begin + a.Data := RandomValue(i); + b.Assign(a); + CheckEquals(a.Data,b.Data); + end; + a.Data := ''; + b.Assign(a); + CheckEquals(a.Data,b.Data); + finally + b.Free(); + a.Free(); + end; +end; + initialization RegisterStdTypes(); GetTypeRegistry().Register(sXSD_NS,TypeInfo(TTestEnum),'TTestEnum').RegisterExternalPropertyName('teOne', '1'); + GetTypeRegistry().ItemByTypeInfo[TypeInfo(TTestEnum)].RegisterExternalPropertyName('teThree', 'Three-external-name'); + 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'); @@ -4310,15 +4261,13 @@ initialization RegisterTest(TTest_TBaseComplexRemotable); RegisterTest(TTestSOAPFormatterAttributes); RegisterTest(TTestBinaryFormatterAttributes); - RegisterTest(TTest_TDateRemotable); - RegisterTest(TTest_TDurationRemotable); - RegisterTest(TTest_TTimeRemotable); RegisterTest(TTestXmlRpcFormatterAttributes); RegisterTest(TTestXmlRpcFormatter); RegisterTest(TTest_SoapFormatterExceptionBlock); RegisterTest(TTest_XmlRpcFormatterExceptionBlock); RegisterTest(TTest_BinaryFormatterExceptionBlock); + RegisterTest(TTest_TStringBufferRemotable); {$ELSE} RegisterTest(TTestArray.Suite); RegisterTest(TTestSOAPFormatter.Suite); @@ -4326,15 +4275,13 @@ initialization RegisterTest(TTest_TBaseComplexRemotable.Suite); RegisterTest(TTestSOAPFormatterAttributes.Suite); RegisterTest(TTestBinaryFormatterAttributes.Suite); - RegisterTest(TTest_TDateRemotable.Suite); - RegisterTest(TTest_TDurationRemotable.Suite); - RegisterTest(TTest_TTimeRemotable.Suite); RegisterTest(TTestXmlRpcFormatterAttributes.Suite); RegisterTest(TTestXmlRpcFormatter.Suite); RegisterTest(TTest_SoapFormatterExceptionBlock.Suite); RegisterTest(TTest_XmlRpcFormatterExceptionBlock.Suite); RegisterTest(TTest_BinaryFormatterExceptionBlock.Suite); + RegisterTest(TTest_TStringBufferRemotable.Suite); {$ENDIF} diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index b774d6969..9bea7831d 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -2,12 +2,12 @@ - + - + @@ -27,7 +27,7 @@ - + @@ -40,12 +40,12 @@ - - + + - + @@ -61,19 +61,19 @@ - - + + + + - - - + + - @@ -81,11 +81,11 @@ - + - - + + @@ -93,9 +93,9 @@ - - - + + + @@ -103,9 +103,11 @@ - - + + + + @@ -154,12 +156,14 @@ - - + + + + @@ -167,454 +171,321 @@ - - - - - - - - - - - + + - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - + + - - - - - - - - - - - + + - - - - - - - - - - - - + + + - - - - - - - - - - + + + - - - - - - - - - + + + - - - - - - - - - + + + - - + + - - - + + + - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + - - + + - - + + - - - - - + + + - - - - - + + + - - - + + + - - - - - + + + - - - - - - - - - - - + + + - - - - - - - - - - - - - - - - - - - - - - - + + + - - + + - - + + - - - + + + - - - - - + + + - - - - + + + + - - + + - - - - - + + + - - - + + + - - - + + + - - - + + + - - + + - - - - - - - - + + - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + @@ -652,22 +523,18 @@ - + - - - - - + - + diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index 0c62ad0d7..2973b6307 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -17,7 +17,7 @@ uses metadata_generator, parserdefs, server_service_intf, metadata_wsdl, test_parserdef, base_xmlrpc_formatter, wst_fpc_xml, test_utilities, server_service_xmlrpc, test_parsers, wsdl_generator, xsd_generator, -xsd_consts, base_json_formatter, wsdl_parser; +xsd_consts, base_json_formatter, wsdl_parser, test_support; Const ShortOpts = 'alh'; diff --git a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi index 3bc440c9d..e23c962af 100644 --- a/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi +++ b/wst/trunk/type_lib_edtr/typ_lib_edtr.lpi @@ -2,19 +2,18 @@ - + + - - @@ -32,15 +31,10 @@ - + - - - - - @@ -49,732 +43,159 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - + + - - - - - - - + + - - - - - - - + + - - - - - - - + + - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - + + - - - - - + + - - - - - - - + + - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - + + - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - + + - - - - - - - - - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - @@ -799,7 +220,6 @@ - @@ -812,24 +232,4 @@ - - - - - - - - - - - - - - - - - - - - diff --git a/wst/trunk/type_lib_edtr/ufclassedit.lrs b/wst/trunk/type_lib_edtr/ufclassedit.lrs index f913534bd..a4e8405ce 100644 --- a/wst/trunk/type_lib_edtr/ufclassedit.lrs +++ b/wst/trunk/type_lib_edtr/ufclassedit.lrs @@ -1,3 +1,5 @@ +{ Ceci est un fichier ressource généré automatiquement par Lazarus } + LazarusResources.Add('TfClassEdit','FORMDATA',[ 'TPF0'#11'TfClassEdit'#10'fClassEdit'#4'Left'#3#16#1#6'Height'#3'#'#2#3'Top'#2 +'*'#5'Width'#3#6#2#18'HorzScrollBar.Page'#3#5#2#18'VertScrollBar.Page'#3'"'#2 diff --git a/wst/trunk/type_lib_edtr/ufclassedit.pas b/wst/trunk/type_lib_edtr/ufclassedit.pas index d140f4877..aaa06c88f 100644 --- a/wst/trunk/type_lib_edtr/ufclassedit.pas +++ b/wst/trunk/type_lib_edtr/ufclassedit.pas @@ -251,7 +251,8 @@ begin end; end; if Assigned(FObject.AncestorType) then begin - edtParent.ItemIndex := edtParent.Items.IndexOfObject(FObject.AncestorType); + //edtParent.ItemIndex := edtParent.Items.IndexOfObject(FObject.AncestorType); + edtParent.ItemIndex := edtParent.Items.IndexOfObject(FSymbolTable.FindElement(FSymbolTable.GetExternalName(FObject.AncestorType))); end; end else begin Self.Caption := 'New'; @@ -287,7 +288,8 @@ begin if ( FOldAncestor <> nil ) then FOldAncestor.Release(); locObj.AncestorType := trueParent; - locObj.AncestorType.AddRef(); + if Assigned(locObj.AncestorType) then + locObj.AncestorType.AddRef(); end; end; diff --git a/wst/trunk/type_lib_edtr/ufrmsaveoption.lfm b/wst/trunk/type_lib_edtr/ufrmsaveoption.lfm index a39e5eac3..ffae17979 100644 --- a/wst/trunk/type_lib_edtr/ufrmsaveoption.lfm +++ b/wst/trunk/type_lib_edtr/ufrmsaveoption.lfm @@ -1,19 +1,23 @@ object frmSaveOptions: TfrmSaveOptions - Left = 775 - Height = 292 - Top = 93 + Left = 404 + Height = 322 + Top = 208 Width = 402 HorzScrollBar.Page = 401 - VertScrollBar.Page = 291 + VertScrollBar.Page = 321 ActiveControl = edtInterface BorderStyle = bsSizeToolWin Caption = 'Export file options ...' + ClientHeight = 322 + ClientWidth = 402 Position = poMainFormCenter object Panel1: TPanel Height = 50 - Top = 242 + Top = 272 Width = 402 Align = alBottom + ClientHeight = 50 + ClientWidth = 402 TabOrder = 0 object Button1: TButton Left = 312 @@ -40,9 +44,11 @@ object frmSaveOptions: TfrmSaveOptions end end object Panel2: TPanel - Height = 242 + Height = 272 Width = 402 Align = alClient + ClientHeight = 272 + ClientWidth = 402 TabOrder = 1 object Label1: TLabel Left = 16 @@ -50,48 +56,49 @@ object frmSaveOptions: TfrmSaveOptions Top = 16 Width = 81 Caption = 'Output directory' - Color = clNone ParentColor = False end object GroupBox1: TGroupBox Left = 16 - Height = 134 + Height = 137 Top = 80 Width = 369 Anchors = [akTop, akLeft, akRight, akBottom] Caption = ' File type ' + ClientHeight = 119 + ClientWidth = 365 TabOrder = 0 object edtInterface: TCheckBox Left = 14 - Height = 13 + Height = 19 Top = 16 - Width = 62 + Width = 68 Caption = 'Interface' TabOrder = 0 end object edtProxy: TCheckBox Left = 14 - Height = 13 - Top = 72 - Width = 46 + Height = 19 + Top = 73 + Width = 52 Anchors = [akLeft, akBottom] Caption = 'Proxy' TabOrder = 1 end object edtImplementation: TCheckBox - Left = 245 - Height = 13 + Left = 235 + Height = 19 Top = 14 - Width = 91 + Width = 97 Anchors = [akTop, akRight] Caption = 'Implementation' TabOrder = 2 end object edtBinder: TCheckBox - Left = 245 - Height = 13 - Top = 72 - Width = 50 + Left = 235 + Height = 19 + Top = 73 + Width = 56 Anchors = [akRight, akBottom] Caption = 'Binder' TabOrder = 3 @@ -116,10 +123,30 @@ object frmSaveOptions: TfrmSaveOptions OnClick = btnSelectDirClick TabOrder = 2 end + object btnSelectAll: TButton + Left = 16 + Height = 25 + Top = 233 + Width = 100 + Anchors = [akLeft, akBottom] + Caption = 'Select All' + OnClick = btnSelectAllClick + TabOrder = 3 + end + object btnUnselectAll: TButton + Left = 256 + Height = 25 + Top = 233 + Width = 100 + Anchors = [akRight, akBottom] + Caption = 'Unselect All' + OnClick = btnUnselectAllClick + TabOrder = 4 + end end object AL: TActionList left = 144 - top = 160 + top = 128 object actOK: TAction Caption = 'OK' DisableIfNoHandler = True diff --git a/wst/trunk/type_lib_edtr/ufrmsaveoption.lrs b/wst/trunk/type_lib_edtr/ufrmsaveoption.lrs index 473ac254f..81fd6cce1 100644 --- a/wst/trunk/type_lib_edtr/ufrmsaveoption.lrs +++ b/wst/trunk/type_lib_edtr/ufrmsaveoption.lrs @@ -1,39 +1,47 @@ { Ceci est un fichier ressource généré automatiquement par Lazarus } LazarusResources.Add('TfrmSaveOptions','FORMDATA',[ - 'TPF0'#15'TfrmSaveOptions'#14'frmSaveOptions'#4'Left'#3#7#3#6'Height'#3'$'#1#3 - +'Top'#2']'#5'Width'#3#146#1#18'HorzScrollBar.Page'#3#145#1#18'VertScrollBar.' - +'Page'#3'#'#1#13'ActiveControl'#7#12'edtInterface'#11'BorderStyle'#7#13'bsSi' - +'zeToolWin'#7'Caption'#6#23'Export file options ...'#8'Position'#7#16'poMain' - +'FormCenter'#0#6'TPanel'#6'Panel1'#6'Height'#2'2'#3'Top'#3#242#0#5'Width'#3 - +#146#1#5'Align'#7#8'alBottom'#8'TabOrder'#2#0#0#7'TButton'#7'Button1'#4'Left' - +#3'8'#1#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#7'Anchors'#11#5'akTop'#7'ak' - +'Right'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel'#9#7'Caption'#6#6'Cance' - +'l'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton'#7'Button2'#4'Left'#3 - +#224#0#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#6'Action'#7#5'actOK'#7'Ancho' - +'rs'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Default'#9 - +#8'TabOrder'#2#1#0#0#0#6'TPanel'#6'Panel2'#6'Height'#3#242#0#5'Width'#3#146#1 - +#5'Align'#7#8'alClient'#8'TabOrder'#2#1#0#6'TLabel'#6'Label1'#4'Left'#2#16#6 - +'Height'#2#14#3'Top'#2#16#5'Width'#2'Q'#7'Caption'#6#16'Output directory'#5 - +'Color'#7#6'clNone'#11'ParentColor'#8#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2 - +#16#6'Height'#3#134#0#3'Top'#2'P'#5'Width'#3'q'#1#7'Anchors'#11#5'akTop'#6'a' - +'kLeft'#7'akRight'#8'akBottom'#0#7'Caption'#6#13' File type '#8'TabOrder'#2 - +#0#0#9'TCheckBox'#12'edtInterface'#4'Left'#2#14#6'Height'#2#13#3'Top'#2#16#5 - +'Width'#2'>'#7'Caption'#6#9'Interface'#8'TabOrder'#2#0#0#0#9'TCheckBox'#8'ed' - +'tProxy'#4'Left'#2#14#6'Height'#2#13#3'Top'#2'H'#5'Width'#2'.'#7'Anchors'#11 - +#6'akLeft'#8'akBottom'#0#7'Caption'#6#5'Proxy'#8'TabOrder'#2#1#0#0#9'TCheckB' - +'ox'#17'edtImplementation'#4'Left'#3#245#0#6'Height'#2#13#3'Top'#2#14#5'Widt' - +'h'#2'['#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#14'Implementation' - +#8'TabOrder'#2#2#0#0#9'TCheckBox'#9'edtBinder'#4'Left'#3#245#0#6'Height'#2#13 - +#3'Top'#2'H'#5'Width'#2'2'#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption' - +#6#6'Binder'#8'TabOrder'#2#3#0#0#0#5'TEdit'#12'edtOutputDir'#4'Left'#2#16#6 - +'Height'#2#23#3'Top'#2'&'#5'Width'#3'P'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7 - +'akRight'#0#8'TabOrder'#2#1#0#0#7'TButton'#12'btnSelectDir'#4'Left'#3'j'#1#6 - +'Height'#2#25#3'Top'#2'$'#5'Width'#2#25#7'Anchors'#11#5'akTop'#7'akRight'#0 - +#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#3'...'#7'OnClick'#7#17'btnSe' - +'lectDirClick'#8'TabOrder'#2#2#0#0#0#11'TActionList'#2'AL'#4'left'#3#144#0#3 - +'top'#3#160#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler' - +#9#9'OnExecute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0#22'TS' - +'electDirectoryDialog'#2'SD'#5'Title'#6#21'Choisir un r'#233'pertoire'#11'Fi' - +'lterIndex'#2#0#4'left'#2'e'#3'top'#3#142#0#0#0#0 + 'TPF0'#15'TfrmSaveOptions'#14'frmSaveOptions'#4'Left'#3#148#1#6'Height'#3'B'#1 + +#3'Top'#3#208#0#5'Width'#3#146#1#18'HorzScrollBar.Page'#3#145#1#18'VertScrol' + +'lBar.Page'#3'A'#1#13'ActiveControl'#7#12'edtInterface'#11'BorderStyle'#7#13 + +'bsSizeToolWin'#7'Caption'#6#23'Export file options ...'#12'ClientHeight'#3 + +'B'#1#11'ClientWidth'#3#146#1#8'Position'#7#16'poMainFormCenter'#0#6'TPanel' + +#6'Panel1'#6'Height'#2'2'#3'Top'#3#16#1#5'Width'#3#146#1#5'Align'#7#8'alBott' + +'om'#12'ClientHeight'#2'2'#11'ClientWidth'#3#146#1#8'TabOrder'#2#0#0#7'TButt' + +'on'#7'Button1'#4'Left'#3'8'#1#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#7'An' + +'chors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#6'Cancel' + +#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#0#0#0#7'TButton' + +#7'Button2'#4'Left'#3#224#0#6'Height'#2#25#3'Top'#2#14#5'Width'#2'K'#6'Actio' + +'n'#7#5'actOK'#7'Anchors'#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBor' + +'der'#2#4#7'Default'#9#8'TabOrder'#2#1#0#0#0#6'TPanel'#6'Panel2'#6'Height'#3 + +#16#1#5'Width'#3#146#1#5'Align'#7#8'alClient'#12'ClientHeight'#3#16#1#11'Cli' + +'entWidth'#3#146#1#8'TabOrder'#2#1#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Heig' + +'ht'#2#14#3'Top'#2#16#5'Width'#2'Q'#7'Caption'#6#16'Output directory'#11'Par' + +'entColor'#8#0#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#16#6'Height'#3#137#0#3 + +'Top'#2'P'#5'Width'#3'q'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akB' + +'ottom'#0#7'Caption'#6#13' File type '#12'ClientHeight'#2'w'#11'ClientWidt' + +'h'#3'm'#1#8'TabOrder'#2#0#0#9'TCheckBox'#12'edtInterface'#4'Left'#2#14#6'He' + +'ight'#2#19#3'Top'#2#16#5'Width'#2'D'#7'Caption'#6#9'Interface'#8'TabOrder'#2 + +#0#0#0#9'TCheckBox'#8'edtProxy'#4'Left'#2#14#6'Height'#2#19#3'Top'#2'I'#5'Wi' + +'dth'#2'4'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#5'Proxy'#8'Tab' + +'Order'#2#1#0#0#9'TCheckBox'#17'edtImplementation'#4'Left'#3#235#0#6'Height' + +#2#19#3'Top'#2#14#5'Width'#2'a'#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Captio' + +'n'#6#14'Implementation'#8'TabOrder'#2#2#0#0#9'TCheckBox'#9'edtBinder'#4'Lef' + +'t'#3#235#0#6'Height'#2#19#3'Top'#2'I'#5'Width'#2'8'#7'Anchors'#11#7'akRight' + +#8'akBottom'#0#7'Caption'#6#6'Binder'#8'TabOrder'#2#3#0#0#0#5'TEdit'#12'edtO' + +'utputDir'#4'Left'#2#16#6'Height'#2#23#3'Top'#2'&'#5'Width'#3'P'#1#7'Anchors' + +#11#5'akTop'#6'akLeft'#7'akRight'#0#8'TabOrder'#2#1#0#0#7'TButton'#12'btnSel' + +'ectDir'#4'Left'#3'j'#1#6'Height'#2#25#3'Top'#2'$'#5'Width'#2#25#7'Anchors' + +#11#5'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#3'.' + +'..'#7'OnClick'#7#17'btnSelectDirClick'#8'TabOrder'#2#2#0#0#7'TButton'#12'bt' + +'nSelectAll'#4'Left'#2#16#6'Height'#2#25#3'Top'#3#233#0#5'Width'#2'd'#7'Anch' + +'ors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#10'Select All'#7'OnClick'#7#17 + +'btnSelectAllClick'#8'TabOrder'#2#3#0#0#7'TButton'#14'btnUnselectAll'#4'Left' + +#3#0#1#6'Height'#2#25#3'Top'#3#233#0#5'Width'#2'd'#7'Anchors'#11#7'akRight'#8 + +'akBottom'#0#7'Caption'#6#12'Unselect All'#7'OnClick'#7#19'btnUnselectAllCli' + +'ck'#8'TabOrder'#2#4#0#0#0#11'TActionList'#2'AL'#4'left'#3#144#0#3'top'#3#128 + +#0#0#7'TAction'#5'actOK'#7'Caption'#6#2'OK'#18'DisableIfNoHandler'#9#9'OnExe' + +'cute'#7#12'actOKExecute'#8'OnUpdate'#7#11'actOKUpdate'#0#0#0#22'TSelectDire' + +'ctoryDialog'#2'SD'#5'Title'#6#21'Choisir un r'#233'pertoire'#11'FilterIndex' + +#2#0#4'left'#2'e'#3'top'#3#142#0#0#0#0 ]); diff --git a/wst/trunk/type_lib_edtr/ufrmsaveoption.pas b/wst/trunk/type_lib_edtr/ufrmsaveoption.pas index ff1144538..e684ce033 100644 --- a/wst/trunk/type_lib_edtr/ufrmsaveoption.pas +++ b/wst/trunk/type_lib_edtr/ufrmsaveoption.pas @@ -18,6 +18,8 @@ type Button1 : TButton; Button2 : TButton; btnSelectDir : TButton; + btnSelectAll: TButton; + btnUnselectAll: TButton; edtInterface : TCheckBox; edtProxy : TCheckBox; edtImplementation : TCheckBox; @@ -30,9 +32,11 @@ type SD : TSelectDirectoryDialog; procedure actOKExecute (Sender : TObject ); procedure actOKUpdate (Sender : TObject ); + procedure btnSelectAllClick(Sender: TObject); procedure btnSelectDirClick (Sender : TObject ); + procedure btnUnselectAllClick(Sender: TObject); private - { private declarations } + procedure SelectAll(const ADoSelect : Boolean); public { public declarations } end; @@ -53,6 +57,11 @@ begin ); end; +procedure TfrmSaveOptions.btnSelectAllClick(Sender: TObject); +begin + SelectAll(True); +end; + procedure TfrmSaveOptions.btnSelectDirClick (Sender : TObject ); begin SD.FileName := edtOutputDir.Text; @@ -61,6 +70,20 @@ begin end; end; +procedure TfrmSaveOptions.btnUnselectAllClick(Sender: TObject); +begin + SelectAll(False); +end; + +procedure TfrmSaveOptions.SelectAll(const ADoSelect: Boolean); +begin + edtBinder.Checked := ADoSelect; + edtImplementation.Checked := edtBinder.Checked; + edtImplementation.Checked := edtBinder.Checked; + edtInterface.Checked := edtBinder.Checked; + edtProxy.Checked := edtBinder.Checked; +end; + procedure TfrmSaveOptions.actOKExecute (Sender : TObject ); begin diff --git a/wst/trunk/ws_helper/generator.pas b/wst/trunk/ws_helper/generator.pas index 7ddec925a..4938d086c 100644 --- a/wst/trunk/ws_helper/generator.pas +++ b/wst/trunk/ws_helper/generator.pas @@ -442,11 +442,15 @@ Var resPrm : TPasResultElement; prms : TList; Begin + prms := AMthd.ProcType.Args; + prmCnt := prms.Count; IncIndent(); WriteLn('Var'); Indent();WriteLn('%s : %s;',[sLOC_SERIALIZER,sSERIALIZER_CLASS]); - Indent();WriteLn('%s : %s;',[sPRM_NAME,'string']); + if ( prmCnt > 0 ) or AMthd.InheritsFrom(TPasFunction) then begin + Indent();WriteLn('%s : %s;',[sPRM_NAME,'string']); + end; WriteLn('Begin'); @@ -455,8 +459,6 @@ Var Indent();WriteLn('%s.BeginCall(''%s'', GetTarget(),(Self as ICallContext));',[sLOC_SERIALIZER,SymbolTable.GetExternalName(AMthd)]); IncIndent(); - prms := AMthd.ProcType.Args; - prmCnt := prms.Count; for k := 0 To Pred(prmCnt) do begin prm := TPasArgument(prms[k]); If ( prm.Access <> argOut ) Then Begin @@ -821,8 +823,8 @@ Var WriteLn('callCtx : ICallContext;'); if ( prmCnt > 0 ) or AMthd.InheritsFrom(TPasFunction) then begin WriteLn('%s : string;',[sPRM_NAME]); - WriteLn('procName,trgName : string;'); end; + WriteLn('procName,trgName : string;'); if ( prmCnt > 0 ) then begin for k := 0 to Pred(prmCnt) do begin prm := TPasArgument(prms[k]); @@ -1929,6 +1931,7 @@ procedure TInftGenerator.GenerateArray(ASymbol: TPasArrayType); WriteLn('public'); Indent();WriteLn('class function GetItemTypeInfo():PTypeInfo;override;'); Indent();WriteLn('procedure SetLength(const ANewSize : Integer);override;'); + Indent();WriteLn('procedure Assign(Source: TPersistent); override;'); Indent();WriteLn('property Item[AIndex:Integer] : %s read GetItem write SetItem; default;',[ASymbol.ElType.Name]); WriteLn('end;'); finally @@ -2006,6 +2009,32 @@ procedure TInftGenerator.GenerateArray(ASymbol: TPasArrayType); Indent();WriteLn('System.SetLength(FData,i);'); DecIndent(); WriteLn('end;'); + + NewLine(); + IncIndent(); + WriteLn('procedure %s.Assign(Source: TPersistent);',[ASymbol.Name]); + WriteLn('var'); + Indent();WriteLn('src : %s;',[ASymbol.Name]); + Indent();WriteLn('i, c : PtrInt;'); + WriteLn('begin'); + Indent();WriteLn('if Assigned(Source) and Source.InheritsFrom(%s) then begin',[ASymbol.Name]); + IncIndent(); + Indent();WriteLn('src := %s(Source);',[ASymbol.Name]); + Indent();WriteLn('c := src.Length;'); + Indent();WriteLn('Self.SetLength(c);'); + Indent();WriteLn('if ( c > 0 ) then begin'); + IncIndent(); + Indent();WriteLn('for i := 0 to Pred(c) do begin'); + IncIndent(); Indent(); WriteLn('Self[i] := src[i];'); DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + Indent();WriteLn('end else begin'); + IncIndent(); Indent(); WriteLn('inherited Assign(Source);'); DecIndent(); + Indent();WriteLn('end;'); + DecIndent(); + WriteLn('end;'); end; var diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index 61b1bca89..157d40686 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -502,6 +502,8 @@ var typeCategory : TTypeCategory; hasSequence : Boolean; trueParent : TPasType; + isEmbeddedArray : Boolean; + propItmUltimeType : TPasType; begin inherited; typItm := ASymbol as TPasClassType; @@ -584,8 +586,11 @@ begin propTypItm := p.VarType; if Assigned(propTypItm) then begin prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument); - if GetUltimeType(propTypItm).InheritsFrom(TPasArrayType) then - s := AContainer.GetExternalName(TPasArrayType(GetUltimeType(propTypItm)).ElType) + propItmUltimeType := GetUltimeType(propTypItm); + isEmbeddedArray := propItmUltimeType.InheritsFrom(TPasArrayType) and + ( AContainer.GetArrayStyle(TPasArrayType(propItmUltimeType)) = asEmbeded ); + if isEmbeddedArray then + s := AContainer.GetExternalName(TPasArrayType(propItmUltimeType).ElType) else s := AContainer.GetExternalName(propTypItm); propNode.SetAttribute(s_type,Format('%s:%s',[prop_ns_shortName,s])); @@ -599,7 +604,7 @@ begin propNode.SetAttribute(s_minOccurs,'0'); {else propNode.SetAttribute(s_minOccurs,'1');} - if GetUltimeType(propTypItm).InheritsFrom(TPasArrayType) then + if isEmbeddedArray then propNode.SetAttribute(s_maxOccurs,s_unbounded) {else propNode.SetAttribute(s_maxOccurs,'1');} diff --git a/wst/trunk/wst_global.inc b/wst/trunk/wst_global.inc index b2830a8be..50751797b 100644 --- a/wst/trunk/wst_global.inc +++ b/wst/trunk/wst_global.inc @@ -14,6 +14,7 @@ {$ENDIF} {$IFNDEF FPC} + {$DEFINE WST_DELPHI} {$UNDEF HAS_QWORD} {$UNDEF USE_INLINE} {$DEFINE WST_RECORD_RTTI}