paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ Base64( refactored ),

Browse Source 
+ Base16 
+ Extendable "AnsiChar" and "WideChar"
+ tests

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@665 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2009-01-19 17:46:33 +00:00
parent a0f8752046
commit cff1351132
17 changed files with 1485 additions and 506 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

451
wst/trunk/base_service_intf.pas
View File

@ -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();

164
wst/trunk/basex_encode.pas
View File

@ -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.

12
wst/trunk/imp_utils.pas
View File

@ -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

22
wst/trunk/tests/test_suite/files/class_ansichar_property.wsdl Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="class_widestring_property"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="class_widestring_property"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="class_ansichar_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="AnsiChar"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="AnsiChar"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

8
wst/trunk/tests/test_suite/files/class_ansichar_property.xsd Normal file
View File

@ -0,0 +1,8 @@
<schema targetNamespace="class_ansichar_property" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="class_ansichar_property" xmlns:wst="urn:wst_base">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="AnsiChar"/>
</xsd:sequence>
<xsd:attribute name="elementAtt" type="xsd:string" wst:TypeHint="AnsiChar" use="required"/>
</xsd:complexType>
</schema>

22
wst/trunk/tests/test_suite/files/class_widechar_property.wsdl Normal file
View File

@ -0,0 +1,22 @@
<?xml version="1.0"?>
<definitions name="wst_test"
xmlns="http://schemas.xmlsoap.org/wsdl/"
xmlns:tns="class_widestring_property"
xmlns:xsd="http://www.w3.org/2001/XMLSchema"
xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
targetNamespace="class_widestring_property"
xmlns:wst="urn:wst_base">
<types>
<xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="class_widestring_property">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="WideChar"/>
</xsd:sequence>
<xsd:attribute use="required" name="elementAtt" type="xsd:string" wst:TypeHint="WideChar"/>
</xsd:complexType>
</xsd:schema>
</types>
</definitions>

8
wst/trunk/tests/test_suite/files/class_widechar_property.xsd Normal file
View File

@ -0,0 +1,8 @@
<schema targetNamespace="class_widechar_property" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:tns="class_widechar_property" xmlns:wst="urn:wst_base">
<xsd:complexType name="TSampleClass">
<xsd:sequence>
<xsd:element name="elementProp" type="xsd:string" wst:TypeHint="WideChar"/>
</xsd:sequence>
<xsd:attribute name="elementAtt" type="xsd:string" wst:TypeHint="WideChar" use="required"/>
</xsd:complexType>
</schema>

130
wst/trunk/tests/test_suite/test_basex_encode.pas
View File

@ -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.

124
wst/trunk/tests/test_suite/test_generators.pas
View File

@ -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;

110
wst/trunk/tests/test_suite/test_parsers.pas
View File

@ -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);

80
wst/trunk/tests/test_suite/test_suite_utils.pas
View File

@ -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.

711
wst/trunk/tests/test_suite/test_support.pas
View File

@ -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);

70
wst/trunk/tests/test_suite/wst_test_suite.lpi
View File

@ -1,16 +1,17 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<IconPath Value=".\"/>
<TargetFileExt Value=".exe"/>
</General>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -18,10 +19,10 @@
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="--suite=TTest_XsdParser"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="37">
<Units Count="39">
<Unit0>
<Filename Value="wst_test_suite.lpr"/>
<IsPartOfProject Value="True"/>
@ -33,47 +34,47 @@
<UnitName Value="testformatter_unit"/>
</Unit1>
<Unit2>
<Filename Value="../../server_service_soap.pas"/>
<Filename Value="..\..\server_service_soap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_soap"/>
</Unit2>
<Unit3>
<Filename Value="../../soap_formatter.pas"/>
<Filename Value="..\..\soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="soap_formatter"/>
</Unit3>
<Unit4>
<Filename Value="../../base_binary_formatter.pas"/>
<Filename Value="..\..\base_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_binary_formatter"/>
</Unit4>
<Unit5>
<Filename Value="../../base_service_intf.pas"/>
<Filename Value="..\..\base_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_service_intf"/>
</Unit5>
<Unit6>
<Filename Value="../../base_soap_formatter.pas"/>
<Filename Value="..\..\base_soap_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_soap_formatter"/>
</Unit6>
<Unit7>
<Filename Value="../../binary_formatter.pas"/>
<Filename Value="..\..\binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_formatter"/>
</Unit7>
<Unit8>
<Filename Value="../../binary_streamer.pas"/>
<Filename Value="..\..\binary_streamer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="binary_streamer"/>
</Unit8>
<Unit9>
<Filename Value="../../server_binary_formatter.pas"/>
<Filename Value="..\..\server_binary_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_binary_formatter"/>
</Unit9>
<Unit10>
<Filename Value="../../metadata_repository.pas"/>
<Filename Value="..\..\metadata_repository.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_repository"/>
</Unit10>
@ -83,27 +84,27 @@
<UnitName Value="testmetadata_unit"/>
</Unit11>
<Unit12>
<Filename Value="../../ws_helper/metadata_generator.pas"/>
<Filename Value="..\..\ws_helper\metadata_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_generator"/>
</Unit12>
<Unit13>
<Filename Value="../../metadata_wsdl.pas"/>
<Filename Value="..\..\metadata_wsdl.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="metadata_wsdl"/>
</Unit13>
<Unit14>
<Filename Value="../../server_service_intf.pas"/>
<Filename Value="..\..\server_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_intf"/>
</Unit14>
<Unit15>
<Filename Value="../../base_xmlrpc_formatter.pas"/>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_xmlrpc_formatter"/>
</Unit15>
<Unit16>
<Filename Value="../../wst_fpc_xml.pas"/>
<Filename Value="..\..\wst_fpc_xml.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wst_fpc_xml"/>
</Unit16>
@ -113,7 +114,7 @@
<UnitName Value="test_utilities"/>
</Unit17>
<Unit18>
<Filename Value="../../server_service_xmlrpc.pas"/>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_xmlrpc"/>
</Unit18>
@ -123,27 +124,27 @@
<UnitName Value="test_parsers"/>
</Unit19>
<Unit20>
<Filename Value="../../ws_helper/wsdl_generator.pas"/>
<Filename Value="..\..\ws_helper\wsdl_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wsdl_generator"/>
</Unit20>
<Unit21>
<Filename Value="../../ws_helper/xsd_generator.pas"/>
<Filename Value="..\..\ws_helper\xsd_generator.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xsd_generator"/>
</Unit21>
<Unit22>
<Filename Value="../../ws_helper/xsd_consts.pas"/>
<Filename Value="..\..\ws_helper\xsd_consts.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xsd_consts"/>
</Unit22>
<Unit23>
<Filename Value="../../ws_helper/wsdl_parser.pas"/>
<Filename Value="..\..\ws_helper\wsdl_parser.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="wsdl_parser"/>
</Unit23>
<Unit24>
<Filename Value="../../base_json_formatter.pas"/>
<Filename Value="..\..\base_json_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="base_json_formatter"/>
</Unit24>
@ -153,7 +154,7 @@
<UnitName Value="test_support"/>
</Unit25>
<Unit26>
<Filename Value="../../basex_encode.pas"/>
<Filename Value="..\..\basex_encode.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="basex_encode"/>
</Unit26>
@ -163,12 +164,12 @@
<UnitName Value="test_basex_encode"/>
</Unit27>
<Unit28>
<Filename Value="../../json_formatter.pas"/>
<Filename Value="..\..\json_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="json_formatter"/>
</Unit28>
<Unit29>
<Filename Value="../../server_service_json.pas"/>
<Filename Value="..\..\server_service_json.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_json"/>
</Unit29>
@ -207,13 +208,24 @@
<IsPartOfProject Value="True"/>
<UnitName Value="test_generators_runtime"/>
</Unit36>
<Unit37>
<Filename Value="test_soap_specific.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_soap_specific"/>
</Unit37>
<Unit38>
<Filename Value="test_date_utils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_date_utils"/>
</Unit38>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="../../"/>
<OtherUnitFiles Value="../../;../../ws_helper/;../../wst_rtti_filter/;../../fcl-json/src/"/>
<IncludeFiles Value="..\..\"/>
<OtherUnitFiles Value="..\..\;..\..\ws_helper\;..\..\wst_rtti_filter\;..\..\fcl-json\src\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>

3
wst/trunk/tests/test_suite/wst_test_suite.lpr
View File

@ -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';

17
wst/trunk/ws_helper/pascal_parser_intf.pas
View File

@ -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;

56
wst/trunk/ws_helper/xsd_generator.pas
View File

@ -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();

3
wst/trunk/wst_types.pas
View File

@ -26,6 +26,9 @@ type
{$ELSE WST_UNICODESTRING}
TBinaryString = ansistring;
{$ENDIF}
TByteDynArray = array of Byte;
{ TDataObject }
TDataObject = class