From cff1351132c55bc8d69ea986bbcc2cd9244ae874 Mon Sep 17 00:00:00 2001 From: inoussa Date: Mon, 19 Jan 2009 17:46:33 +0000 Subject: [PATCH] + Base64( refactored ), + Base16 + Extendable "AnsiChar" and "WideChar" + tests git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@665 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- wst/trunk/base_service_intf.pas | 451 +++++++---- wst/trunk/basex_encode.pas | 164 +++- wst/trunk/imp_utils.pas | 12 +- .../files/class_ansichar_property.wsdl | 22 + .../files/class_ansichar_property.xsd | 8 + .../files/class_widechar_property.wsdl | 22 + .../files/class_widechar_property.xsd | 8 + .../tests/test_suite/test_basex_encode.pas | 130 +++- .../tests/test_suite/test_generators.pas | 124 +++ wst/trunk/tests/test_suite/test_parsers.pas | 110 +++ .../tests/test_suite/test_suite_utils.pas | 80 ++ wst/trunk/tests/test_suite/test_support.pas | 711 ++++++++++-------- wst/trunk/tests/test_suite/wst_test_suite.lpi | 70 +- wst/trunk/tests/test_suite/wst_test_suite.lpr | 3 +- wst/trunk/ws_helper/pascal_parser_intf.pas | 17 +- wst/trunk/ws_helper/xsd_generator.pas | 56 +- wst/trunk/wst_types.pas | 3 + 17 files changed, 1485 insertions(+), 506 deletions(-) create mode 100644 wst/trunk/tests/test_suite/files/class_ansichar_property.wsdl create mode 100644 wst/trunk/tests/test_suite/files/class_ansichar_property.xsd create mode 100644 wst/trunk/tests/test_suite/files/class_widechar_property.wsdl create mode 100644 wst/trunk/tests/test_suite/files/class_widechar_property.xsd diff --git a/wst/trunk/base_service_intf.pas b/wst/trunk/base_service_intf.pas index 172aa0929..e73460eec 100644 --- a/wst/trunk/base_service_intf.pas +++ b/wst/trunk/base_service_intf.pas @@ -286,15 +286,15 @@ type function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; property Data : string read FData write FData; end; - - { TBase64StringRemotable } - TBase64StringRemotable = class(TAbstractSimpleRemotable) + { TAbstractEncodedStringRemotable } + + TAbstractEncodedStringRemotable = class(TAbstractSimpleRemotable) private - FBinaryData : TBinaryString; + FBinaryData : TByteDynArray; private - function GetEncodedString : string; - procedure SetEncodedString(const AValue : string); + function GetEncodedString : string; virtual; abstract; + procedure SetEncodedString(const AValue : string); virtual; abstract; public class procedure Save( AObject : TBaseRemotable; @@ -315,10 +315,26 @@ type procedure LoadFromFile(const AFileName : string); procedure SaveToStream(AStream : TStream); procedure SaveToFile(const AFileName : string); - property BinaryData : TBinaryString read FBinaryData write FBinaryData; + property BinaryData : TByteDynArray read FBinaryData write FBinaryData; property EncodedString : string read GetEncodedString write SetEncodedString; end; - + + { TBase64StringRemotable } + + TBase64StringRemotable = class(TAbstractEncodedStringRemotable) + private + function GetEncodedString : string; override; + procedure SetEncodedString(const AValue : string); override; + end; + + { TBase16StringRemotable } + + TBase16StringRemotable = class(TAbstractEncodedStringRemotable) + private + function GetEncodedString : string; override; + procedure SetEncodedString(const AValue : string); override; + end; + { TBaseDateRemotable } TBaseDateRemotable = class(TAbstractSimpleRemotable) @@ -626,6 +642,26 @@ type property Value : Single read FValue write FValue; end; + TComplexAnsiCharContentRemotable = class(TBaseComplexSimpleContentRemotable) + private + FValue: AnsiChar; + protected + class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override; + class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override; + public + property Value : AnsiChar read FValue write FValue; + end; + + TComplexWideCharContentRemotable = class(TBaseComplexSimpleContentRemotable) + private + FValue: WideChar; + protected + class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override; + class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override; + public + property Value : WideChar read FValue write FValue; + end; + { TComplexStringContentRemotable } TComplexStringContentRemotable = class(TBaseComplexSimpleContentRemotable) @@ -637,7 +673,7 @@ type public property Value : string read FValue write FValue; end; - + { TComplexWideStringContentRemotable } TComplexWideStringContentRemotable = class(TBaseComplexSimpleContentRemotable) @@ -664,14 +700,14 @@ type end; {$ENDIF WST_UNICODESTRING} - { TBase64StringExtRemotable } + { TAbstractEncodedStringExtRemotable } - TBase64StringExtRemotable = class(TBaseComplexSimpleContentRemotable) + TAbstractEncodedStringExtRemotable = class(TBaseComplexSimpleContentRemotable) private - FBinaryData : TBinaryString; + FBinaryData : TByteDynArray; private - function GetEncodedString : string; - procedure SetEncodedString(const AValue : string); + function GetEncodedString : string; virtual; abstract; + procedure SetEncodedString(const AValue : string); virtual; abstract; protected class procedure SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase);override; class procedure LoadValue(var AObject : TObject; AStore : IFormatterBase);override; @@ -682,10 +718,26 @@ type procedure LoadFromFile(const AFileName : string); procedure SaveToStream(AStream : TStream); procedure SaveToFile(const AFileName : string); - property BinaryData : TBinaryString read FBinaryData write FBinaryData; + property BinaryData : TByteDynArray read FBinaryData write FBinaryData; property EncodedString : string read GetEncodedString write SetEncodedString; end; + { TBase64StringExtRemotable } + + TBase64StringExtRemotable = class(TAbstractEncodedStringExtRemotable) + private + function GetEncodedString : string; override; + procedure SetEncodedString(const AValue : string); override; + end; + + { TBase16StringExtRemotable } + + TBase16StringExtRemotable = class(TAbstractEncodedStringExtRemotable) + private + function GetEncodedString : string; override; + procedure SetEncodedString(const AValue : string); override; + end; + { TComplexBooleanContentRemotable } TComplexBooleanContentRemotable = class(TBaseComplexSimpleContentRemotable) @@ -1621,6 +1673,14 @@ begin r.Register(sXSD_NS,TypeInfo(TComplexUnicodeStringContentRemotable),'unicodestring').AddPascalSynonym('TComplexUnicodeStringContentRemotable'); {$ENDIF WST_UNICODESTRING} r.Register(sXSD_NS,TypeInfo(TComplexBooleanContentRemotable),'boolean').AddPascalSynonym('TComplexBooleanContentRemotable'); + + r.Register(sXSD_NS,TypeInfo(TComplexAnsiCharContentRemotable),'AnsiChar').AddPascalSynonym('TComplexAnsiCharContentRemotable'); + r.Register(sXSD_NS,TypeInfo(TComplexWideCharContentRemotable),'WideChar').AddPascalSynonym('TComplexWideCharContentRemotable'); + + r.Register(sXSD_NS,TypeInfo(TBase64StringRemotable),'base64Binary').AddPascalSynonym('TBase64StringRemotable'); + r.Register(sXSD_NS,TypeInfo(TBase64StringExtRemotable),'base64Binary').AddPascalSynonym('TBase64StringExtRemotable'); + r.Register(sXSD_NS,TypeInfo(TBase16StringRemotable),'hexBinary').AddPascalSynonym('TBase16StringRemotable'); + r.Register(sXSD_NS,TypeInfo(TBase16StringExtRemotable),'hexBinary').AddPascalSynonym('TBase16StringExtRemotable'); end; procedure SetFieldSerializationVisibility( @@ -5980,7 +6040,7 @@ end; function TBase64StringRemotable.GetEncodedString : string; begin - Result := Base64Encode(BinaryData); + Result := Base64Encode(Length(BinaryData),BinaryData[0]); end; procedure TBase64StringRemotable.SetEncodedString(const AValue : string); @@ -5988,90 +6048,11 @@ begin BinaryData := Base64Decode(AValue,[xoDecodeIgnoreIllegalChar]); end; -class procedure TBase64StringRemotable.Save( - AObject : TBaseRemotable; - AStore : IFormatterBase; - const AName : string; - const ATypeInfo : PTypeInfo -); -var - buffer : string; -begin - if ( AObject <> nil ) then - buffer := TBase64StringRemotable(AObject).EncodedString - else - buffer := ''; - AStore.Put(AName,TypeInfo(string),buffer); -end; - -class procedure TBase64StringRemotable.Load( - var AObject : TObject; - AStore : IFormatterBase; - var AName : string; - const ATypeInfo : PTypeInfo -); -var - buffer : string; -begin - buffer := ''; - AStore.Get(TypeInfo(string),AName,buffer); - if ( AObject = nil ) then - AObject := Create(); - TBase64StringRemotable(AObject).EncodedString := buffer; -end; - -procedure TBase64StringRemotable.Assign(Source : TPersistent); -begin - if Assigned(Source) then begin - if Source.InheritsFrom(TBase64StringRemotable) then - Self.BinaryData := TBase64StringRemotable(Source).BinaryData - else - inherited Assign(Source); - end else begin - BinaryData := ''; - end; -end; - -function TBase64StringRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; -begin - Result := Assigned(ACompareTo) and - ACompareTo.InheritsFrom(TBase64StringRemotable) and - ( TBase64StringRemotable(ACompareTo).BinaryData = Self.BinaryData ); -end; - -procedure TBase64StringRemotable.LoadFromStream(AStream : TStream); -begin - BinaryData := LoadBufferFromStream(AStream); -end; - -procedure TBase64StringRemotable.LoadFromFile(const AFileName : string); -begin - BinaryData := LoadBufferFromFile(AFileName); -end; - -procedure TBase64StringRemotable.SaveToStream(AStream : TStream); -begin - if ( Length(FBinaryData) > 0 ) then - AStream.Write(FBinaryData[1],Length(FBinaryData)); -end; - -procedure TBase64StringRemotable.SaveToFile(const AFileName : string); -var - locStream : TFileStream; -begin - locStream := TFileStream.Create(AFileName,fmCreate); - try - SaveToStream(locStream); - finally - locStream.Free(); - end; -end; - { TBase64StringExtRemotable } function TBase64StringExtRemotable.GetEncodedString : string; begin - Result := Base64Encode(BinaryData); + Result := Base64Encode(Length(BinaryData),BinaryData[0]); end; procedure TBase64StringExtRemotable.SetEncodedString(const AValue : string); @@ -6079,65 +6060,6 @@ begin BinaryData := Base64Decode(AValue,[xoDecodeIgnoreIllegalChar]); end; -class procedure TBase64StringExtRemotable.SaveValue(AObject : TBaseRemotable; AStore : IFormatterBase); -var - s : string; -begin - s := (AObject as TBase64StringExtRemotable).EncodedString; - AStore.PutScopeInnerValue(TypeInfo(string),s); -end; - -class procedure TBase64StringExtRemotable.LoadValue(var AObject : TObject; AStore : IFormatterBase); -var - s : string; -begin - s := ''; - AStore.GetScopeInnerValue(TypeInfo(string),s); - (AObject as TBase64StringExtRemotable).EncodedString := s; -end; - -function TBase64StringExtRemotable.Equal(const ACompareTo : TBaseRemotable) : Boolean; -begin - Result := Assigned(ACompareTo) and - ACompareTo.InheritsFrom(TBase64StringExtRemotable) and - ( TBase64StringExtRemotable(ACompareTo).BinaryData = Self.BinaryData ); -end; - -procedure TBase64StringExtRemotable.LoadFromStream(AStream : TStream); -begin - BinaryData := LoadBufferFromStream(AStream); -end; - -procedure TBase64StringExtRemotable.LoadFromFile(const AFileName : string); -begin - BinaryData := LoadBufferFromFile(AFileName); -end; - -procedure TBase64StringExtRemotable.SaveToStream(AStream : TStream); -begin - if ( Length(FBinaryData) > 0 ) then - AStream.Write(FBinaryData[1],Length(FBinaryData)); -end; - -procedure TBase64StringExtRemotable.SaveToFile(const AFileName : string); -var - locStream : TFileStream; -begin - locStream := TFileStream.Create(AFileName,fmCreate); - try - SaveToStream(locStream); - finally - locStream.Free(); - end; -end; - -procedure TBase64StringExtRemotable.Assign(Source: TPersistent); -begin - if Assigned(Source) and Source.InheritsFrom(TBase64StringExtRemotable) then begin - Self.BinaryData := TBase64StringExtRemotable(Source).BinaryData; - end; - inherited; -end; procedure initialize_base_service_intf(); begin @@ -6398,6 +6320,225 @@ end; +{ TComplexAnsiCharContentRemotable } + +class procedure TComplexAnsiCharContentRemotable.LoadValue( + var AObject: TObject; + AStore: IFormatterBase +); +var + i : AnsiChar; +begin + i := #0; + AStore.GetScopeInnerValue(TypeInfo(AnsiChar),i); + (AObject as TComplexAnsiCharContentRemotable).Value := i; +end; + +class procedure TComplexAnsiCharContentRemotable.SaveValue( + AObject: TBaseRemotable; + AStore: IFormatterBase +); +begin + AStore.PutScopeInnerValue(TypeInfo(AnsiChar),(AObject as TComplexAnsiCharContentRemotable).Value); +end; + +{ TComplexWideCharContentRemotable } + +class procedure TComplexWideCharContentRemotable.LoadValue( + var AObject: TObject; + AStore: IFormatterBase +); +var + i : WideChar; +begin + i := #0; + AStore.GetScopeInnerValue(TypeInfo(WideChar),i); + (AObject as TComplexWideCharContentRemotable).Value := i; +end; + +class procedure TComplexWideCharContentRemotable.SaveValue( + AObject: TBaseRemotable; + AStore: IFormatterBase +); +begin + AStore.PutScopeInnerValue(TypeInfo(WideChar),(AObject as TComplexWideCharContentRemotable).Value); +end; + +{ TAbstractEncodedStringRemotable } + +class procedure TAbstractEncodedStringRemotable.Save( + AObject : TBaseRemotable; + AStore : IFormatterBase; + const AName : string; + const ATypeInfo : PTypeInfo +); +var + buffer : string; +begin + if ( AObject <> nil ) then + buffer := TAbstractEncodedStringRemotable(AObject).EncodedString + else + buffer := ''; + AStore.Put(AName,TypeInfo(string),buffer); +end; + +class procedure TAbstractEncodedStringRemotable.Load( + var AObject : TObject; + AStore : IFormatterBase; + var AName : string; + const ATypeInfo : PTypeInfo +); +var + buffer : string; +begin + buffer := ''; + AStore.Get(TypeInfo(string),AName,buffer); + if ( AObject = nil ) then + AObject := Create(); + TAbstractEncodedStringRemotable(AObject).EncodedString := buffer; +end; + +procedure TAbstractEncodedStringRemotable.Assign(Source: TPersistent); +begin + if Assigned(Source) then begin + if Source.InheritsFrom(TAbstractEncodedStringRemotable) then + Self.BinaryData := Copy(TAbstractEncodedStringRemotable(Source).BinaryData) + else + inherited Assign(Source); + end else begin + BinaryData := nil; + end; +end; + +function TAbstractEncodedStringRemotable.Equal(const ACompareTo: TBaseRemotable): Boolean; +begin + Result := Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TAbstractEncodedStringRemotable) and + ( Length(Self.BinaryData) = Length(TAbstractEncodedStringRemotable(ACompareTo).BinaryData) ) and + CompareMem(Pointer(Self.BinaryData),Pointer(TAbstractEncodedStringRemotable(ACompareTo).BinaryData),Length(Self.BinaryData)); +end; + +procedure TAbstractEncodedStringRemotable.LoadFromStream(AStream: TStream); +begin + BinaryData := LoadBufferFromStream(AStream); +end; + +procedure TAbstractEncodedStringRemotable.LoadFromFile(const AFileName: string); +begin + BinaryData := LoadBufferFromFile(AFileName); +end; + +procedure TAbstractEncodedStringRemotable.SaveToStream(AStream: TStream); +begin + if ( Length(FBinaryData) > 0 ) then + AStream.Write(FBinaryData[0],Length(FBinaryData)); +end; + +procedure TAbstractEncodedStringRemotable.SaveToFile(const AFileName: string); +var + locStream : TFileStream; +begin + locStream := TFileStream.Create(AFileName,fmCreate); + try + SaveToStream(locStream); + finally + locStream.Free(); + end; +end; + +{ TAbstractEncodedStringExtRemotable } + +class procedure TAbstractEncodedStringExtRemotable.SaveValue( + AObject: TBaseRemotable; + AStore: IFormatterBase +); +var + s : string; +begin + s := (AObject as TAbstractEncodedStringExtRemotable).EncodedString; + AStore.PutScopeInnerValue(TypeInfo(string),s); +end; + +class procedure TAbstractEncodedStringExtRemotable.LoadValue( + var AObject: TObject; + AStore: IFormatterBase +); +var + s : string; +begin + s := ''; + AStore.GetScopeInnerValue(TypeInfo(string),s); + (AObject as TAbstractEncodedStringExtRemotable).EncodedString := s; +end; + +procedure TAbstractEncodedStringExtRemotable.Assign(Source: TPersistent); +begin + if Assigned(Source) and Source.InheritsFrom(TAbstractEncodedStringExtRemotable) then begin + Self.BinaryData := Copy(TAbstractEncodedStringExtRemotable(Source).BinaryData); + end; + inherited; +end; + +function TAbstractEncodedStringExtRemotable.Equal(const ACompareTo: TBaseRemotable): Boolean; +begin + Result := Assigned(ACompareTo) and + ACompareTo.InheritsFrom(TAbstractEncodedStringExtRemotable) and + ( Length(Self.BinaryData) = Length(TAbstractEncodedStringExtRemotable(ACompareTo).BinaryData) ) and + CompareMem(Pointer(Self.BinaryData),Pointer(TAbstractEncodedStringExtRemotable(ACompareTo).BinaryData),Length(Self.BinaryData)); +end; + +procedure TAbstractEncodedStringExtRemotable.LoadFromStream(AStream: TStream); +begin + BinaryData := LoadBufferFromStream(AStream); +end; + +procedure TAbstractEncodedStringExtRemotable.LoadFromFile(const AFileName: string); +begin + BinaryData := LoadBufferFromFile(AFileName); +end; + +procedure TAbstractEncodedStringExtRemotable.SaveToStream(AStream: TStream); +begin + if ( Length(FBinaryData) > 0 ) then + AStream.Write(FBinaryData[0],Length(FBinaryData)); +end; + +procedure TAbstractEncodedStringExtRemotable.SaveToFile(const AFileName: string); +var + locStream : TFileStream; +begin + locStream := TFileStream.Create(AFileName,fmCreate); + try + SaveToStream(locStream); + finally + locStream.Free(); + end; +end; + +{ TBase16StringExtRemotable } + +function TBase16StringExtRemotable.GetEncodedString: string; +begin + Result := Base16Encode(BinaryData[0],Length(BinaryData)); +end; + +procedure TBase16StringExtRemotable.SetEncodedString(const AValue: string); +begin + BinaryData := Base16Decode(AValue,[xoDecodeIgnoreIllegalChar]); +end; + +{ TBase16StringRemotable } + +function TBase16StringRemotable.GetEncodedString: string; +begin + Result := Base16Encode(BinaryData[0],Length(BinaryData)); +end; + +procedure TBase16StringRemotable.SetEncodedString(const AValue: string); +begin + BinaryData := Base16Decode(AValue,[xoDecodeIgnoreIllegalChar]); +end; + initialization initialize_base_service_intf(); diff --git a/wst/trunk/basex_encode.pas b/wst/trunk/basex_encode.pas index deb1bc61e..4988e7208 100644 --- a/wst/trunk/basex_encode.pas +++ b/wst/trunk/basex_encode.pas @@ -20,6 +20,7 @@ uses type EBaseXException = class(Exception); + EBase16Exception = class(EBaseXException); EBase64Exception = class(EBaseXException); TBaseXOption = ( xoDecodeIgnoreIllegalChar ); @@ -27,12 +28,23 @@ type function Base64Encode(const ALength : PtrInt; const AInBuffer) : string;overload; function Base64Encode(const AInBuffer : TBinaryString) : string;overload; + function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray;overload; - function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar]) : TBinaryString; + procedure Base16Encode(const ABin; const ALen : Integer; AOutBuffer : PChar); overload; + function Base16Encode(const ABin; const ALen : Integer) : string; overload; + function Base16Encode(const AInBuffer : TBinaryString) : string;overload; + function Base16Decode( + const AHex : PChar; + var ABin; + const ABinLen : Integer; + const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar] + ) : Integer;overload; + function Base16Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray;overload; resourcestring s_InvalidEncodedData = 'Invalid encoded data.'; s_IllegalChar = 'Illegal character for that encoding : %s.'; + s_UnexpectedEndOfData = 'Unexpected end of data.'; implementation @@ -119,7 +131,7 @@ begin Result := Base64Encode(Length(AInBuffer),AInBuffer[1]); end; -function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TBinaryString; +function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray; var locBuffer : PChar; locInLen, locInIndex, i, locPadded : PtrInt; @@ -131,7 +143,7 @@ var locFailOnIllegalChar : Boolean; begin if ( AInBuffer = '' ) then begin - Result := ''; + Result := nil; end else begin locInIndex := 0; locAtualLen := 0; @@ -172,11 +184,155 @@ begin locOutQuantom[0] := ( locInQuantom[0] shl 2 ) or ( locInQuantom[1] shr 4 ); locOutQuantom[1] := ( locInQuantom[1] shl 4 ) or ( locInQuantom[2] shr 2 ); locOutQuantom[2] := ( locInQuantom[2] shl 6 ) or ( locInQuantom[3] ); - Move(locOutQuantom[0],Result[locAtualLen + 1],3 - locPadded); + Move(locOutQuantom[0],Result[locAtualLen],3 - locPadded); Inc(locAtualLen,3 - locPadded); end; SetLength(Result,locAtualLen); end; end; +function Base64DecodeStr(const AInBuffer : string; const AOptions : TBaseXOptions) : TBinaryString; +var + locRes : TByteDynArray; +begin + locRes := Base64Decode(AInBuffer,AOptions); + SetLength(Result,Length(locRes)); + if ( Length(Result) > 0 ) then + Move(locRes[0],Result[1],Length(Result)); +end; + +procedure Base16Encode(const ABin; const ALen : Integer; AOutBuffer : PChar); +const + HEX_MAP : array[0..15] of Char = '0123456789ABCDEF'; +var + p : PByte; + pres : PChar; + i : Integer; +begin + if ( ALen > 0 ) then begin + pres := AOutBuffer; + p := PByte(@Abin); + for i := 1 to ALen do begin + pres^ := HEX_MAP[p^ shr 4]; + PChar(PtrUInt(pres) + SizeOf(Char))^ := HEX_MAP[p^ and $F]; + Inc(pres,2); + Inc(p); + end; + end; +end; + +function Base16Encode(const ABin; const ALen : Integer) : string; +begin + if ( ALen > 0 ) then begin + SetLength(Result,(2 * ALen)); + Base16Encode(ABin,ALen,@Result[1]); + end; +end; + +function Base16Encode(const AInBuffer : TBinaryString) : string; +begin + Result := Base16Encode(AInBuffer[1],Length(AInBuffer)); +end; + +// Returns the actual bytes count. +function Base16Decode( + const AHex : PChar; + var ABin; + const ABinLen : Integer; + const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar] +) : Integer; +const + DIGIT_MAP : array['0'..'9'] of Byte = ( 0, 1, 2, 3, 4, 5, 6, 7, 8, 9); + ALPHA_UP_MAP : array['A'..'F'] of Byte = ( 10, 11, 12, 13, 14, 15 ); + ALPHA_LOW_MAP : array['a'..'f'] of Byte = ( 10, 11, 12, 13, 14, 15 ); +var + i : Integer; + hp : PChar; + bp : PByte; + binVal : Byte; + locFailOnIllegalChar : Boolean; +begin + Result := 0; + if ( ABinLen > 0 ) then begin + binVal := 0; + bp := PByte(@Abin); + hp := AHex; + locFailOnIllegalChar := not ( xoDecodeIgnoreIllegalChar in AOptions ); + for i := 0 to Pred(ABinLen) do begin + if ( hp^ = #0 ) then + Break; + while ( hp^ <> #0 ) do begin + case hp^ of + '0'..'9' : + begin + binVal := ( DIGIT_MAP[hp^] shl 4); + Break; + end; + 'A'..'Z' : + begin + binVal := ( ALPHA_UP_MAP[hp^] shl 4); + Break; + end; + 'a'..'z' : + begin + binVal := ( ALPHA_LOW_MAP[hp^] shl 4); + Break; + end; + else + begin + if locFailOnIllegalChar then + raise EBase16Exception.Create(s_IllegalChar); + end; + end; + Inc(hp); + end; + if ( hp^ = #0 ) then + raise EBase16Exception.Create(s_UnexpectedEndOfData); + Inc(hp); + while ( hp^ <> #0 ) do begin + case hp^ of + '0'..'9' : + begin + bp^ := binVal or DIGIT_MAP[hp^]; + Break; + end; + 'A'..'Z' : + begin + bp^ := binVal or ALPHA_UP_MAP[hp^]; + Break; + end; + 'a'..'z' : + begin + bp^ := binVal or ALPHA_LOW_MAP[hp^]; + Break; + end; + else + begin + if locFailOnIllegalChar then + raise EBase16Exception.Create(s_IllegalChar); + end; + end; + Inc(hp); + end; + if ( hp^ = #0 ) then + raise EBase16Exception.Create(s_UnexpectedEndOfData); + Inc(hp); + Inc(bp); + end; + Result := PtrUInt(bp) - PtrUInt(@Abin); + end; +end; + +function Base16Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray; +var + i : Integer; +begin + if ( Length(AInBuffer) > 0 ) then begin + SetLength(Result,Length(AInBuffer) div 2); + i := Base16Decode(PChar(AInBuffer),Result[0],Length(Result),AOptions); + if ( i <> Length(Result) ) then + SetLength(Result,i); + end; +end; + end. diff --git a/wst/trunk/imp_utils.pas b/wst/trunk/imp_utils.pas index 61fd6d278..518310e7f 100644 --- a/wst/trunk/imp_utils.pas +++ b/wst/trunk/imp_utils.pas @@ -51,9 +51,9 @@ Type const AData : Extended ) : string; - - function LoadBufferFromFile(const AFileName : string) : TBinaryString; - function LoadBufferFromStream(AStream : TStream) : TBinaryString; + + function LoadBufferFromFile(const AFileName : string) : TByteDynArray; + function LoadBufferFromStream(AStream : TStream) : TByteDynArray; implementation @@ -143,7 +143,7 @@ begin Result := s end; -function LoadBufferFromStream(AStream : TStream) : TBinaryString; +function LoadBufferFromStream(AStream : TStream) : TByteDynArray; var len : Int64; begin @@ -152,7 +152,7 @@ begin if ( len > 0 ) then begin try AStream.Seek(0,soBeginning); - AStream.Read(Result[1],len); + AStream.Read(Result[0],len); except SetLength(Result,0); raise; @@ -160,7 +160,7 @@ begin end; end; -function LoadBufferFromFile(const AFileName : string) : TBinaryString; +function LoadBufferFromFile(const AFileName : string) : TByteDynArray; var locStream : TStream; begin diff --git a/wst/trunk/tests/test_suite/files/class_ansichar_property.wsdl b/wst/trunk/tests/test_suite/files/class_ansichar_property.wsdl new file mode 100644 index 000000000..96613623a --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_ansichar_property.wsdl @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/class_ansichar_property.xsd b/wst/trunk/tests/test_suite/files/class_ansichar_property.xsd new file mode 100644 index 000000000..6d336b109 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_ansichar_property.xsd @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/class_widechar_property.wsdl b/wst/trunk/tests/test_suite/files/class_widechar_property.wsdl new file mode 100644 index 000000000..866e7f556 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_widechar_property.wsdl @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + diff --git a/wst/trunk/tests/test_suite/files/class_widechar_property.xsd b/wst/trunk/tests/test_suite/files/class_widechar_property.xsd new file mode 100644 index 000000000..52052fec4 --- /dev/null +++ b/wst/trunk/tests/test_suite/files/class_widechar_property.xsd @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/wst/trunk/tests/test_suite/test_basex_encode.pas b/wst/trunk/tests/test_suite/test_basex_encode.pas index cf9bb25db..5e550ff6e 100644 --- a/wst/trunk/tests/test_suite/test_basex_encode.pas +++ b/wst/trunk/tests/test_suite/test_basex_encode.pas @@ -21,11 +21,11 @@ uses TestFrameWork, {$ENDIF} TypInfo, - wst_types, basex_encode; + wst_types, test_suite_utils, basex_encode; type - TTest_Base64 = class(TTestCase) + TTest_Base64 = class(TWstBaseTest) protected procedure Check_Encode(const AIn, AExpect : string); procedure Check_Decode(const AIn, AExpect : string; const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar]); @@ -47,16 +47,38 @@ type procedure Decode_illegal_char(); end; + TTest_Base16 = class(TWstBaseTest) + protected + procedure Check_Encode(const AIn, AExpect : string); + procedure Check_Decode(const AIn, AExpect : string; const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar]); + published + procedure Encode_empty(); + procedure Encode_f(); + procedure Encode_fo(); + procedure Encode_foo(); + procedure Encode_foob(); + procedure Encode_fooba(); + procedure Encode_foobar(); + + procedure Decode_f(); + procedure Decode_fo(); + procedure Decode_foo(); + procedure Decode_foob(); + procedure Decode_fooba(); + procedure Decode_foobar(); + procedure Decode_illegal_char(); + end; + implementation { TTest_Base64 } procedure TTest_Base64.Check_Decode(const AIn, AExpect: string; const AOptions : TBaseXOptions); var - locRes : string; + locRes : TByteDynArray; begin locRes := Base64Decode(AIn,AOptions); - CheckEquals(AExpect,locRes); + CheckEquals(StringToByteArray(AExpect),locRes); end; procedure TTest_Base64.Check_Encode(const AIn, AExpect: string); @@ -153,7 +175,107 @@ begin //Check_Encode('foobar','Zm9vYmFy'); end; +{ TTest_Base16 } + +procedure TTest_Base16.Check_Decode(const AIn, AExpect: string; const AOptions: TBaseXOptions); +var + locRes : TByteDynArray; +begin + locRes := Base16Decode(AIn,AOptions); + CheckEquals(StringToByteArray(AExpect),locRes); +end; + +procedure TTest_Base16.Check_Encode(const AIn, AExpect: string); +var + locRes : string; +begin + locRes := Base16Encode(AIn); + CheckEquals(AExpect,locRes); +end; + +procedure TTest_Base16.Decode_f(); +begin + Check_Decode('66','f'); +end; + +procedure TTest_Base16.Decode_fo(); +begin + Check_Decode('666F','fo'); +end; + +procedure TTest_Base16.Decode_foo(); +begin + Check_Decode('666F6F','foo'); +end; + +procedure TTest_Base16.Decode_foob(); +begin + Check_Decode('666F6F62','foob'); +end; + +procedure TTest_Base16.Decode_fooba(); +begin + Check_Decode('666F6F6261','fooba'); +end; + +procedure TTest_Base16.Decode_foobar(); +begin + Check_Decode('666F6F626172','foobar'); +end; + +procedure TTest_Base16.Decode_illegal_char(); +var + ok : Boolean; +begin + ok := False; + try + Check_Decode('666'#200'F6F' + sLineBreak + '6'#1'26172','foobar',[]); + except + on e : EBase16Exception do + ok := True; + end; + CheckEquals(True,ok); + + Check_Decode('666'#200'F6F' + sLineBreak + '6'#1'26172','foobar',[xoDecodeIgnoreIllegalChar]); +end; + +procedure TTest_Base16.Encode_empty(); +begin + Check_Encode('',''); +end; + +procedure TTest_Base16.Encode_f(); +begin + Check_Encode('f','66'); +end; + +procedure TTest_Base16.Encode_fo(); +begin + Check_Encode('fo','666F'); +end; + +procedure TTest_Base16.Encode_foo(); +begin + Check_Encode('foo','666F6F'); +end; + +procedure TTest_Base16.Encode_foob(); +begin + Check_Encode('foob','666F6F62'); +end; + +procedure TTest_Base16.Encode_fooba(); +begin + Check_Encode('fooba','666F6F6261'); +end; + +procedure TTest_Base16.Encode_foobar(); +begin + Check_Encode('foobar','666F6F626172'); +end; + initialization RegisterTest('Encoding',TTest_Base64.Suite); + RegisterTest('Encoding',TTest_Base16.Suite); end. diff --git a/wst/trunk/tests/test_suite/test_generators.pas b/wst/trunk/tests/test_suite/test_generators.pas index 7d3b9181c..2d545f24d 100644 --- a/wst/trunk/tests/test_suite/test_generators.pas +++ b/wst/trunk/tests/test_suite/test_generators.pas @@ -42,6 +42,8 @@ type {$IFDEF WST_UNICODESTRING} procedure class_unicodestring_property(); {$ENDIF WST_UNICODESTRING} + procedure class_ansichar_property(); + procedure class_widechar_property(); procedure array_sequence_collection(); procedure class_sequence_open_type_any(); @@ -846,6 +848,128 @@ begin ReadXMLFile(Result,wstExpandLocalFileName(TestFilesPath + AFileName)); end; +procedure TTest_CustomXsdGenerator.class_ansichar_property(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + procedure AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType + ); + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.Members.Add(p); + p.ReadAccessorName := 'F' + AName; + p.WriteAccessorName := 'F' + AName; + p.VarType := tr.FindElement(ATypeName) as TPasType; + Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName])); + p.VarType.AddRef(); + p.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'class_ansichar_property',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleClass',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('elementProp','AnsiChar','',ptField); + AddProperty('elementAtt','AnsiChar','',ptAttribute); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + WriteXMLFile(locDoc,'.\class_ansichar_property.xsd'); + locExistDoc := LoadXmlFromFilesList('class_ansichar_property.xsd'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + +procedure TTest_CustomXsdGenerator.class_widechar_property(); +var + tr : TwstPasTreeContainer; + mdl : TPasModule; + cltyp : TPasClassType; + + procedure AddProperty( + const AName, + ATypeName, + ADefault : string; + const AKind : TPropertyType + ); + var + p : TPasProperty; + begin + p := TPasProperty(tr.CreateElement(TPasProperty,AName,cltyp,visDefault,'',0)); + cltyp.Members.Add(p); + p.ReadAccessorName := 'F' + AName; + p.WriteAccessorName := 'F' + AName; + p.VarType := tr.FindElement(ATypeName) as TPasType; + Check( (p.VarType <> nil), Format('Type not found : "%s".',[ATypeName])); + p.VarType.AddRef(); + p.DefaultValue := ADefault; + p.Visibility := visPublished; + p.StoredAccessorName := 'True'; + if ( AKind = ptAttribute ) then + tr.SetPropertyAsAttribute(p,True); + end; + +var + g : IGenerator; + locDoc, locExistDoc : TXMLDocument; +begin + locDoc := nil; + locExistDoc := nil; + tr := TwstPasTreeContainer.Create(); + try + CreateWstInterfaceSymbolTable(tr); + mdl := TPasModule(tr.CreateElement(TPasModule,'class_widechar_property',tr.Package,visDefault,'',0)); + tr.Package.Modules.Add(mdl); + mdl.InterfaceSection := TPasSection(tr.CreateElement(TPasSection,'',mdl,visDefault,'',0)); + cltyp := TPasClassType(tr.CreateElement(TPasClassType,'TSampleClass',mdl.InterfaceSection,visDefault,'',0)); + cltyp.ObjKind := okClass; + mdl.InterfaceSection.Declarations.Add(cltyp); + mdl.InterfaceSection.Types.Add(cltyp); + AddProperty('elementProp','WideChar','',ptField); + AddProperty('elementAtt','WideChar','',ptAttribute); + + locDoc := CreateDoc(); + g := CreateGenerator(locDoc); + g.Execute(tr,mdl.Name); + WriteXMLFile(locDoc,'.\class_widechar_property.xsd'); + locExistDoc := LoadXmlFromFilesList('class_widechar_property.xsd'); + Check(CompareNodes(locExistDoc.DocumentElement,locDoc.DocumentElement),'generated document differs from the existent one.'); + finally + ReleaseDomNode(locExistDoc); + ReleaseDomNode(locDoc); + FreeAndNil(tr); + end; +end; + { TTest_XsdGenerator } function TTest_XsdGenerator.CreateGenerator(const ADoc: TXMLDocument): IXsdGenerator; diff --git a/wst/trunk/tests/test_suite/test_parsers.pas b/wst/trunk/tests/test_suite/test_parsers.pas index 17b9254a8..522caa6e8 100644 --- a/wst/trunk/tests/test_suite/test_parsers.pas +++ b/wst/trunk/tests/test_suite/test_parsers.pas @@ -56,6 +56,8 @@ type function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;virtual;abstract; function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;virtual;abstract; function load_class_widestring_property() : TwstPasTreeContainer;virtual;abstract; + function load_class_ansichar_property() : TwstPasTreeContainer;virtual;abstract; + function load_class_widechar_property() : TwstPasTreeContainer;virtual;abstract; published procedure EmptySchema(); @@ -88,6 +90,8 @@ type procedure class_headerblock_derived(); procedure class_headerblock_simplecontent_derived(); procedure class_widestring_property(); + procedure class_ansichar_property(); + procedure class_widechar_property(); end; { TTest_XsdParser } @@ -124,6 +128,8 @@ type function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override; function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override; function load_class_widestring_property() : TwstPasTreeContainer;override; + function load_class_ansichar_property() : TwstPasTreeContainer;override; + function load_class_widechar_property() : TwstPasTreeContainer;override; end; { TTest_WsdlParser } @@ -160,6 +166,8 @@ type function load_class_headerblock_derived_Schema() : TwstPasTreeContainer;override; function load_class_headerblock_simplecontent_derived_Schema() : TwstPasTreeContainer;override; function load_class_widestring_property() : TwstPasTreeContainer;override; + function load_class_ansichar_property() : TwstPasTreeContainer;override; + function load_class_widechar_property() : TwstPasTreeContainer;override; published procedure no_binding_style(); procedure signature_last(); @@ -1611,6 +1619,88 @@ begin end; +procedure TTest_CustomXsdParser.class_ansichar_property(); +const s_class_name = 'TSampleClass'; +var + clsType : TPasClassType; + tr : TwstPasTreeContainer; + + procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,prp.VarType.Name,'TypeName'); + CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName'); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + elt : TPasElement; +begin + tr := load_class_ansichar_property(); + try + mdl := tr.FindModule('class_ansichar_property'); + CheckNotNull(mdl,'class_ansichar_property'); + elt := tr.FindElement(s_class_name); + CheckNotNull(elt,s_class_name); + CheckEquals(s_class_name,elt.Name); + CheckEquals(s_class_name,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckProperty('elementProp','AnsiChar','string',ptField); + CheckProperty('elementAtt','AnsiChar','string',ptAttribute); + finally + tr.Free(); + end; +end; + +procedure TTest_CustomXsdParser.class_widechar_property(); +const s_class_name = 'TSampleClass'; +var + clsType : TPasClassType; + tr : TwstPasTreeContainer; + + procedure CheckProperty(const AName,ATypeName,ADeclaredTypeName : string; const AFieldType : TPropertyType); + var + prp : TPasProperty; + begin + prp := FindMember(clsType,AName) as TPasProperty; + CheckNotNull(prp); + CheckEquals(AName,prp.Name); + CheckEquals(AName,tr.GetExternalName(prp)); + CheckNotNull(prp.VarType); + CheckEquals(ATypeName,prp.VarType.Name,'TypeName'); + CheckEquals(ADeclaredTypeName,tr.GetExternalName(prp.VarType),'DeclaredTypeName'); + CheckEquals(PropertyType_Att[AFieldType],tr.IsAttributeProperty(prp)); + end; + +var + mdl : TPasModule; + elt : TPasElement; +begin + tr := load_class_widechar_property(); + try + mdl := tr.FindModule('class_widechar_property'); + CheckNotNull(mdl,'class_widechar_property'); + elt := tr.FindElement(s_class_name); + CheckNotNull(elt,s_class_name); + CheckEquals(s_class_name,elt.Name); + CheckEquals(s_class_name,tr.GetExternalName(elt)); + CheckIs(elt,TPasClassType); + clsType := elt as TPasClassType; + CheckProperty('elementProp','WideChar','string',ptField); + CheckProperty('elementAtt','WideChar','string',ptAttribute); + finally + tr.Free(); + end; +end; + { TTest_XsdParser } function TTest_XsdParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -1736,6 +1826,16 @@ begin Result := ParseDoc(x_complexType_class_properties_extended_metadata + '_2'); end; +function TTest_XsdParser.load_class_ansichar_property(): TwstPasTreeContainer; +begin + Result := ParseDoc('class_ansichar_property'); +end; + +function TTest_XsdParser.load_class_widechar_property: TwstPasTreeContainer; +begin + Result := ParseDoc('class_widechar_property'); +end; + { TTest_WsdlParser } function TTest_WsdlParser.ParseDoc(const ADoc: string): TwstPasTreeContainer; @@ -2114,6 +2214,16 @@ begin Result := ParseDoc(x_complexType_class_properties_extended_metadata + '_2'); end; +function TTest_WsdlParser.load_class_ansichar_property() : TwstPasTreeContainer; +begin + Result := ParseDoc('class_ansichar_property'); +end; + +function TTest_WsdlParser.load_class_widechar_property() : TwstPasTreeContainer; +begin + Result := ParseDoc('class_widechar_property'); +end; + initialization RegisterTest('XSD parser',TTest_XsdParser.Suite); RegisterTest('WSDL parser',TTest_WsdlParser.Suite); diff --git a/wst/trunk/tests/test_suite/test_suite_utils.pas b/wst/trunk/tests/test_suite/test_suite_utils.pas index e80762a7b..2360ba8bc 100644 --- a/wst/trunk/tests/test_suite/test_suite_utils.pas +++ b/wst/trunk/tests/test_suite/test_suite_utils.pas @@ -25,12 +25,61 @@ uses const TestFilesPath = {$IFDEF WST_DELPHI}'.' +{$ENDIF WST_DELPHI}'.' + PathDelim + 'files' + PathDelim; +type + + { TWstBaseTest } + + TWstBaseTest = class(TTestCase) + protected + procedure CheckEquals(expected, actual: TByteDynArray; msg: string = ''; const AStrict : Boolean = True); overload; +{$IFDEF FPC} + procedure CheckEquals(expected, actual: Int64; msg: string = ''; const AStrict : Boolean = True); overload; + procedure CheckEquals(expected, actual: QWord; msg: string = ''; const AStrict : Boolean = True); overload; +{$ENDIF FPC} + end; + function CompareNodes(const A,B : TDOMNode) : Boolean;overload; function wstExpandLocalFileName(const AFileName : string) : string; function DumpMemory(AMem : Pointer; const ALength : PtrInt) : ansistring; + function StringToByteArray(const AValue : string) : TByteDynArray; + + function RandomRange(const AFrom, ATo : Integer) : Integer ;overload; + function RandomRange(const AFrom, ATo : Int64) : Int64 ; overload; implementation +//{$IFDEF FPC} + // {$IF not Defined(RandomRange)} + function RandomRange(const AFrom, ATo : Integer) : Integer ; + var + a : Integer; + begin + if ( AFrom <= ATo ) then + a := AFrom + else + a := ATo; + Result := a + Random(Abs(ATo - AFrom)); + end; +// {$IFEND} +//{$ENDIF} + +function RandomRange(const AFrom, ATo : Int64) : Int64 ; +var + a : Int64; +begin + if ( AFrom <= ATo ) then + a := AFrom + else + a := ATo; + Result := a + Random(Abs(ATo - AFrom)); +end; + +function StringToByteArray(const AValue : string) : TByteDynArray; +begin + SetLength(Result,Length(AValue)); + Move(Pointer(AValue)^,Pointer(Result)^,Length(Result)); +end; + function wstExpandLocalFileName(const AFileName : string) : string; begin Result := ExtractFilePath(ParamStr(0)) + AFileName; @@ -92,4 +141,35 @@ begin end; end; +{ TWstBaseTest } + +{$IFDEF FPC} +procedure TWstBaseTest.CheckEquals(expected, actual: Int64; msg: string; + const AStrict: Boolean); +begin + if (expected <> actual) then + FailNotEquals(IntToStr(expected), IntToStr(actual), msg{$IFDEF WST_DELPHI}, CallerAddr{$ENDIF WST_DELPHI}); +end; + +procedure TWstBaseTest.CheckEquals(expected, actual: QWord; msg: string; + const AStrict: Boolean); +begin + if (expected <> actual) then + FailNotEquals(IntToStr(expected), IntToStr(actual), msg{$IFDEF WST_DELPHI}, CallerAddr{$ENDIF WST_DELPHI}); +end; +{$ENDIF FPC} + +procedure TWstBaseTest.CheckEquals(expected, actual: TByteDynArray; + msg: string; const AStrict: Boolean +); +begin + if ( expected = nil ) then begin + Check(actual = nil, msg); + end else begin + CheckEquals(Length(expected),Length(actual),msg); + if ( Length(expected) > 0 ) then + Check(CompareMem(Pointer(expected), Pointer(actual),Length(expected)),msg); + end; +end; + end. diff --git a/wst/trunk/tests/test_suite/test_support.pas b/wst/trunk/tests/test_suite/test_support.pas index cb7529fbd..07beeeee3 100644 --- a/wst/trunk/tests/test_suite/test_support.pas +++ b/wst/trunk/tests/test_suite/test_support.pas @@ -351,9 +351,13 @@ type procedure Equal(); end; - { TTest_TBase64StringRemotable } + { TTest_TAbstractEncodedStringRemotable } - TTest_TBase64StringRemotable = class(TTestCase) + TTest_TAbstractEncodedStringRemotable = class(TWstBaseTest) + protected + class function CreateObject() : TAbstractEncodedStringRemotable; virtual; abstract; + class function EncodeData(const AValue : TByteDynArray) : string; overload; virtual; abstract; + class function EncodeData(const AValue : TBinaryString) : string; overload; published procedure test_Assign(); procedure Equal(); @@ -365,9 +369,31 @@ type procedure SaveToFile(); end; + { TTest_TBase64StringRemotable } + + TTest_TBase64StringRemotable = class(TTest_TAbstractEncodedStringRemotable) + protected + class function CreateObject() : TAbstractEncodedStringRemotable; override; + class function EncodeData(const AValue : TByteDynArray) : string; override; + end; + + { TTest_TBase16StringRemotable } + + TTest_TBase16StringRemotable = class(TTest_TAbstractEncodedStringRemotable) + protected + class function CreateObject() : TAbstractEncodedStringRemotable; override; + class function EncodeData(const AValue : TByteDynArray) : string; override; + end; + { TTest_TBase64StringExtRemotable } - TTest_TBase64StringExtRemotable = class(TTestCase) + { TTest_TAbstractEncodedStringExtRemotable } + + TTest_TAbstractEncodedStringExtRemotable = class(TWstBaseTest) + protected + class function CreateObject() : TAbstractEncodedStringExtRemotable; virtual; abstract; + class function EncodeData(const AValue : TByteDynArray) : string; overload; virtual; abstract; + class function EncodeData(const AValue : TBinaryString) : string; overload; published procedure Equal(); procedure test_Assign(); @@ -379,6 +405,20 @@ type procedure SaveToFile(); end; + TTest_TBase64StringExtRemotable = class(TTest_TAbstractEncodedStringExtRemotable) + protected + class function CreateObject() : TAbstractEncodedStringExtRemotable; override; + class function EncodeData(const AValue : TByteDynArray) : string; override; + end; + + { TTest_TBase16StringExtRemotable } + + TTest_TBase16StringExtRemotable = class(TTest_TAbstractEncodedStringExtRemotable) + protected + class function CreateObject() : TAbstractEncodedStringExtRemotable; override; + class function EncodeData(const AValue : TByteDynArray) : string; override; + end; + { TClass_A_CollectionRemotable } TClass_A_CollectionRemotable = class(TObjectCollectionRemotable) @@ -406,7 +446,7 @@ type { TTest_Procedures } - TTest_Procedures = class(TTestCase) + TTest_Procedures = class(TWstBaseTest) published procedure test_LoadBufferFromStream(); procedure test_LoadBufferFromFile(); @@ -425,6 +465,16 @@ begin end; end; +function RandomBytesValue(const AMaxlen: Integer): TByteDynArray; +var + k : Integer; +begin + SetLength(Result,AMaxlen); + for k := 0 to ( AMaxlen - 1 ) do begin + Result[k] := RandomRange(Low(Byte),High(Byte)); + end; +end; + { TArrayOfClass_A } function TArrayOfClass_A.GetItem(AIndex: Integer): TClass_A; @@ -2975,20 +3025,25 @@ begin end; end; -{ TTest_TBase64StringRemotable } +{ TTest_TAbstractEncodedStringRemotable } -procedure TTest_TBase64StringRemotable.test_Assign(); +class function TTest_TAbstractEncodedStringRemotable.EncodeData(const AValue: TBinaryString): string; +begin + Result := EncodeData(StringToByteArray(AValue)); +end; + +procedure TTest_TAbstractEncodedStringRemotable.test_Assign(); const ITER = 100; var i : Integer; - a, b : TBase64StringRemotable; + a, b : TAbstractEncodedStringRemotable; begin b := nil; - a := TBase64StringRemotable.Create(); + a := CreateObject(); try - b := TBase64StringRemotable.Create(); + b := CreateObject(); for i := 1 to ITER do begin - a.BinaryData := RandomValue(Random(500)); + a.BinaryData := RandomBytesValue(Random(500)); b.Assign(a); CheckEquals(a.BinaryData, b.BinaryData); CheckEquals(a.EncodedString, b.EncodedString); @@ -2999,28 +3054,249 @@ begin end; end; -procedure TTest_TBase64StringRemotable.Equal(); +procedure TTest_TAbstractEncodedStringRemotable.Equal(); const ITER = 100; var i : Integer; - a, b : TBase64StringRemotable; + a, b : TAbstractEncodedStringRemotable; c : TClass_A; begin c := nil; b := nil; - a := TBase64StringRemotable.Create(); + a := CreateObject(); try - b := TBase64StringRemotable.Create(); + b := CreateObject(); CheckEquals(False, a.Equal(nil)); c := TClass_A.Create(); CheckEquals(False, a.Equal(c)); - a.BinaryData := 'wst'; - b.BinaryData := 'azerty'; + a.BinaryData := StringToByteArray('wst'); + b.BinaryData := StringToByteArray('azerty'); CheckEquals(False, a.Equal(b)); CheckEquals(False, b.Equal(a)); for i := 1 to ITER do begin - a.BinaryData := RandomValue(Random(500)); + a.BinaryData := RandomBytesValue(Random(500)); + b.BinaryData := Copy(a.BinaryData); + CheckEquals(True, a.Equal(b)); + CheckEquals(True, b.Equal(a)); + end; + finally + FreeAndNil(c); + FreeAndNil(b); + FreeAndNil(a); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.SetBinaryData(); +const ITER = 100; +var + i : Integer; + a : TAbstractEncodedStringRemotable; + s, es : string; +begin + a := CreateObject(); + try + s := ''; es := EncodeData(s); + a.BinaryData := StringToByteArray(s); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + + for i := 1 to ITER do begin + s := RandomValue(Random(500)); es := EncodeData(s); + a.BinaryData := StringToByteArray(s); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + end; + finally + FreeAndNil(a); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.SetEncodedString(); +const ITER = 100; +var + i : Integer; + a : TAbstractEncodedStringRemotable; + s, es : TBinaryString; +begin + a := CreateObject(); + try + s := ''; es := EncodeData(s); + a.EncodedString := es; + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + + for i := 1 to ITER do begin + s := RandomValue(Random(500)); es := EncodeData(s); + a.EncodedString := es; + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + CheckEquals(StringToByteArray(s),a.BinaryData); + CheckEquals(es,a.EncodedString); + end; + finally + FreeAndNil(a); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.LoadFromStream(); +var + locLoadedBuffer : TAbstractEncodedStringRemotable; + locBuffer : TByteDynArray; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[0])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[0],Length(locBuffer)); + locLoadedBuffer := CreateObject(); + locLoadedBuffer.LoadFromStream(locStream); + CheckEquals( locBuffer, locLoadedBuffer.BinaryData ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.LoadFromFile(); +var + locLoadedBuffer : TAbstractEncodedStringRemotable; + locBuffer : TByteDynArray; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[0])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locLoadedBuffer := nil; + locStream := TMemoryStream.Create(); + try + locStream.Write(locBuffer[0],Length(locBuffer)); + locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); + locStream.SaveToFile(locFileName); + locLoadedBuffer := CreateObject(); + locLoadedBuffer.LoadFromFile(locFileName); + CheckEquals( locBuffer, locLoadedBuffer.BinaryData ); + finally + locLoadedBuffer.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.SaveToStream(); +var + locObj : TAbstractEncodedStringRemotable; + locBuffer : TByteDynArray; + pBytePtr : PByte; + locStream : TMemoryStream; + i : PtrInt; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[0])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locObj := nil; + locStream := TMemoryStream.Create(); + try + locObj := CreateObject(); + locObj.BinaryData := Copy(locBuffer); + locObj.SaveToStream(locStream); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[0],Length(locBuffer)); + CheckEquals( locObj.BinaryData, locBuffer ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + +procedure TTest_TAbstractEncodedStringRemotable.SaveToFile(); +var + locObj : TAbstractEncodedStringRemotable; + locBuffer : TByteDynArray; + pBytePtr : PByte; + locStream : TFileStream; + i : PtrInt; + locFileName : string; +begin + SetLength(locBuffer,255); + pBytePtr := PByte(@(locBuffer[0])); + for i := 0 to 255 do begin + pBytePtr^ := i; + Inc(pBytePtr); + end; + locStream := nil; + locObj := CreateObject(); + try + locObj.BinaryData := Copy(locBuffer); + locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); + DeleteFile(locFileName); + locObj.SaveToFile(locFileName); + Check(FileExists(locFileName)); + locStream := TFileStream.Create(locFileName,fmOpenRead); + Check( locStream.Size = Length(locObj.BinaryData) ); + SetLength(locBuffer,locStream.Size); + locStream.Position := 0; + locStream.Read(locBuffer[0],Length(locBuffer)); + CheckEquals( locObj.BinaryData, locBuffer ); + finally + locObj.Free(); + locStream.Free(); + end; +end; + +{ TTest_TAbstractEncodedStringExtRemotable } + +class function TTest_TAbstractEncodedStringExtRemotable.EncodeData(const AValue: TBinaryString): string; +begin + Result := EncodeData(StringToByteArray(AValue)); +end; + +procedure TTest_TAbstractEncodedStringExtRemotable.Equal(); +const ITER = 100; +var + i : Integer; + a, b : TAbstractEncodedStringExtRemotable; + c : TClass_A; +begin + c := nil; + b := nil; + a := CreateObject(); + try + b := CreateObject(); + CheckEquals(False, a.Equal(nil)); + c := TClass_A.Create(); + CheckEquals(False, a.Equal(c)); + a.BinaryData := StringToByteArray('wst'); + b.BinaryData := StringToByteArray('azerty'); + CheckEquals(False, a.Equal(b)); + CheckEquals(False, b.Equal(a)); + + for i := 1 to ITER do begin + a.BinaryData := RandomBytesValue(Random(500)); b.BinaryData := a.BinaryData; CheckEquals(True, a.Equal(b)); CheckEquals(True, b.Equal(a)); @@ -3032,28 +3308,28 @@ begin end; end; -procedure TTest_TBase64StringRemotable.SetBinaryData(); +procedure TTest_TAbstractEncodedStringExtRemotable.SetBinaryData(); const ITER = 100; var i : Integer; - a : TBase64StringRemotable; + a : TAbstractEncodedStringExtRemotable; s, es : string; begin - a := TBase64StringRemotable.Create(); + a := CreateObject(); try - s := ''; es := Base64Encode(s); - a.BinaryData := s; - CheckEquals(s,a.BinaryData); + s := ''; es := EncodeData(s); + a.BinaryData := StringToByteArray(s); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); for i := 1 to ITER do begin - s := RandomValue(Random(500)); es := Base64Encode(s); - a.BinaryData := s; - CheckEquals(s,a.BinaryData); + s := RandomValue(Random(500)); es := EncodeData(s); + a.BinaryData := StringToByteArray(s); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); end; finally @@ -3061,28 +3337,28 @@ begin end; end; -procedure TTest_TBase64StringRemotable.SetEncodedString(); +procedure TTest_TAbstractEncodedStringExtRemotable.SetEncodedString(); const ITER = 100; var i : Integer; - a : TBase64StringRemotable; + a : TAbstractEncodedStringExtRemotable; s, es : string; begin - a := TBase64StringRemotable.Create(); + a := CreateObject(); try s := ''; es := Base64Encode(s); a.EncodedString := es; - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); for i := 1 to ITER do begin - s := RandomValue(Random(500)); es := Base64Encode(s); + s := RandomValue(Random(500)); es := EncodeData(s); a.EncodedString := es; - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); + CheckEquals(StringToByteArray(s),a.BinaryData); CheckEquals(es,a.EncodedString); end; finally @@ -3090,16 +3366,16 @@ begin end; end; -procedure TTest_TBase64StringRemotable.LoadFromStream(); +procedure TTest_TAbstractEncodedStringExtRemotable.LoadFromStream(); var - locLoadedBuffer : TBase64StringRemotable; - locBuffer : TBinaryString; + locLoadedBuffer : TAbstractEncodedStringExtRemotable; + locBuffer : TByteDynArray; pBytePtr : PByte; locStream : TMemoryStream; i : PtrInt; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); @@ -3107,27 +3383,27 @@ begin locLoadedBuffer := nil; locStream := TMemoryStream.Create(); try - locStream.Write(locBuffer[1],Length(locBuffer)); - locLoadedBuffer := TBase64StringRemotable.Create(); + locStream.Write(locBuffer[0],Length(locBuffer)); + locLoadedBuffer := CreateObject(); locLoadedBuffer.LoadFromStream(locStream); - Check( locLoadedBuffer.BinaryData = locBuffer ); + CheckEquals( locBuffer, locLoadedBuffer.BinaryData ); finally locLoadedBuffer.Free(); locStream.Free(); end; end; -procedure TTest_TBase64StringRemotable.LoadFromFile(); +procedure TTest_TAbstractEncodedStringExtRemotable.LoadFromFile(); var - locLoadedBuffer : TBase64StringRemotable; - locBuffer : TBinaryString; + locLoadedBuffer : TAbstractEncodedStringExtRemotable; + locBuffer : TByteDynArray; pBytePtr : PByte; locStream : TMemoryStream; i : PtrInt; locFileName : string; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); @@ -3135,28 +3411,28 @@ begin locLoadedBuffer := nil; locStream := TMemoryStream.Create(); try - locStream.Write(locBuffer[1],Length(locBuffer)); + locStream.Write(locBuffer[0],Length(locBuffer)); locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); locStream.SaveToFile(locFileName); - locLoadedBuffer := TBase64StringRemotable.Create(); + locLoadedBuffer := CreateObject(); locLoadedBuffer.LoadFromFile(locFileName); - Check( locLoadedBuffer.BinaryData = locBuffer ); + CheckEquals( locBuffer, locLoadedBuffer.BinaryData ); finally locLoadedBuffer.Free(); locStream.Free(); end; end; -procedure TTest_TBase64StringRemotable.SaveToStream(); +procedure TTest_TAbstractEncodedStringExtRemotable.SaveToStream(); var - locObj : TBase64StringRemotable; - locBuffer : TBinaryString; + locObj : TAbstractEncodedStringExtRemotable; + locBuffer : TByteDynArray; pBytePtr : PByte; locStream : TMemoryStream; i : PtrInt; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); @@ -3164,39 +3440,39 @@ begin locObj := nil; locStream := TMemoryStream.Create(); try - locObj := TBase64StringRemotable.Create(); + locObj := CreateObject(); locObj.BinaryData := locBuffer; locObj.SaveToStream(locStream); Check( locStream.Size = Length(locObj.BinaryData) ); SetLength(locBuffer,locStream.Size); locStream.Position := 0; - locStream.Read(locBuffer[1],Length(locBuffer)); - Check( locBuffer = locObj.BinaryData ); + locStream.Read(locBuffer[0],Length(locBuffer)); + CheckEquals( locObj.BinaryData, locBuffer ); finally locObj.Free(); locStream.Free(); end; end; -procedure TTest_TBase64StringRemotable.SaveToFile(); +procedure TTest_TAbstractEncodedStringExtRemotable.SaveToFile(); var - locObj : TBase64StringRemotable; - locBuffer : TBinaryString; + locObj : TAbstractEncodedStringExtRemotable; + locBuffer : TByteDynArray; pBytePtr : PByte; locStream : TFileStream; i : PtrInt; locFileName : string; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); end; locStream := nil; - locObj := TBase64StringRemotable.Create(); + locObj := CreateObject(); try - locObj.BinaryData := locBuffer; + locObj.BinaryData := Copy(locBuffer); locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); DeleteFile(locFileName); locObj.SaveToFile(locFileName); @@ -3205,242 +3481,26 @@ begin Check( locStream.Size = Length(locObj.BinaryData) ); SetLength(locBuffer,locStream.Size); locStream.Position := 0; - locStream.Read(locBuffer[1],Length(locBuffer)); - Check( locBuffer = locObj.BinaryData ); + locStream.Read(locBuffer[0],Length(locBuffer)); + CheckEquals( locObj.BinaryData, locBuffer ); finally locObj.Free(); locStream.Free(); end; end; -{ TTest_TBase64StringExtRemotable } - -procedure TTest_TBase64StringExtRemotable.Equal(); +procedure TTest_TAbstractEncodedStringExtRemotable.test_Assign(); const ITER = 100; var i : Integer; - a, b : TBase64StringExtRemotable; - c : TClass_A; -begin - c := nil; - b := nil; - a := TBase64StringExtRemotable.Create(); - try - b := TBase64StringExtRemotable.Create(); - CheckEquals(False, a.Equal(nil)); - c := TClass_A.Create(); - CheckEquals(False, a.Equal(c)); - a.BinaryData := 'wst'; - b.BinaryData := 'azerty'; - CheckEquals(False, a.Equal(b)); - CheckEquals(False, b.Equal(a)); - - for i := 1 to ITER do begin - a.BinaryData := RandomValue(Random(500)); - b.BinaryData := a.BinaryData; - CheckEquals(True, a.Equal(b)); - CheckEquals(True, b.Equal(a)); - end; - finally - FreeAndNil(c); - FreeAndNil(b); - FreeAndNil(a); - end; -end; - -procedure TTest_TBase64StringExtRemotable.SetBinaryData(); -const ITER = 100; -var - i : Integer; - a : TBase64StringExtRemotable; - s, es : string; -begin - a := TBase64StringExtRemotable.Create(); - try - s := ''; es := Base64Encode(s); - a.BinaryData := s; - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - - for i := 1 to ITER do begin - s := RandomValue(Random(500)); es := Base64Encode(s); - a.BinaryData := s; - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - end; - finally - FreeAndNil(a); - end; -end; - -procedure TTest_TBase64StringExtRemotable.SetEncodedString(); -const ITER = 100; -var - i : Integer; - a : TBase64StringExtRemotable; - s, es : string; -begin - a := TBase64StringExtRemotable.Create(); - try - s := ''; es := Base64Encode(s); - a.EncodedString := es; - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - - for i := 1 to ITER do begin - s := RandomValue(Random(500)); es := Base64Encode(s); - a.EncodedString := es; - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - CheckEquals(s,a.BinaryData); - CheckEquals(es,a.EncodedString); - end; - finally - FreeAndNil(a); - end; -end; - -procedure TTest_TBase64StringExtRemotable.LoadFromStream(); -var - locLoadedBuffer : TBase64StringExtRemotable; - locBuffer : TBinaryString; - pBytePtr : PByte; - locStream : TMemoryStream; - i : PtrInt; -begin - SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); - for i := 0 to 255 do begin - pBytePtr^ := i; - Inc(pBytePtr); - end; - locLoadedBuffer := nil; - locStream := TMemoryStream.Create(); - try - locStream.Write(locBuffer[1],Length(locBuffer)); - locLoadedBuffer := TBase64StringExtRemotable.Create(); - locLoadedBuffer.LoadFromStream(locStream); - Check( locLoadedBuffer.BinaryData = locBuffer ); - finally - locLoadedBuffer.Free(); - locStream.Free(); - end; -end; - -procedure TTest_TBase64StringExtRemotable.LoadFromFile(); -var - locLoadedBuffer : TBase64StringExtRemotable; - locBuffer : TBinaryString; - pBytePtr : PByte; - locStream : TMemoryStream; - i : PtrInt; - locFileName : string; -begin - SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); - for i := 0 to 255 do begin - pBytePtr^ := i; - Inc(pBytePtr); - end; - locLoadedBuffer := nil; - locStream := TMemoryStream.Create(); - try - locStream.Write(locBuffer[1],Length(locBuffer)); - locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); - locStream.SaveToFile(locFileName); - locLoadedBuffer := TBase64StringExtRemotable.Create(); - locLoadedBuffer.LoadFromFile(locFileName); - Check( locLoadedBuffer.BinaryData = locBuffer ); - finally - locLoadedBuffer.Free(); - locStream.Free(); - end; -end; - -procedure TTest_TBase64StringExtRemotable.SaveToStream(); -var - locObj : TBase64StringExtRemotable; - locBuffer : TBinaryString; - pBytePtr : PByte; - locStream : TMemoryStream; - i : PtrInt; -begin - SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); - for i := 0 to 255 do begin - pBytePtr^ := i; - Inc(pBytePtr); - end; - locObj := nil; - locStream := TMemoryStream.Create(); - try - locObj := TBase64StringExtRemotable.Create(); - locObj.BinaryData := locBuffer; - locObj.SaveToStream(locStream); - Check( locStream.Size = Length(locObj.BinaryData) ); - SetLength(locBuffer,locStream.Size); - locStream.Position := 0; - locStream.Read(locBuffer[1],Length(locBuffer)); - Check( locBuffer = locObj.BinaryData ); - finally - locObj.Free(); - locStream.Free(); - end; -end; - -procedure TTest_TBase64StringExtRemotable.SaveToFile(); -var - locObj : TBase64StringExtRemotable; - locBuffer : TBinaryString; - pBytePtr : PByte; - locStream : TFileStream; - i : PtrInt; - locFileName : string; -begin - SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); - for i := 0 to 255 do begin - pBytePtr^ := i; - Inc(pBytePtr); - end; - locStream := nil; - locObj := TBase64StringExtRemotable.Create(); - try - locObj.BinaryData := locBuffer; - locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); - DeleteFile(locFileName); - locObj.SaveToFile(locFileName); - Check(FileExists(locFileName)); - locStream := TFileStream.Create(locFileName,fmOpenRead); - Check( locStream.Size = Length(locObj.BinaryData) ); - SetLength(locBuffer,locStream.Size); - locStream.Position := 0; - locStream.Read(locBuffer[1],Length(locBuffer)); - Check( locBuffer = locObj.BinaryData ); - finally - locObj.Free(); - locStream.Free(); - end; -end; - -procedure TTest_TBase64StringExtRemotable.test_Assign(); -const ITER = 100; -var - i : Integer; - a, b : TBase64StringExtRemotable; + a, b : TAbstractEncodedStringExtRemotable; begin b := nil; - a := TBase64StringExtRemotable.Create(); + a := CreateObject(); try - b := TBase64StringExtRemotable.Create(); + b := CreateObject(); for i := 1 to ITER do begin - a.BinaryData := RandomValue(Random(500)); + a.BinaryData := RandomBytesValue(Random(500)); b.Assign(a); CheckEquals(a.BinaryData, b.BinaryData); CheckEquals(a.EncodedString, b.EncodedString); @@ -3682,22 +3742,22 @@ end; procedure TTest_Procedures.test_LoadBufferFromStream(); var - locBuffer, locLoadedBuffer : TBinaryString; + locBuffer, locLoadedBuffer : TByteDynArray; pBytePtr : PByte; locStream : TMemoryStream; i : PtrInt; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); end; locStream := TMemoryStream.Create(); try - locStream.Write(locBuffer[1],Length(locBuffer)); + locStream.Write(locBuffer[0],Length(locBuffer)); locLoadedBuffer := LoadBufferFromStream(locStream); - Check( locLoadedBuffer = locBuffer ); + CheckEquals( locBuffer, locLoadedBuffer ); finally locStream.Free(); end; @@ -3705,30 +3765,91 @@ end; procedure TTest_Procedures.test_LoadBufferFromFile(); var - locBuffer, locLoadedBuffer : TBinaryString; + locBuffer, locLoadedBuffer : TByteDynArray; pBytePtr : PByte; locStream : TMemoryStream; i : PtrInt; locFileName : string; begin SetLength(locBuffer,255); - pBytePtr := PByte(@(locBuffer[1])); + pBytePtr := PByte(@(locBuffer[0])); for i := 0 to 255 do begin pBytePtr^ := i; Inc(pBytePtr); end; locStream := TMemoryStream.Create(); try - locStream.Write(locBuffer[1],Length(locBuffer)); + locStream.Write(locBuffer[0],Length(locBuffer)); locFileName := wstExpandLocalFileName('test_LoadBufferFromFile.bin'); locStream.SaveToFile(locFileName); locLoadedBuffer := LoadBufferFromFile(locFileName); - Check( locLoadedBuffer = locBuffer ); + CheckEquals(locBuffer, locLoadedBuffer); finally locStream.Free(); end; end; +{ TTest_TBase64StringRemotable } + +class function TTest_TBase64StringRemotable.CreateObject( ): TAbstractEncodedStringRemotable; +begin + Result := TBase64StringRemotable.Create(); +end; + +class function TTest_TBase64StringRemotable.EncodeData(const AValue: TByteDynArray): string; +begin + if ( Length(AValue) > 0 ) then + Result := Base64Encode(Length(AValue),AValue[0]) + else + Result := ''; +end; + +{ TTest_TBase16StringRemotable } + +class function TTest_TBase16StringRemotable.CreateObject( ): TAbstractEncodedStringRemotable; +begin + Result := TBase16StringRemotable.Create(); +end; + +class function TTest_TBase16StringRemotable.EncodeData(const AValue: TByteDynArray): string; +begin + if ( Length(AValue) > 0 ) then + Result := Base16Encode(AValue[0],Length(AValue)) + else + Result := ''; +end; + +{ TTest_TBase64StringExtRemotable } + +class function TTest_TBase64StringExtRemotable.CreateObject( ): TAbstractEncodedStringExtRemotable; +begin + Result := TBase64StringExtRemotable.Create(); +end; + +class function TTest_TBase64StringExtRemotable.EncodeData(const AValue: TByteDynArray): string; +begin + if ( Length(AValue) > 0 ) then + Result := Base64Encode(Length(AValue),AValue[0]) + else + Result := ''; +end; + + +{ TTest_TBase16StringExtRemotable } + +class function TTest_TBase16StringExtRemotable.CreateObject( ): TAbstractEncodedStringExtRemotable; +begin + Result := TBase16StringExtRemotable.Create(); +end; + +class function TTest_TBase16StringExtRemotable.EncodeData(const AValue: TByteDynArray): string; +begin + if ( Length(AValue) > 0 ) then + Result := Base16Encode(AValue[0],Length(AValue)) + else + Result := ''; +end; + initialization RegisterTest('Support',TTest_TObjectCollectionRemotable.Suite); RegisterTest('Support',TTest_TBaseComplexRemotable.Suite); @@ -3758,6 +3879,8 @@ initialization RegisterTest('Support',TTest_TBase64StringRemotable.Suite); RegisterTest('Support',TTest_TBase64StringExtRemotable.Suite); + RegisterTest('Support',TTest_TBase16StringRemotable.Suite); + RegisterTest('Support',TTest_TBase16StringExtRemotable.Suite); RegisterTest('Support',TTest_Procedures.Suite); diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpi b/wst/trunk/tests/test_suite/wst_test_suite.lpi index 3c9a7975e..085a68454 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpi +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpi @@ -1,16 +1,17 @@ - + - + + @@ -18,10 +19,10 @@ - + - + @@ -33,47 +34,47 @@ - + - + - + - + - + - + - + - + - + @@ -83,27 +84,27 @@ - + - + - + - + - + @@ -113,7 +114,7 @@ - + @@ -123,27 +124,27 @@ - + - + - + - + - + @@ -153,7 +154,7 @@ - + @@ -163,12 +164,12 @@ - + - + @@ -207,13 +208,24 @@ + + + + + + + + + + + - - + + diff --git a/wst/trunk/tests/test_suite/wst_test_suite.lpr b/wst/trunk/tests/test_suite/wst_test_suite.lpr index c29b89692..35bf8f978 100644 --- a/wst/trunk/tests/test_suite/wst_test_suite.lpr +++ b/wst/trunk/tests/test_suite/wst_test_suite.lpr @@ -18,7 +18,8 @@ uses xsd_consts, base_json_formatter, wsdl_parser, test_support, basex_encode, test_basex_encode, json_formatter, server_service_json, test_json, test_suite_utils, test_generators, test_std_cursors, test_rtti_filter, -test_wst_cursors, test_registry, test_soap_specific, test_generators_runtime; +test_wst_cursors, test_registry, test_soap_specific, test_generators_runtime, +test_date_utils; Const ShortOpts = 'alh'; diff --git a/wst/trunk/ws_helper/pascal_parser_intf.pas b/wst/trunk/ws_helper/pascal_parser_intf.pas index 5cba37363..f156461a0 100644 --- a/wst/trunk/ws_helper/pascal_parser_intf.pas +++ b/wst/trunk/ws_helper/pascal_parser_intf.pas @@ -228,14 +228,17 @@ const ('Double', 'TComplexFloatDoubleContentRemotable', 'double'), ('Extended', 'TComplexFloatExtendedContentRemotable', 'decimal') ); - BOXED_TYPES_COUNT = 1; + BOXED_TYPES_COUNT = 2; BOXED_TYPES : Array[0..Pred(BOXED_TYPES_COUNT)] Of array[0..2] of string = ( - ('TBase64StringRemotable', 'TBase64StringExtRemotable', 'base64Binary') + ('TBase64StringRemotable', 'TBase64StringExtRemotable', 'base64Binary'), + ('TBase16StringRemotable', 'TBase16StringExtRemotable', 'hexBinary') ); - SPECIAL_SIMPLE_TYPES_COUNT = 2 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; + SPECIAL_SIMPLE_TYPES_COUNT = 4 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; SPECIAL_SIMPLE_TYPES : Array[0..Pred(SPECIAL_SIMPLE_TYPES_COUNT)] Of array[0..2] of string = ( ('string', 'TComplexStringContentRemotable', 'string'), - ('WideString', 'TComplexWideStringContentRemotable', 'string') + ('WideString', 'TComplexWideStringContentRemotable', 'string'), + ('AnsiChar', 'TComplexAnsiCharContentRemotable', 'string'), + ('WideChar', 'TComplexWideCharContentRemotable', 'string') {$IFDEF WST_UNICODESTRING} ,('UnicodeString', 'TComplexUnicodeStringContentRemotable', 'string') {$ENDIF WST_UNICODESTRING} @@ -319,13 +322,13 @@ procedure AddSystemSymbol( procedure RegisterBoxedTypes(); var i : Integer; - nativeType : TPasNativeClassType; + nativeType : TPasNativeSimpleContentClassType; syb : TPasNativeSimpleContentClassType; s : string; - typlst : array[0..Pred(BOXED_TYPES_COUNT)] of TPasNativeClassType; + typlst : array[0..Pred(BOXED_TYPES_COUNT)] of TPasNativeSimpleContentClassType; begin for i := Low(BOXED_TYPES) to High(BOXED_TYPES) do begin - nativeType := TPasNativeClassType(AContainer.CreateElement(TPasNativeClassType,BOXED_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0)); + nativeType := TPasNativeSimpleContentClassType(AContainer.CreateElement(TPasNativeSimpleContentClassType,BOXED_TYPES[i][0],ADest.InterfaceSection,visPublic,'',0)); ADest.InterfaceSection.Declarations.Add(nativeType); ADest.InterfaceSection.Types.Add(nativeType); typlst[i] := nativeType; diff --git a/wst/trunk/ws_helper/xsd_generator.pas b/wst/trunk/ws_helper/xsd_generator.pas index 72d193df5..981da52af 100644 --- a/wst/trunk/ws_helper/xsd_generator.pas +++ b/wst/trunk/ws_helper/xsd_generator.pas @@ -186,6 +186,22 @@ type );override; end; + TAnsiCharHelper = class(TAbstractSpecialTypeHelper,IXsdSpecialTypeHelper) + protected + procedure HandleTypeUsage( + ATargetNode, + ASchemaNode : TDOMElement + );override; + end; + + TWideCharHelper = class(TAbstractSpecialTypeHelper,IXsdSpecialTypeHelper) + protected + procedure HandleTypeUsage( + ATargetNode, + ASchemaNode : TDOMElement + );override; + end; + {$IFDEF WST_UNICODESTRING} { TUnicodeStringHelper } @@ -401,6 +417,28 @@ begin ATargetNode.SetAttribute(Format('%s:%s',[s_WST,s_WST_typeHint]),'WideString'); end; +{ TAnsiCharHelper } + +procedure TAnsiCharHelper.HandleTypeUsage(ATargetNode, ASchemaNode: TDOMElement); +var + strBuffer : string; +begin + if not FindAttributeByValueInNode(s_WST_base_namespace,ASchemaNode,strBuffer) then + ASchemaNode.SetAttribute(Format('%s:%s',[s_xmlns,s_WST]),s_WST_base_namespace); + ATargetNode.SetAttribute(Format('%s:%s',[s_WST,s_WST_typeHint]),'AnsiChar'); +end; + +{ TWideCharHelper } + +procedure TWideCharHelper.HandleTypeUsage(ATargetNode, ASchemaNode: TDOMElement); +var + strBuffer : string; +begin + if not FindAttributeByValueInNode(s_WST_base_namespace,ASchemaNode,strBuffer) then + ASchemaNode.SetAttribute(Format('%s:%s',[s_xmlns,s_WST]),s_WST_base_namespace); + ATargetNode.SetAttribute(Format('%s:%s',[s_WST,s_WST_typeHint]),'WideChar'); +end; + {$IFDEF WST_UNICODESTRING} { TUnicodeStringHelper } @@ -481,9 +519,11 @@ function TXsdTypeHandlerRegistry.FindHelper( out AHelper: IXsdSpecialTypeHelper ) : Boolean; const - HELPER_COUNT = 1 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; + HELPER_COUNT = 3 {$IFDEF WST_UNICODESTRING} + 1 {$ENDIF WST_UNICODESTRING}; HELPER_MAP : array[0..Pred(HELPER_COUNT)] of TSpecialTypeHelperRecord = ( - ( Name : 'widestring'; HelperClass : TWideStringHelper;) + ( Name : 'widestring'; HelperClass : TWideStringHelper;), + ( Name : 'ansichar'; HelperClass : TAnsiCharHelper;), + ( Name : 'widechar'; HelperClass : TWideCharHelper;) {$IFDEF WST_UNICODESTRING} ,( Name : 'unicodestring'; HelperClass : TUnicodeStringHelper;) {$ENDIF WST_UNICODESTRING} @@ -848,14 +888,17 @@ var if Assigned(propTypItm) then begin if propTypItm.InheritsFrom(TPasUnresolvedTypeRef) then propTypItm := AContainer.FindElement(AContainer.GetExternalName(propTypItm)) as TPasType; - prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument,GetOwner().GetPreferedShortNames()); + //prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument,GetOwner().GetPreferedShortNames()); propItmUltimeType := GetUltimeType(propTypItm); isEmbeddedArray := propItmUltimeType.InheritsFrom(TPasArrayType) and ( AContainer.GetArrayStyle(TPasArrayType(propItmUltimeType)) = asEmbeded ); - if isEmbeddedArray then - s := AContainer.GetExternalName(TPasArrayType(propItmUltimeType).ElType) - else + if isEmbeddedArray then begin + s := AContainer.GetExternalName(TPasArrayType(propItmUltimeType).ElType); + prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,TPasArrayType(propItmUltimeType).ElType),ADocument,GetOwner().GetPreferedShortNames()); + end else begin s := AContainer.GetExternalName(propTypItm); + prop_ns_shortName := GetNameSpaceShortName(GetTypeNameSpace(AContainer,propTypItm),ADocument,GetOwner().GetPreferedShortNames()); + end; propNode.SetAttribute(s_type,Format('%s:%s',[prop_ns_shortName,s])); if propTypItm.InheritsFrom(TPasNativeSpecialSimpleType) then begin if GetRegistry().FindHelper(propTypItm,typeHelper) then @@ -1291,6 +1334,7 @@ begin FSchemaNode.SetAttribute(Format('%s:%s',[s_xmlns,s_tns]),unitExternalName); end; + initialization XsdTypeHandlerRegistryInst := TXsdTypeHandlerRegistry.Create() as IXsdTypeHandlerRegistry; RegisterFondamentalTypes(); diff --git a/wst/trunk/wst_types.pas b/wst/trunk/wst_types.pas index 6c2691735..33f0fd1b8 100644 --- a/wst/trunk/wst_types.pas +++ b/wst/trunk/wst_types.pas @@ -26,6 +26,9 @@ type {$ELSE WST_UNICODESTRING} TBinaryString = ansistring; {$ENDIF} + + TByteDynArray = array of Byte; + { TDataObject } TDataObject = class