TDurationRemotable and TTimeRemotable implementation + tests

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@896 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2009-07-06 16:21:25 +00:00
parent bbc9203ac8
commit 6ab87b285d
7 changed files with 1018 additions and 68 deletions

View File

@ -449,10 +449,50 @@ type
property FractionalSecond : PtrUInt read FFractionalSecond write FFractionalSecond;
end;
TTimeRemotable = class(TBaseDateRemotable)
protected
//class function FormatDate(const ADate : TDateTime):string;override;
//class function ParseDate(const ABuffer : string):TDateTime;override;
{ TTimeRemotable }
TTimeRemotable = class(TAbstractSimpleRemotable)
private
FData : TTimeRec;
private
function GetOffset(AIndex: integer): Shortint;
function GetPart(AIndex: integer): Byte;
procedure SetMilliSecond(const AValue: Word);
procedure SetOffset(AIndex: integer; const AValue: Shortint);
procedure SetPart(AIndex: integer; const AValue: Byte);
function GetAsString: string;
function GetMilliSecond: Word;
procedure SetAsString(const AValue: string);
public
class procedure Save(
AObject : TBaseRemotable;
AStore : IFormatterBase;
const AName : string;
const ATypeInfo : PTypeInfo
);override;
class procedure Load(
var AObject : TObject;
AStore : IFormatterBase;
var AName : string;
const ATypeInfo : PTypeInfo
);override;
procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
procedure Clear();
class function Parse(const ABuffer : string) : TTimeRec;
class function ToString(const AValue : TTimeRec) : string;
property Hour : Byte index 0 read GetPart write SetPart;
property Minute : Byte index 1 read GetPart write SetPart;
property Second : Byte index 2 read GetPart write SetPart;
property MilliSecond : Word read GetMilliSecond write SetMilliSecond;
property HourOffset : Shortint index 0 read GetOffset write SetOffset;
property MinuteOffset : Shortint index 1 read GetOffset write SetOffset;
property Data : TTimeRec read FData write FData;
property AsString : string read GetAsString write SetAsString;
end;
TAbstractComplexRemotableClass = class of TAbstractComplexRemotable;
@ -6842,6 +6882,150 @@ begin
BinaryData := Base16Decode(AValue,[xoDecodeIgnoreIllegalChar]);
end;
{ TTimeRemotable }
function TTimeRemotable.GetAsString : string;
begin
Result := ToString(Data);
end;
function TTimeRemotable.GetMilliSecond: Word;
begin
Result := Data.MilliSecond;
end;
function TTimeRemotable.GetOffset(AIndex: integer): Shortint;
begin
case AIndex of
0 : Result := Data.HourOffset;
1 : Result := Data.MinuteOffset;
else
Result := 0;
end;
end;
function TTimeRemotable.GetPart(AIndex: integer): Byte;
begin
case AIndex of
0 : Result := Data.Hour;
1 : Result := Data.Minute;
2 : Result := Data.Second;
else
Result := 0;
end;
end;
procedure TTimeRemotable.SetAsString(const AValue: string);
begin
Data := Parse(AValue);
end;
procedure TTimeRemotable.SetMilliSecond(const AValue: Word);
begin
FData.MilliSecond := AValue;
end;
procedure TTimeRemotable.SetOffset(AIndex: integer; const AValue: Shortint);
begin
case AIndex of
0 : FData.HourOffset := AValue;
1 : FData.MinuteOffset := AValue;
end;
end;
procedure TTimeRemotable.SetPart(AIndex: integer; const AValue: Byte);
begin
case AIndex of
0 : FData.Hour := AValue;
1 : FData.Minute := AValue;
2 : FData.Second := AValue;
end;
end;
class procedure TTimeRemotable.Save(
AObject : TBaseRemotable;
AStore : IFormatterBase;
const AName : string;
const ATypeInfo : PTypeInfo
);
var
buffer : string;
begin
buffer := TTimeRemotable(AObject).AsString;
AStore.BeginObject(AName,ATypeInfo);
try
AStore.PutScopeInnerValue(TypeInfo(string),buffer);
finally
AStore.EndScope();
end;
end;
class procedure TTimeRemotable.Load(
var AObject : TObject;
AStore : IFormatterBase;
var AName : string;
const ATypeInfo : PTypeInfo
);
var
strBuffer : string;
begin
if ( AStore.BeginObjectRead(AName,ATypeInfo) >= 0 ) then begin
try
strBuffer := '';
AStore.GetScopeInnerValue(TypeInfo(string),strBuffer);
if IsStrEmpty(strBuffer) then
(AObject as TTimeRemotable).Clear()
else
(AObject as TTimeRemotable).AsString := strBuffer;
finally
AStore.EndScopeRead();
end;
end;
end;
procedure TTimeRemotable.Assign(Source: TPersistent);
begin
if ( Source = nil ) then begin
Clear();
end else begin
if Source.InheritsFrom(TTimeRemotable) then
Self.Data := TTimeRemotable(Source).Data
else if Source.InheritsFrom(TDateRemotable) then
Self.Data := DateTimeToTimeRec(TDateRemotable(Source).AsUTCDate)
else
inherited Assign(Source);
end;
end;
function TTimeRemotable.Equal(const ACompareTo: TBaseRemotable): Boolean;
begin
if ( ACompareTo = nil ) then begin
Result := date_utils.Equals(Data,ZERO_TIME );
end else begin
if ACompareTo.InheritsFrom(TTimeRemotable) then
Result := date_utils.Equals(Self.Data,TTimeRemotable(ACompareTo).Data)
else
Result := inherited Equal(ACompareTo);
end;
end;
procedure TTimeRemotable.Clear();
begin
Data := ZERO_TIME;
end;
class function TTimeRemotable.Parse(const ABuffer: string): TTimeRec;
begin
Result := xsd_StrToTime(ABuffer);
end;
class function TTimeRemotable.ToString(const AValue: TTimeRec): string;
begin
Result := xsd_TimeToStr(AValue);
end;
initialization
initialize_base_service_intf();

View File

@ -1257,13 +1257,19 @@ procedure TXmlRpcBaseFormatter.BeginObject(
);
var
locScopeType : TScopeType;
locClass : TClass;
begin
if ( ATypeInfo^.Kind = tkClass ) and
( GetTypeData(ATypeInfo)^.ClassType.InheritsFrom(TDateRemotable) )
then
locScopeType := stXmlRpcDate
else
locScopeType := stObject;
locScopeType := stObject;
if ( ATypeInfo^.Kind = tkClass ) then begin
locClass := GetTypeData(ATypeInfo)^.ClassType;
if locClass.InheritsFrom(TAbstractSimpleRemotable) then begin
if locClass.InheritsFrom(TDateRemotable) then
locScopeType := stXmlRpcDate
else
locScopeType := stSimpleContent;
end;
end;
BeginScope(AName,'','',locScopeType,asNone);
end;

View File

@ -24,23 +24,64 @@ type
MinuteOffset : Shortint;
end;
TTimeRec = packed record
Hour : Byte;
Minute : Byte;
Second : Byte;
MilliSecond : Word;
HourOffset : Shortint;
MinuteOffset : Shortint;
end;
const
ZERO_DATE : TDateTimeRec = ( Date : 0; HourOffset : 0; MinuteOffset : 0; );
ZERO_TIME : TTimeRec = (
Hour : 0;
Minute : 0;
Second : 0;
MilliSecond : 0;
HourOffset : 0;
MinuteOffset : 0;
);
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
function xsd_StrToDate(const AStr : string) : TDateTimeRec;
function xsd_StrToDate(const AStr : string) : TDateTimeRec; {$IFDEF USE_INLINE}inline;{$ENDIF}
function xsd_DateTimeToStr(const ADate : TDateTimeRec) : string;overload;
function xsd_DateTimeToStr(const ADate : TDateTime) : string;overload;
function xsd_TimeToStr(const ATime : TTimeRec) : string;
function xsd_TryStrToTime(const AStr : string; out ADate : TTimeRec) : Boolean;
function xsd_StrToTime(const AStr : string) : TTimeRec; {$IFDEF USE_INLINE}inline;{$ENDIF}
function xsd_EncodeTime(
const AHour,
AMin,
ASec : Byte;
const AMiliSec : Word
) : TTimeRec; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
function xsd_EncodeTime(
const AHour,
AMin,
ASec : Byte;
const AMiliSec : Word;
const AHourOffset : Shortint;
const AMinuteOffset : Shortint
) : TTimeRec; overload; {$IFDEF USE_INLINE}inline;{$ENDIF}
function DateTimeToTimeRec(const ADateTime : TDateTime) : TTimeRec; {$IFDEF USE_INLINE}inline;{$ENDIF}
function TimeRecToDateTime(const ATime : TTimeRec) : TDateTime; {$IFDEF USE_INLINE}inline;{$ENDIF}
function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF}
function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;{$IFDEF USE_INLINE}inline;{$ENDIF}
function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime;
function DateEquals(const AA,AB: TDateTimeRec) : Boolean;
function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime; overload;
function NormalizeToUTC(const ATime : TTimeRec) : TTimeRec; overload;
function Equals(const AA,AB: TDateTimeRec) : Boolean; overload;
function Equals(const AA,AB: TTimeRec) : Boolean; overload;
resourcestring
SERR_InvalidDate = '"%s" is not a valid date.';
SERR_InvalidTime = '"%s" is not a valid time.';
implementation
@ -65,8 +106,27 @@ begin
Result := IncMinute(Result,-ADate.MinuteOffset);
end;
function NormalizeToUTC(const ATime : TTimeRec) : TTimeRec;
var
locDate : TDateTime;
e_h, e_mn, e_ss, e_ms : Word;
begin
locDate := TimeRecToDateTime(ATime);
if ( ATime.HourOffset <> 0 ) then
locDate := IncHour(locDate,ATime.HourOffset);
if ( ATime.MinuteOffset <> 0 ) then
locDate := IncMinute(locDate,ATime.MinuteOffset);
DecodeTime(locDate,e_h,e_mn,e_ss,e_ms);
Result.Hour := e_h;
Result.Minute := e_mn;
Result.Second := e_ss;
Result.MilliSecond := e_ms;
Result.HourOffset := 0;
Result.MinuteOffset := 0;
end;
{$HINTS OFF}
function DateEquals(const AA,AB: TDateTimeRec) : Boolean;
function Equals(const AA,AB: TDateTimeRec) : Boolean;
var
e, a : TDateTime;
e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms : Word;
@ -81,6 +141,20 @@ begin
end;
{$HINTS ON}
function Equals(const AA,AB: TTimeRec) : Boolean;
var
a, b : TTimeRec;
begin
a := NormalizeToUTC(AA);
b := NormalizeToUTC(AB);
Result := ( a.Hour = b.Hour ) and
( a.Minute = b.Minute ) and
( a.Second = b.Second ) and
( a.MilliSecond = b.MilliSecond ) and
( a.HourOffset = b.HourOffset ) and
( a.MinuteOffset = b.MinuteOffset );
end;
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
const
DATE_SEP_CHAR = '-'; TIME_MARKER_CHAR = 'T'; TIME_SEP_CHAR = ':';
@ -225,7 +299,6 @@ end;
function xsd_DateTimeToStr(const ADate : TDateTimeRec) : string;
var
locDate : TDateTime;
s, buffer : string;
d, m, y : Word;
hh, mn, ss, ssss : Word;
begin
@ -235,46 +308,11 @@ begin
locDate := IncHour(locDate,-ADate.HourOffset);
if ( ADate.MinuteOffset <> 0 ) then
locDate := IncMinute(locDate,-ADate.MinuteOffset);
DecodeDate(locDate,y,m,d);
s := IntToStr(y);
buffer := IntToStr(m);
if ( Length(s) < 4 ) then
s := StringOfChar('0', ( 4 - Length(s) ) ) + s;
if ( m < 10 ) then
buffer := '0' + buffer;
s := Format('%s-%s',[s,buffer]);
buffer := IntToStr(d);
if ( d < 10 ) then
buffer := '0' + buffer;
s := Format('%s-%s',[s,buffer]);
DecodeTime(locDate,hh,mn,ss,ssss);
buffer := IntToStr(hh);
if ( hh < 10 ) then
buffer := '0' + buffer;
s := Format('%sT%s',[s,buffer]);
buffer := IntToStr(mn);
if ( mn < 10 ) then
buffer := '0' + buffer;
s := Format('%s:%s',[s,buffer]);
buffer := IntToStr(ss);
if ( ss < 10 ) then
buffer := '0' + buffer;
s := Format('%s:%s',[s,buffer]);
if ( ssss > 0 ) then begin
buffer := IntToStr(ssss);
case ssss of
0..9 : buffer := '00' + buffer;
10..99 : buffer := '0' + buffer;
end;
s := Format('%s.%s',[s,buffer]);
end;
Result := s + 'Z';
DecodeDateTime(locDate,y,m,d,hh,mn,ss,ssss);
if ( ssss = 0 ) then
Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2dZ',[y,m,d, hh,mn,ss])
else
Result := Format('%.4d-%.2d-%.2dT%.2d:%.2d:%.2d.%.3dZ',[y,m,d, hh,mn,ss,ssss]);
end;
function xsd_DateTimeToStr(const ADate : TDateTime) : string;
@ -286,4 +324,203 @@ begin
Result := xsd_DateTimeToStr(tmpDate);
end;
function xsd_TimeToStr(const ATime : TTimeRec) : string;
var
buffer : string;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
if ( ( ATime.Hour < 0 ) or ( ATime.Hour > 23 ) ) or
( ( ATime.Minute < 0 ) or ( ATime.Minute > 59 ) ) or
( ( ATime.Second < 0 ) or ( ATime.Second > 59 ) ) or
( ATime.MilliSecond < 0 )
then begin
buffer := Format('{ Hour : %d; Minute : %d; Second : %d; SecondFractional : %d}',[ATime.Hour,ATime.Minute,ATime.Second,ATime.MilliSecond]);
raise EConvertError.CreateFmt(SERR_InvalidTime,[buffer]);
end;
if ( ATime.MilliSecond = 0 ) then
buffer := Format('%.2d:%.2d:%.2d',[ATime.Hour,ATime.Minute,ATime.Second])
else
buffer := Format('%.2d:%.2d:%.2d.%.3d',[ATime.Hour,ATime.Minute,ATime.Second,ATime.MilliSecond]);
if ( ATime.HourOffset <> 0 ) then begin
if ( ATime.HourOffset > 0 ) then
buffer := Format('%s+%.2d',[buffer,ATime.HourOffset])
else
buffer := Format('%s-%.2d',[buffer,-ATime.HourOffset]);
if ( ATime.MinuteOffset > 0 ) then
buffer := Format('%s:%.2d',[buffer,ATime.MinuteOffset])
else if ( ATime.MinuteOffset < 0 ) then
buffer := Format('%s:%.2d',[buffer,-ATime.MinuteOffset]);
end else if ( ATime.MinuteOffset <> 0 ) then begin
if ( ATime.MinuteOffset > 0 ) then
buffer := Format('%s+00:%.2d',[buffer,ATime.MinuteOffset])
else if ( ATime.MinuteOffset < 0 ) then
buffer := Format('%s-00:%.2d',[buffer,-ATime.MinuteOffset]);
end;
if ( ATime.HourOffset = 0 ) and ( ATime.MinuteOffset = 0 ) then
buffer := buffer + 'Z';
Result := buffer;
end;
function xsd_TryStrToTime(const AStr : string; out ADate : TTimeRec) : Boolean;
const
TIME_SEP_CHAR = ':';
var
buffer : string;
bufferPos, bufferLen : Integer;
function ReadInt(out AValue : Integer; const ASeparatorAtEnd : Char) : Boolean;
var
locStartPos : Integer;
begin
while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] < #33 ) do begin
Inc(bufferPos);
end;
locStartPos := bufferPos;
if ( bufferPos <= bufferLen ) and ( buffer[bufferPos] in ['-','+'] ) then
Inc(bufferPos);
while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] in ['0'..'9'] ) do begin
Inc(bufferPos);
end;
Result := ( bufferPos > locStartPos ) and
( ( ASeparatorAtEnd = #0 ) or
( ( bufferPos <= bufferLen ) and
( buffer[bufferPos] = ASeparatorAtEnd )
)
);
if Result then
Result := TryStrToInt(Copy(buffer,locStartPos,(bufferPos-locStartPos)),AValue);
end;
var
hh, mn, ss, ssss : Integer;
tz_hh, tz_mn : Integer;
tz_negative : Boolean;
ok : Boolean;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
buffer := Trim(AStr);
bufferPos := 1;
bufferLen := Length(buffer);
ok := False;
if ( bufferLen > 0 ) then begin
if ReadInt(hh,#0) then begin
Inc(bufferPos);
mn := 0;
ss := 0;
ssss := 0;
tz_hh := 0;
tz_mn := 0;
ok := True;
if ( bufferPos < bufferLen ) then begin
ok := ( buffer[bufferPos -1] = TIME_SEP_CHAR ) and ReadInt(mn,#0);
if ok then begin
Inc(bufferPos);
if ( bufferPos < bufferLen ) then begin
ok := ReadInt(ss,#0);
if ok then begin
if ( bufferPos < bufferLen ) then begin
if ( buffer[bufferPos] = '.' ) then begin
Inc(bufferPos);
ok := ReadInt(ssss,#0);
end else begin
ssss := 0;
end;
if ok and ( bufferPos < bufferLen ) then begin
ok := ( buffer[bufferPos] in ['+','-'] );
if ok then begin
tz_negative := ( buffer[bufferPos] = '-' );
Inc(bufferPos);
ok := ReadInt(tz_hh,#0);
if ok then begin
Inc(bufferPos);
if ( bufferPos < bufferLen ) then
ok := ReadInt(tz_mn,#0)
else
tz_mn := 0;
if ok and tz_negative then begin
tz_hh := -tz_hh;
tz_mn := -tz_mn;
end;
end;
end;
end;
end;
end;
end;
end;
end;
if ok then begin
ok := ( ( hh = 24 ) and ( mn = 0 ) and ( ss = 0 ) and ( ssss = 0 )
) or
( ( hh >= 0 ) and ( hh < 24 ) and
( mn >= 0 ) and ( mn < 60 ) and
( ss >= 0 ) and ( ss < 60 ) and
( ssss >= 0 ) and ( ssss < 1000 )
);
ok := ok and
( tz_hh > -60 ) and ( tz_hh < 60 ) and
( tz_mn > -60 ) and ( tz_mn < 60 );
end;
if ok then begin
ADate.Hour := hh;
ADate.Minute := mn;
ADate.Second := ss;
ADate.MilliSecond := ssss;
ADate.HourOffset := tz_hh;
ADate.MinuteOffset := tz_mn;
end;
end;
end;
Result := ok;
end;
function xsd_StrToTime(const AStr : string) : TTimeRec;
begin
if not xsd_TryStrToTime(AStr,Result) then
raise EConvertError.CreateFmt(SERR_InvalidTime,[AStr]);
end;
function xsd_EncodeTime(
const AHour,
AMin,
ASec : Byte;
const AMiliSec : Word
) : TTimeRec;
begin
Result := xsd_EncodeTime(AHour,AMin,ASec,AMiliSec,0,0);
end;
function xsd_EncodeTime(
const AHour,
AMin,
ASec : Byte;
const AMiliSec : Word;
const AHourOffset : Shortint;
const AMinuteOffset : Shortint
) : TTimeRec;
begin
Result.Hour := AHour;
Result.Minute := AMin;
Result.Second := ASec;
Result.MilliSecond := AMiliSec;
Result.HourOffset := AHourOffset;
Result.MinuteOffset := AMinuteOffset;
end;
function DateTimeToTimeRec(const ADateTime : TDateTime) : TTimeRec;
var
hh, mn, ss, ssss : Word;
begin
DecodeTime(ADateTime,hh,mn,ss,ssss);
Result.Hour := hh;
Result.Minute := mn;
Result.Second := ss;
Result.MilliSecond := ssss;
end;
function TimeRecToDateTime(const ATime : TTimeRec) : TDateTime;
begin
Result := EncodeTime(ATime.Hour,ATime.Minute,ATime.Second,ATime.MilliSecond);
end;
end.

View File

@ -24,7 +24,16 @@ uses
type
{ TTest_DateUtils }
TTest_DateUtils = class(TTestCase)
protected
{$IFDEF FPC}
class procedure CheckEquals(expected, actual: TTimeRec; msg: string = ''); overload;
{$ENDIF FPC}
{$IFDEF WST_DELPHI}
procedure CheckEquals(expected, actual: TTimeRec; msg: string = ''); overload;
{$ENDIF WST_DELPHI}
published
procedure xsd_TryStrToDate_date_only();
procedure xsd_TryStrToDate_date_time();
@ -41,6 +50,18 @@ type
procedure xsd_DateTimeToStr_fractional_second_1();
procedure xsd_DateTimeToStr_fractional_second_2();
procedure xsd_DateTimeToStr_timezone_1();
procedure xsd_TimeToStr_1();
procedure xsd_TimeToStr_zero();
procedure xsd_TimeToStr_fractional_second_1();
procedure xsd_TryStrToTime_hour_only();
procedure xsd_TryStrToTime_hour_minute_only();
procedure xsd_TryStrToTime_hour_minute_second_only();
procedure xsd_TryStrToTime_all_fields();
procedure xsd_TryStrToTime_time_timezone_1();
procedure xsd_TryStrToTime_time_timezone_2();
procedure xsd_TryStrToTime_time_timezone_3();
procedure xsd_TryStrToTime_time_timezone_4();
end;
implementation
@ -132,6 +153,241 @@ begin
CheckEquals('2002-10-10T07:00:00Z', xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_TimeToStr_1();
const
sVALUE_1 = '01:23:45Z';
sVALUE_2 = '12:34:56Z';
sVALUE_3 = '20:34:56Z';
var
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d.Hour := 1;
d.Minute := 23;
d.Second := 45;
d.MilliSecond := 0;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_1, xsd_TimeToStr(d));
d.Hour := 12;
d.Minute := 34;
d.Second := 56;
d.MilliSecond := 0;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_2, xsd_TimeToStr(d));
d.Hour := 20;
d.Minute := 34;
d.Second := 56;
d.MilliSecond := 0;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_3, xsd_TimeToStr(d));
end;
procedure TTest_DateUtils.xsd_TimeToStr_zero();
const
sVALUE_1 = '00:00:00Z';
var
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d.Hour := 0;
d.Minute := 0;
d.Second := 0;
d.MilliSecond := 0;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_1, xsd_TimeToStr(d));
end;
procedure TTest_DateUtils.xsd_TimeToStr_fractional_second_1();
const
sVALUE_1 = '23:34:56.007Z';
sVALUE_2 = '23:34:56.078Z';
sVALUE_3 = '23:34:56.789Z';
var
d : TTimeRec;
begin
d.Hour := 23;
d.Minute := 34;
d.Second := 56;
d.MilliSecond := 7;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_1, xsd_TimeToStr(d));
d.Hour := 23;
d.Minute := 34;
d.Second := 56;
d.MilliSecond := 78;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_2, xsd_TimeToStr(d));
d.Hour := 23;
d.Minute := 34;
d.Second := 56;
d.MilliSecond := 789;
d.HourOffset := 0;
d.MinuteOffset := 0;
CheckEquals(sVALUE_3, xsd_TimeToStr(d));
end;
procedure TTest_DateUtils.xsd_TryStrToTime_hour_only();
var
s : string;
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '01';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(1,0,0,0),d);
s := '05';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(5,0,0,0),d);
s := '12';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(12,0,0,0),d);
s := '13';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(13,0,0,0),d);
s := '20';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(20,0,0,0),d);
end;
procedure TTest_DateUtils.xsd_TryStrToTime_hour_minute_only();
var
s : string;
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '01:00';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(1,0,0,0),d);
s := '05:12';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(5,12,0,0),d);
s := '12:55';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(12,55,0,0),d);
s := '13:45';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(13,45,0,0),d);
s := '20:34';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(20,34,0,0),d);
end;
procedure TTest_DateUtils.xsd_TryStrToTime_hour_minute_second_only();
var
s : string;
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '01:00:00';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(1,0,0,0),d);
s := '05:12:34';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(5,12,34,0),d);
s := '12:55:56';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(12,55,56,0),d);
s := '13:45:41';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(13,45,41,0),d);
s := '20:34:12';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(20,34,12,0),d);
end;
procedure TTest_DateUtils.xsd_TryStrToTime_all_fields();
var
s : string;
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '01:00:00.00';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(1,0,0,0),d);
s := '05:12:34.001';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(5,12,34,1),d);
s := '12:55:56.012';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(12,55,56,12),d);
s := '13:45:41.123';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(13,45,41,123),d);
s := '20:34:12.998';
Check(xsd_TryStrToTime(s,d));
CheckEquals(xsd_EncodeTime(20,34,12,998),d);
end;
procedure TTest_DateUtils.xsd_TryStrToTime_time_timezone_1();
var
s : string;
d : TTimeRec;
begin
s := '23:34:56+12:34';
Check(xsd_TryStrToTime(s,d));
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,0,'MilliSecond');
CheckEquals(12,d.HourOffset,'HourOffset');
CheckEquals(34,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToTime_time_timezone_2();
var
s : string;
d : TTimeRec;
begin
s := '23:34:56-01:23';
Check(xsd_TryStrToTime(s,d));
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,0,'MilliSecond');
CheckEquals(-1,d.HourOffset,'HourOffset');
CheckEquals(-23,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToTime_time_timezone_3();
var
s : string;
d : TTimeRec;
begin
s := '23:34:56.78+12:34';
Check(xsd_TryStrToTime(s,d));
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,78,'MilliSecond');
CheckEquals(12,d.HourOffset,'HourOffset');
CheckEquals(34,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToTime_time_timezone_4();
var
s : string;
d : TTimeRec;
begin
s := '23:34:56.789-01:23';
Check(xsd_TryStrToTime(s,d));
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,789,'MilliSecond');
CheckEquals(-1,d.HourOffset,'HourOffset');
CheckEquals(-23,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_bad_separator();
const
DATE_STR = '1976;10;12';
@ -141,6 +397,30 @@ begin
CheckEquals(False,xsd_TryStrToDate(DATE_STR,d),Format('"%s" is not a valid date.',[DATE_STR]));
end;
{$IFDEF FPC}
class procedure TTest_DateUtils.CheckEquals(expected, actual: TTimeRec; msg: string);
begin
CheckEquals(expected.Hour,actual.Hour,msg + ', Hour');
CheckEquals(expected.Minute,actual.Minute,msg + ', Minute');
CheckEquals(expected.Second,actual.Second,msg + ', Second');
CheckEquals(expected.MilliSecond,actual.MilliSecond,msg + ', MilliSecond');
CheckEquals(expected.HourOffset,actual.HourOffset,msg + ', HourOffset');
CheckEquals(expected.MinuteOffset,actual.MinuteOffset,msg + ', MinuteOffset');
end;
{$ENDIF FPC}
{$IFDEF WST_DELPHI}
procedure TTest_DateUtils.CheckEquals(expected, actual: TTimeRec; msg: string);
begin
CheckEquals(expected.Hour,actual.Hour,msg + ', Hour');
CheckEquals(expected.Minute,actual.Minute,msg + ', Minute');
CheckEquals(expected.Second,actual.Second,msg + ', Second');
CheckEquals(expected.MilliSecond,actual.MilliSecond,msg + ', MilliSecond');
CheckEquals(expected.HourOffset,actual.HourOffset,msg + ', HourOffset');
CheckEquals(expected.MinuteOffset,actual.MinuteOffset,msg + ', MinuteOffset');
end;
{$ENDIF WST_DELPHI}
procedure TTest_DateUtils.xsd_TryStrToDate_date_only();
var
s : string;

View File

@ -22,7 +22,7 @@ uses
TestFrameWork,
{$ENDIF}
TypInfo,
wst_types, base_service_intf, imp_utils, test_suite_utils;
wst_types, base_service_intf, imp_utils, test_suite_utils, date_utils;
type
@ -338,9 +338,23 @@ type
{ TTest_TTimeRemotable }
TTest_TTimeRemotable = class(TTestCase)
protected
{$IFDEF FPC}
class procedure CheckEquals(expected, actual: TTimeRec; msg: string = ''); overload;
{$ENDIF FPC}
{$IFDEF WST_DELPHI}
procedure CheckEquals(expected, actual: TTimeRec; msg: string = ''); overload;
{$ENDIF WST_DELPHI}
published
procedure FormatDate();
procedure ParseDate();
procedure ToString();
procedure Parse();
procedure Parse_millisecond();
procedure Parse_offset_1();
procedure Parse_offset_2();
procedure Data;
procedure Equal();
procedure Assign();
procedure Clear();
end;
{ TTest_TStringBufferRemotable }
@ -453,7 +467,7 @@ type
end;
implementation
uses Math, basex_encode, DateUtils, date_utils;
uses Math, basex_encode, DateUtils;
function RandomValue(const AMaxlen: Integer): TBinaryString;
var
@ -2958,15 +2972,235 @@ begin
end;
{ TTest_TTimeRemotable }
procedure TTest_TTimeRemotable.FormatDate();
{$IFDEF WST_DELPHI}
procedure TTest_TTimeRemotable.CheckEquals(expected, actual: TTimeRec;msg: string);
begin
Fail('Write me!');
CheckEquals(expected.Hour,actual.Hour,msg + ', Hour');
CheckEquals(expected.Minute,actual.Minute,msg + ', Minute');
CheckEquals(expected.Second,actual.Second,msg + ', Second');
CheckEquals(expected.MilliSecond,actual.MilliSecond,msg + ', MilliSecond');
CheckEquals(expected.HourOffset,actual.HourOffset,msg + ', HourOffset');
CheckEquals(expected.MinuteOffset,actual.MinuteOffset,msg + ', MinuteOffset');
end;
{$ENDIF WST_DELPHI}
{$IFDEF FPC}
class procedure TTest_TTimeRemotable.CheckEquals(expected, actual: TTimeRec;msg: string);
begin
CheckEquals(expected.Hour,actual.Hour,msg + ', Hour');
CheckEquals(expected.Minute,actual.Minute,msg + ', Minute');
CheckEquals(expected.Second,actual.Second,msg + ', Second');
CheckEquals(expected.MilliSecond,actual.MilliSecond,msg + ', MilliSecond');
CheckEquals(expected.HourOffset,actual.HourOffset,msg + ', HourOffset');
CheckEquals(expected.MinuteOffset,actual.MinuteOffset,msg + ', MinuteOffset');
end;
{$ENDIF FPC}
procedure TTest_TTimeRemotable.ToString();
const
sVALUE_1 = '01:23:45.678';
sVALUE_2 = '12:34:56';
sVALUE_3 = '20:34:56';
var
d : TTimeRec;
begin
//hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
d := xsd_EncodeTime(01,23,45,678);
CheckEquals(sVALUE_1, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_1)));
d := xsd_EncodeTime(12,34,56,0);
CheckEquals(sVALUE_2, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_2)));
d := xsd_EncodeTime(20,34,56,0);
CheckEquals(sVALUE_3, Copy(TTimeRemotable.ToString(d),1,Length(sVALUE_3)));
end;
procedure TTest_TTimeRemotable.ParseDate();
procedure TTest_TTimeRemotable.Parse();
var
s : string;
objd : TTimeRemotable;
d : TTimeRec;
begin
Fail('Write me!');
s := '23:34:56';
d := TTimeRemotable.Parse(s);
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,0,'MilliSecond');
CheckEquals(d.HourOffset,0,'HourOffset');
CheckEquals(d.MinuteOffset,0,'MinuteOffset');
objd := TTimeRemotable.Create();
try
objd.Data := d;
CheckEquals(objd.Hour,23,'Hour');
CheckEquals(objd.Minute,34,'Minute');
CheckEquals(objd.Second,56,'Second');
CheckEquals(objd.MilliSecond,0,'MilliSecond');
CheckEquals(objd.HourOffset,0,'HourOffset');
CheckEquals(objd.MinuteOffset,0,'MinuteOffset');
finally
FreeAndNil(objd);
end;
end;
procedure TTest_TTimeRemotable.Parse_millisecond();
var
s : string;
objd : TTimeRemotable;
d : TTimeRec;
begin
s := '23:34:56.780';
d := TTimeRemotable.Parse(s);
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,780,'MilliSecond');
CheckEquals(d.HourOffset,0,'HourOffset');
CheckEquals(d.MinuteOffset,0,'MinuteOffset');
objd := TTimeRemotable.Create();
try
objd.Data := d;
CheckEquals(objd.Hour,23,'Hour');
CheckEquals(objd.Minute,34,'Minute');
CheckEquals(objd.Second,56,'Second');
CheckEquals(objd.MilliSecond,780,'MilliSecond');
CheckEquals(objd.HourOffset,0,'HourOffset');
CheckEquals(objd.MinuteOffset,0,'MinuteOffset');
finally
FreeAndNil(objd);
end;
end;
procedure TTest_TTimeRemotable.Parse_offset_1();
var
s : string;
objd : TTimeRemotable;
d : TTimeRec;
begin
s := '23:34:56+01:27';
d := TTimeRemotable.Parse(s);
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,0,'MilliSecond');
CheckEquals(d.HourOffset,1,'HourOffset');
CheckEquals(d.MinuteOffset,27,'MinuteOffset');
objd := TTimeRemotable.Create();
try
objd.Data := d;
CheckEquals(objd.Hour,23,'Hour');
CheckEquals(objd.Minute,34,'Minute');
CheckEquals(objd.Second,56,'Second');
CheckEquals(objd.MilliSecond,0,'MilliSecond');
CheckEquals(objd.HourOffset,1,'HourOffset');
CheckEquals(objd.MinuteOffset,27,'MinuteOffset');
finally
FreeAndNil(objd);
end;
end;
procedure TTest_TTimeRemotable.Parse_offset_2();
var
s : string;
objd : TTimeRemotable;
d : TTimeRec;
begin
s := '23:34:56.800-01:27';
d := TTimeRemotable.Parse(s);
CheckEquals(d.Hour,23,'Hour');
CheckEquals(d.Minute,34,'Minute');
CheckEquals(d.Second,56,'Second');
CheckEquals(d.MilliSecond,800,'MilliSecond');
CheckEquals(d.HourOffset,-1,'HourOffset');
CheckEquals(d.MinuteOffset,-27,'MinuteOffset');
objd := TTimeRemotable.Create();
try
objd.Data := d;
CheckEquals(objd.Hour,23,'Hour');
CheckEquals(objd.Minute,34,'Minute');
CheckEquals(objd.Second,56,'Second');
CheckEquals(objd.MilliSecond,800,'MilliSecond');
CheckEquals(objd.HourOffset,-1,'HourOffset');
CheckEquals(objd.MinuteOffset,-27,'MinuteOffset');
finally
FreeAndNil(objd);
end;
end;
procedure TTest_TTimeRemotable.Data;
var
objd : TTimeRemotable;
d : TTimeRec;
begin
d := xsd_EncodeTime(1,2,3,4,5,6);
objd := TTimeRemotable.Create();
try
objd.Data := d;
CheckEquals(objd.Data,d);
finally
FreeAndNil(objd);
end;
end;
procedure TTest_TTimeRemotable.Equal();
var
a, b : TTimeRemotable;
begin
b := nil;
a := TTimeRemotable.Create();
try
b := TTimeRemotable.Create();
Check(a.Equal(b));
a.Data := xsd_EncodeTime(1,2,3,4,5,6);
Check(not a.Equal(b));
b.Data := xsd_EncodeTime(1,2,3,4,5,6);
Check(a.Equal(b));
finally
b.Free();
a.Free();
end;
end;
procedure TTest_TTimeRemotable.Assign();
var
a, b : TTimeRemotable;
begin
b := nil;
a := TTimeRemotable.Create();
try
b := TTimeRemotable.Create();
b.Assign(a);
CheckEquals(a.Data,b.Data);
a.Data := xsd_EncodeTime(1,2,3,4,5,6);
b.Assign(a);
CheckEquals(a.Data,b.Data);
finally
b.Free();
a.Free();
end;
end;
procedure TTest_TTimeRemotable.Clear();
var
a : TTimeRemotable;
begin
a := TTimeRemotable.Create();
try
a.Clear();
CheckEquals(a.Data,ZERO_TIME);
a.Data := xsd_EncodeTime(1,2,3,4,5,6);
a.Clear();
CheckEquals(a.Data,ZERO_TIME);
finally
a.Free();
end;
end;
{ TTest_TStringBufferRemotable }

View File

@ -45,6 +45,7 @@ type
FVal_Date: TDateRemotable;
FVal_Enum: TTestEnum;
FVal_String: string;
FVal_Time : TTimeRemotable;
{$IFDEF WST_UNICODESTRING}
FVal_UnicodeString: UnicodeString;
{$ENDIF WST_UNICODESTRING}
@ -62,6 +63,7 @@ type
property Val_UnicodeString : UnicodeString Read FVal_UnicodeString Write FVal_UnicodeString;
{$ENDIF WST_UNICODESTRING}
property Val_Date : TDateRemotable read FVal_Date write FVal_Date;
property Val_Time : TTimeRemotable read FVal_Time write FVal_Time;
End;
TClass_A_Array = class(TBaseObjectArrayRemotable)
@ -2943,6 +2945,7 @@ end;
procedure TTestFormatter.Test_Object();
const
DATE_VALUE = 39000;
TIME_VALUE = '01:23:45.789Z';
Var
f : IFormatterBase;
s : TMemoryStream;
@ -2962,6 +2965,7 @@ begin
a.ObjProp.Val_String := '456';
a.ObjProp.Val_WideString := 'wide456';
a.ObjProp.Val_Date.AsDate := DATE_VALUE;
a.ObjProp.Val_Time.AsString := TIME_VALUE;
{$IFDEF WST_UNICODESTRING}
a.ObjProp.Val_UnicodeString := 'unicode456';
{$ENDIF WST_UNICODESTRING}
@ -3003,6 +3007,7 @@ begin
CheckEquals('456',a.ObjProp.Val_String);
CheckEquals(WideString('wide456'),a.ObjProp.Val_WideString);
CheckEquals(TDateRemotable.FormatDate(DATE_VALUE),TDateRemotable.FormatDate(a.ObjProp.Val_Date.AsDate));
CheckEquals(TIME_VALUE,a.ObjProp.Val_Time.AsString);
{$IFDEF WST_UNICODESTRING}
CheckEquals('unicode456',a.ObjProp.Val_UnicodeString);
{$ENDIF WST_UNICODESTRING}
@ -4652,7 +4657,7 @@ begin
Check( ls.IndexOf('intv') >= 0 );
x := 'a';
f.BeginObjectRead(x,TypeInfo(TClass_A));
CheckEquals(6{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(a)');
CheckEquals(7{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(a)');
Check( ls.IndexOf('Val_Bool') >= 0 );
Check( ls.IndexOf('Val_Enum') >= 0 );
Check( ls.IndexOf('Val_String') >= 0 );
@ -4661,7 +4666,7 @@ begin
x := 'b';
f.BeginObjectRead(x,TypeInfo(TClass_A));
CheckEquals(6{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(b)');
CheckEquals(7{$IFDEF WST_UNICODESTRING}+1{$ENDIF}, f.GetScopeItemNames(ls), 'GetScopeItemNames.Count(b)');
Check( ls.IndexOf('Val_Bool') >= 0 );
Check( ls.IndexOf('Val_Enum') >= 0 );
Check( ls.IndexOf('Val_String') >= 0 );
@ -4750,6 +4755,7 @@ end;
procedure TTestSOAPFormatter.do_test_Object(const AProps, AFilename: string);
const
DATE_VALUE = 39000;
TIME_VALUE = '01:23:45.789Z';
Var
f : IFormatterBase;
s : TMemoryStream;
@ -4769,6 +4775,7 @@ begin
a.ObjProp.Val_String := '456';
a.ObjProp.Val_WideString := 'wide456';
a.ObjProp.Val_Date.AsDate := DATE_VALUE;
a.ObjProp.Val_Time.AsString := TIME_VALUE;
{$IFDEF WST_UNICODESTRING}
a.ObjProp.Val_UnicodeString := 'unicode456';
{$ENDIF WST_UNICODESTRING}
@ -6291,10 +6298,12 @@ constructor TClass_A.Create();
begin
inherited Create();
FVal_Date := TDateRemotable.Create();
FVal_Time := TTimeRemotable.Create();
end;
destructor TClass_A.Destroy();
begin
FreeAndNil(FVal_Time);
FreeAndNil(FVal_Date);
inherited Destroy();
end;

View File

@ -3,8 +3,8 @@
{$UNDEF WST_TKPROCVAR}
{$UNDEF WST_UNICODESTRING}
{$UNDEF WST_SEMAPHORE_TIMEOUT}
{$UNDEF WST_HAS_TDURATIONREMOTABLE}
{$UNDEF WST_HAS_TTIMEREMOTABLE}
{$DEFINE WST_HAS_TDURATIONREMOTABLE}
{$DEFINE WST_HAS_TTIMEREMOTABLE}
{$WARNINGS OFF}