pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@609 8e941d3f-bd1b-0410-a28a-d453659cc2b4

Browse Source
This commit is contained in:
inoussa
2008-11-24 15:39:35 +00:00
parent 69a8145509
commit a43bb35944
7 changed files with 762 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

185
wst/trunk/base_service_intf.pas
View File

@ -22,7 +22,7 @@ uses
{$IFDEF WST_DELPHI} {$IFDEF WST_DELPHI}
,Windows ,Windows
{$ENDIF} {$ENDIF}
; , date_utils;
const const
stBase = 0; stBase = 0;
@ -323,12 +323,14 @@ type
TBaseDateRemotable = class(TAbstractSimpleRemotable) TBaseDateRemotable = class(TAbstractSimpleRemotable)
private private
FDate : TDateTime; FDate : TDateTimeRec;
FYear : Integer; private
FMonth : Integer; function GetOffset(const Index: Integer): Shortint;
FDay : Integer; procedure SetOffset(const Index: Integer; const Value: Shortint);
function GetDate(const AIndex : Integer) : TDateTime;
protected protected
procedure SetDate(const AValue: TDateTime);virtual; function GetDatepart(const AIndex : Integer) : Integer;virtual;
procedure SetDate(const AIndex : Integer; const AValue: TDateTime);virtual;
public public
class procedure Save( class procedure Save(
AObject : TBaseRemotable; AObject : TBaseRemotable;
@ -342,33 +344,33 @@ type
var AName : string; var AName : string;
const ATypeInfo : PTypeInfo const ATypeInfo : PTypeInfo
);override; );override;
class function FormatDate(const ADate : TDateTime):string;virtual;abstract; class function FormatDate(const ADate : TDateTime):string;overload;
class function FormatDate(const ADate : TDateTimeRec):string;overload;virtual;abstract;
class function ParseDate(const ABuffer : string):TDateTime;virtual;abstract; class function ParseDate(const ABuffer : string):TDateTime;virtual;abstract;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
function Equal(const ACompareTo : TBaseRemotable) : Boolean;override; function Equal(const ACompareTo : TBaseRemotable) : Boolean;override;
property AsDate : TDateTime read FDate write SetDate; property AsDate : TDateTime index 0 read GetDate write SetDate;
property Year : Integer read FYear; property AsUTCDate : TDateTime index 1 read GetDate write SetDate;
property Month : Integer read FMonth; property Year : Integer index 0 read GetDatepart;
property Day : Integer read FDay; property Month : Integer index 1 read GetDatepart;
property Day : Integer index 2 read GetDatepart;
property HourOffset : Shortint index 0 read GetOffset write SetOffset;
property MinuteOffset : Shortint index 1 read GetOffset write SetOffset;
end; end;
{ TDateRemotable } { TDateRemotable }
TDateRemotable = class(TBaseDateRemotable) TDateRemotable = class(TBaseDateRemotable)
private
FHour: Integer;
FMinute: Integer;
FSecond: Integer;
protected protected
procedure SetDate(const AValue: TDateTime);override; function GetDatepart(const AIndex : Integer) : Integer;override;
public public
class function FormatDate(const ADate : TDateTime):string;override; class function FormatDate(const ADate : TDateTimeRec):string;override;
class function ParseDate(const ABuffer : string):TDateTime;override; class function ParseDate(const ABuffer : string):TDateTime;override;
property Hour : Integer read FHour; property Hour : Integer index 3 read GetDatepart;
property Minute : Integer read FMinute; property Minute : Integer index 4 read GetDatepart;
property Second : Integer read FSecond; property Second : Integer index 5 read GetDatepart;
end; end;
{ TDurationRemotable } { TDurationRemotable }
@ -1501,9 +1503,13 @@ var
wst_FormatSettings : TFormatSettings; wst_FormatSettings : TFormatSettings;
{$ENDIF HAS_FORMAT_SETTINGS} {$ENDIF HAS_FORMAT_SETTINGS}
resourcestring
SERR_InvalidHourOffetValue = '"%d" is not a valid hour offset value.';
SERR_InvalidMinuteOffetValue = '"%d" is not a valid minute offset value.';
implementation implementation
uses uses
imp_utils, record_rtti, basex_encode, object_serializer; imp_utils, record_rtti, basex_encode, object_serializer, DateUtils;
type type
@ -3006,7 +3012,7 @@ begin
i := IndexOf(ADataType); i := IndexOf(ADataType);
if ( i = -1 ) then begin if ( i = -1 ) then begin
Result := GetItemClassFor(ADataType).Create(Self,ANameSpace,ADataType,ADeclaredName); Result := GetItemClassFor(ADataType).Create(Self,ANameSpace,ADataType,ADeclaredName);
i := Add(Result); Add(Result);
{$IFDEF TRemotableTypeInitializer_Initialize} {$IFDEF TRemotableTypeInitializer_Initialize}
InitializeItem(Result); InitializeItem(Result);
{$ENDIF TRemotableTypeInitializer_Initialize} {$ENDIF TRemotableTypeInitializer_Initialize}
@ -5210,56 +5216,9 @@ end;
{ TDateRemotable } { TDateRemotable }
procedure TDateRemotable.SetDate(const AValue: TDateTime); class function TDateRemotable.FormatDate(const ADate: TDateTimeRec): string;
var
hh, mn, ss, ssss : Word;
begin begin
inherited SetDate(AValue); Result := xsd_DateTimeToStr(ADate);
DecodeTime(AsDate,hh,mn,ss,ssss);
FHour := hh;
FMinute := mn;
FSecond := ss;
end;
class function TDateRemotable.FormatDate(const ADate: TDateTime): string;
var
s, buffer : string;
d, m, y : Word;
hh, mn, ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
DecodeDate(ADate,y,m,d);
s := IntToStr(y);
buffer := IntToStr(m);
if ( Length(s) < 4 ) then
s := StringOfChar('0', ( 4 - Length(s) ) ) + s;
if ( m < 10 ) then
buffer := '0' + buffer;
s := Format('%s-%s',[s,buffer]);
buffer := IntToStr(d);
if ( d < 10 ) then
buffer := '0' + buffer;
s := Format('%s-%s',[s,buffer]);
DecodeTime(ADate,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]);
Result := s;
end; end;
class function TDateRemotable.ParseDate(const ABuffer: string): TDateTime; class function TDateRemotable.ParseDate(const ABuffer: string): TDateTime;
@ -5333,17 +5292,28 @@ begin
end; end;
end; end;
function TDateRemotable.GetDatepart(const AIndex: Integer): Integer;
begin
case AIndex of
3 : Result := HourOf(AsDate);
4 : Result := MinuteOf(AsDate);
5 : Result := SecondOf(AsDate);
else
Result := inherited GetDatepart(AIndex);
end;
end;
{ TBaseDateRemotable } { TBaseDateRemotable }
procedure TBaseDateRemotable.SetDate(const AValue: TDateTime); procedure TBaseDateRemotable.SetDate(const AIndex : Integer; const AValue: TDateTime);
var
y, m, d : Word;
begin begin
DecodeDate(AValue,y,m,d); FDate.Date := AValue;
FDate := AValue; if ( AIndex = 1 ) then begin
FYear := y; if ( FDate.HourOffset <> 0 ) then
FMonth := m; FDate.Date := date_utils.IncHour(FDate.Date,FDate.HourOffset);
FDay := d; if ( FDate.MinuteOffset <> 0 ) then
FDate.Date := IncMinute(FDate.Date,FDate.MinuteOffset);
end;
end; end;
class procedure TBaseDateRemotable.Save( class procedure TBaseDateRemotable.Save(
@ -5387,7 +5357,7 @@ end;
procedure TBaseDateRemotable.Assign(Source: TPersistent); procedure TBaseDateRemotable.Assign(Source: TPersistent);
begin begin
if Source.InheritsFrom(TDateRemotable) then begin if Source.InheritsFrom(TDateRemotable) then begin
FDate := TDateRemotable(Source).AsDate; FDate := TDateRemotable(Source).FDate;
end else begin end else begin
inherited Assign(Source); inherited Assign(Source);
end; end;
@ -5402,6 +5372,61 @@ begin
); );
end; end;
function TBaseDateRemotable.GetDate(const AIndex : Integer) : TDateTime;
begin
Result := FDate.Date;
if ( AIndex = 1 ) then begin
if ( FDate.HourOffset <> 0 ) then
Result := date_utils.IncHour(Result,-FDate.HourOffset);
if ( FDate.MinuteOffset <> 0 ) then
Result := date_utils.IncMinute(Result,-FDate.MinuteOffset);
end;
end;
function TBaseDateRemotable.GetDatepart(const AIndex: Integer): Integer;
begin
case AIndex of
0 : Result := YearOf(AsDate);
1 : Result := MonthOf(AsDate);
2 : Result := DayOf(AsDate);
else
Result := 0;
end;
end;
function TBaseDateRemotable.GetOffset(const Index: Integer): Shortint;
begin
if ( Index = 0 ) then
Result := FDate.HourOffset
else
Result := FDate.MinuteOffset;
end;
procedure TBaseDateRemotable.SetOffset(const Index: Integer; const Value: Shortint);
begin
if ( Index = 0 ) then begin
if ( Value >= -14 ) and ( Value <= 14 ) then
FDate.HourOffset := Value
else
raise Exception.CreateFmt(SERR_InvalidHourOffetValue,[Value]);
end else begin
if ( Value >= -59 ) and ( Value <= 59 ) then
FDate.MinuteOffset := Value
else
raise Exception.CreateFmt(SERR_InvalidMinuteOffetValue,[Value]);
end;
end;
class function TBaseDateRemotable.FormatDate(const ADate: TDateTime): string;
var
locTemp : TDateTimeRec;
begin
locTemp.Date := ADate;
locTemp.HourOffset := 0;
locTemp.MinuteOffset := 0;
Result := FormatDate(locTemp);
end;
{ TComplexInt8SContentRemotable } { TComplexInt8SContentRemotable }
class procedure TComplexInt8SContentRemotable.SaveValue( class procedure TComplexInt8SContentRemotable.SaveValue(

215
wst/trunk/date_utils.pas Normal file
View File

@ -0,0 +1,215 @@
{ This file is part of the Web Service Toolkit
Copyright (c) 2008 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit date_utils;
interface
uses
SysUtils;
type
TDateTimeRec = packed record
Date : TDateTime;
HourOffset : Shortint;
MinuteOffset : Shortint;
end;
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
function xsd_StrToDate(const AStr : string) : TDateTimeRec;
function xsd_DateTimeToStr(const ADate : TDateTimeRec) : string;overload;
function xsd_DateTimeToStr(const ADate : TDateTime) : string;overload;
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}
resourcestring
SERR_InvalidDate = '"%s" is not a valid date.';
implementation
uses Math, DateUtils;
function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
begin
Result := DateOf(AValue) + DateUtils.IncHour(TimeOf(AValue),ANumberOfHours);
end;
function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
begin
Result := DateOf(AValue) + DateUtils.IncMinute(TimeOf(AValue),ANumberOfMinutes);
end;
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
const
DATE_SEP_CHAR = '-'; TIME_MARKER_CHAR = 'T'; 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
d, m, y : Integer;
hh, mn, ss : Integer;
tz_hh, tz_mn : Integer;
tz_negative : Boolean;
ok : Boolean;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
buffer := Trim(AStr);
bufferPos := 1;
bufferLen := Length(buffer);
if ( bufferLen > 0 ) then begin
Result := False;
FillChar(ADate,SizeOf(ADate),#0);
if ReadInt(y,DATE_SEP_CHAR) then begin
Inc(bufferPos);
if ReadInt(m,DATE_SEP_CHAR) then begin
Inc(bufferPos);
if ReadInt(d,#0) then begin
Inc(bufferPos);
tz_hh := 0;
tz_mn := 0;
if ( bufferPos > bufferLen ) then begin
hh := 0;
mn := 0;
ss := 0;
ok := True;
end else begin
ok := ( buffer[bufferPos -1] = TIME_MARKER_CHAR ) and ReadInt(hh,TIME_SEP_CHAR);
if ok then begin
Inc(bufferPos);
ok := ReadInt(mn,TIME_SEP_CHAR);
if ok then begin
Inc(bufferPos);
ok := ReadInt(ss,#0);
if ok and ( bufferPos < bufferLen ) then begin
tz_negative := ( buffer[bufferPos] = '-' );
Inc(bufferPos);
ok := ReadInt(tz_hh,TIME_SEP_CHAR);
if ok then begin
Inc(bufferPos);
ok := ReadInt(tz_mn,#0);
if ok and tz_negative then begin
tz_hh := -tz_hh;
tz_mn := -tz_mn;
end;
end;
end;
end;
end;
end;
if ok then begin
if ( ( y + m + d + hh + mn + ss ) = 0 ) then
ADate.Date := 0
else
ADate.Date := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0);
ADate.HourOffset := tz_hh;
ADate.MinuteOffset := tz_mn;
Result := True;
end;
end;
end;
end;
end else begin
FillChar(ADate,SizeOf(ADate),#0);
Result := True;
end;
end;
function xsd_StrToDate(const AStr : string) : TDateTimeRec;
begin
if not xsd_TryStrToDate(AStr,Result) then
raise EConvertError.CreateFmt(SERR_InvalidDate,[AStr]);
end;
function xsd_DateTimeToStr(const ADate : TDateTimeRec) : string;
var
locDate : TDateTime;
s, buffer : string;
d, m, y : Word;
hh, mn, ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
locDate := ADate.Date;
if ( ADate.HourOffset <> 0 ) then
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]);
Result := s + 'Z';
end;
function xsd_DateTimeToStr(const ADate : TDateTime) : string;
var
tmpDate : TDateTimeRec;
begin
FillChar(tmpDate,SizeOf(TDateTimeRec),#0);
tmpDate.Date := ADate;
Result := xsd_DateTimeToStr(tmpDate);
end;
end.

256
wst/trunk/tests/test_suite/test_date_utils.pas Normal file
View File

@ -0,0 +1,256 @@
{ This file is part of the Web Service Toolkit
Copyright (c) 2008 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit test_date_utils;
interface
uses
SysUtils,
{$IFDEF FPC}
fpcunit, testregistry,
{$ELSE}
TestFrameWork,
{$ENDIF}
date_utils;
type
TTest_DateUtils = class(TTestCase)
published
procedure xsd_TryStrToDate_date_only();
procedure xsd_TryStrToDate_date_time();
procedure xsd_TryStrToDate_date_bad_separator();
procedure xsd_TryStrToDate_date_time_bad_separator();
procedure xsd_TryStrToDate_date_time_timezone_z();
procedure xsd_TryStrToDate_date_time_timezone_zero();
procedure xsd_TryStrToDate_date_time_timezone_1();
procedure xsd_TryStrToDate_date_time_timezone_2();
procedure xsd_DateTimeToStr_1();
procedure xsd_DateTimeToStr_2();
procedure xsd_DateTimeToStr_timezone_1();
end;
implementation
{ TTest_DateUtils }
procedure TTest_DateUtils.xsd_DateTimeToStr_1();
const
sDATE_1 = '1976-10-12T23:34:56Z';
sDATE_2 = '0987-06-12T20:34:56Z';
var
d : TDateTimeRec;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,0);
CheckEquals(sDATE_1, xsd_DateTimeToStr(d));
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(987,06,12) - EncodeTime(20,34,56,0);
CheckEquals(sDATE_2, xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_DateTimeToStr_2();
const
sDATE_1 = '1976-10-12T23:34:56Z';
sDATE_2 = '0987-06-12T20:34:56Z';
var
d : TDateTime;
begin
d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,0);
CheckEquals(sDATE_1, xsd_DateTimeToStr(d));
d := EncodeDate(987,06,12) - EncodeTime(20,34,56,0);
CheckEquals(sDATE_2, xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_DateTimeToStr_timezone_1();
//2002-10-10T12:00:00+05:00 is 2002-10-10T07:00:00Z
var
d : TDateTimeRec;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(2002,10,10) + EncodeTime(12,0,0,0);
d.HourOffset := 5;
CheckEquals('2002-10-10T07:00:00Z', xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_bad_separator();
const
DATE_STR = '1976;10;12';
var
d : TDateTimeRec;
begin
CheckEquals(False,xsd_TryStrToDate(DATE_STR,d),Format('"%s" is not a valid date.',[DATE_STR]));
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_only();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,0,'Hour');
CheckEquals(mn,0,'Minute');
CheckEquals(ss,0,'Second');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_bad_separator();
const
DATE_STR = '1976-10-12T23/34:56';
var
d : TDateTimeRec;
begin
CheckEquals(False,xsd_TryStrToDate(DATE_STR,d),Format('"%s" is not a valid date.',[DATE_STR]));
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_1();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56+12:34';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(12,d.HourOffset,'HourOffset');
CheckEquals(34,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_2();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56-01:23';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(-1,d.HourOffset,'HourOffset');
CheckEquals(-23,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_z();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56Z';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_zero();
var
s : string;
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
s := '1976-10-12T23:34:56+00:00';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
s := '1976-10-12T23:34:56-00:00';
d := xsd_StrToDate(s);
DecodeDate(d.Date,y,m,dy);
CheckEquals(y,1976,'Year');
CheckEquals(m,10,'Month');
CheckEquals(dy,12,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(hh,23,'Hour');
CheckEquals(mn,34,'Minute');
CheckEquals(ss,56,'Second');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
end;
initialization
RegisterTest('Support',TTest_DateUtils.Suite);
end.

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

@ -20,7 +20,7 @@ uses
{$ELSE} {$ELSE}
,TestFrameWork, xmldom, wst_delphi_xml ,TestFrameWork, xmldom, wst_delphi_xml
{$ENDIF} {$ENDIF}
,wst_types; ,wst_types, dateutils;
const const
TestFilesPath = {$IFDEF WST_DELPHI}'.' +{$ENDIF WST_DELPHI}'.' + PathDelim + 'files' + PathDelim; TestFilesPath = {$IFDEF WST_DELPHI}'.' +{$ENDIF WST_DELPHI}'.' + PathDelim + 'files' + PathDelim;

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

@ -305,6 +305,13 @@ type
procedure ParseDate(); procedure ParseDate();
procedure Assign(); procedure Assign();
procedure Equal(); procedure Equal();
procedure AsDate();
procedure AsUTCDate();
procedure HourOffset();
procedure HourOffset_invalid_values();
procedure MinuteOffset();
procedure MinuteOffset_invalid_values();
procedure Year();
end; end;
{ TTest_TDurationRemotable } { TTest_TDurationRemotable }
@ -406,7 +413,7 @@ type
end; end;
implementation implementation
uses Math, basex_encode; uses Math, basex_encode, DateUtils, date_utils;
function RandomValue(const AMaxlen: Integer): ansistring; function RandomValue(const AMaxlen: Integer): ansistring;
var var
@ -2284,6 +2291,173 @@ begin
CheckEquals(sDATE, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE))); CheckEquals(sDATE, Copy(TDateRemotable.FormatDate(d),1,Length(sDATE)));
end; end;
procedure TTest_TDateRemotable.AsDate();
var
d : TDateTime;
locObj : TDateRemotable;
begin
d := EncodeDateTime(1976,10,12,13,14,15,0);
locObj := TDateRemotable.Create();
try
locObj.AsDate := d;
CheckEquals(d, locObj.AsDate);
locObj.HourOffset := 4;
locObj.MinuteOffset := 5;
CheckEquals(d, locObj.AsDate);
// test while (Hour|Minute)Offset is not null
locObj.HourOffset := 4;
locObj.MinuteOffset := 5;
locObj.AsDate := d;
CheckEquals(d, locObj.AsDate);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.AsUTCDate();
var
d, dd : TDateTime;
locObj : TDateRemotable;
begin
d := EncodeDateTime(1976,10,12,13,14,15,0);
locObj := TDateRemotable.Create();
try
locObj.AsUTCDate := d;
CheckEquals(d, locObj.AsUTCDate);
locObj.HourOffset := 4;
locObj.MinuteOffset := 5;
dd := date_utils.IncHour(d,-locObj.HourOffset);
dd := date_utils.IncMinute(dd,-locObj.MinuteOffset);
CheckEquals(dd, locObj.AsUTCDate);
// test while (Hour|Minute)Offset is not null
locObj.AsUTCDate := dd;
CheckEquals(dd, locObj.AsUTCDate);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.HourOffset();
var
locObj : TDateRemotable;
begin
locObj := TDateRemotable.Create();
try
locObj.HourOffset := -5;
CheckEquals(-5, locObj.HourOffset);
locObj.HourOffset := 0;
CheckEquals(0, locObj.HourOffset);
locObj.HourOffset := 1;
CheckEquals(1, locObj.HourOffset);
locObj.HourOffset := 2;
CheckEquals(2, locObj.HourOffset);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.MinuteOffset();
var
locObj : TDateRemotable;
begin
locObj := TDateRemotable.Create();
try
locObj.MinuteOffset := -54;
CheckEquals(-54, locObj.MinuteOffset);
locObj.MinuteOffset := 0;
CheckEquals(0, locObj.MinuteOffset);
locObj.MinuteOffset := 20;
CheckEquals(20, locObj.MinuteOffset);
locObj.MinuteOffset := 56;
CheckEquals(56, locObj.MinuteOffset);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.HourOffset_invalid_values();
var
locObj : TDateRemotable;
procedure check_invalid_value(const AValue : ShortInt);
var
ok : Boolean;
begin
try
locObj.HourOffset := AValue;
ok := False;
except
ok := True;
end;
Check(ok, Format('"%d" is not a valid hour offset',[AValue]));
end;
begin
locObj := TDateRemotable.Create();
try
check_invalid_value(-50);
check_invalid_value(-24);
check_invalid_value(-15);
check_invalid_value(15);
check_invalid_value(24);
check_invalid_value(50);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.MinuteOffset_invalid_values();
var
locObj : TDateRemotable;
procedure check_invalid_value(const AValue : ShortInt);
var
ok : Boolean;
begin
try
locObj.MinuteOffset := AValue;
ok := False;
except
ok := True;
end;
Check(ok, Format('"%d" is not a valid minute offset',[AValue]));
end;
begin
locObj := TDateRemotable.Create();
try
check_invalid_value(-60);
check_invalid_value(-74);
check_invalid_value(-85);
check_invalid_value(65);
check_invalid_value(74);
check_invalid_value(80);
finally
locObj.Free();
end;
end;
procedure TTest_TDateRemotable.Year();
var
locObj : TDateRemotable;
begin
locObj := TDateRemotable.Create();
try
locObj.AsDate := EncodeDate(1976,10,12);
CheckEquals(1976, locObj.Year);
locObj.AsDate := EncodeDate(2000,10,12);
CheckEquals(2000, locObj.Year);
locObj.AsDate := EncodeDate(2,10,12);
CheckEquals(2, locObj.Year);
{locObj.AsDate := EncodeDate(-1976,10,12);
CheckEquals(-1976, locObj.Year);}
finally
locObj.Free();
end;
end;
{ TTest_TDurationRemotable } { TTest_TDurationRemotable }
procedure TTest_TDurationRemotable.Clear(); procedure TTest_TDurationRemotable.Clear();
@ -3361,11 +3535,11 @@ begin
end; end;
Check(ok); Check(ok);
aa := ls.Add(); ls.Add();
ls.Delete(0); ls.Delete(0);
CheckEquals(0,ls.Length); CheckEquals(0,ls.Length);
aa := ls.Add(); ls.Add();
ab := ls.Add(); ab := ls.Add();
ls.Delete(0); ls.Delete(0);
CheckEquals(1,ls.Length); CheckEquals(1,ls.Length);
@ -3374,7 +3548,7 @@ begin
FreeAndNil(ls); FreeAndNil(ls);
ls := TClass_A_CollectionRemotable.Create(); ls := TClass_A_CollectionRemotable.Create();
aa := ls.Add(); aa := ls.Add();
ab := ls.Add(); ls.Add();
ls.Delete(1); ls.Delete(1);
CheckEquals(1,ls.Length); CheckEquals(1,ls.Length);
CheckSame(aa,ls[0]); CheckSame(aa,ls[0]);

7
wst/trunk/tests/test_suite/wst_test_suite_gui.lpi
View File

@ -35,7 +35,7 @@
<PackageName Value="fpcunittestrunner"/> <PackageName Value="fpcunittestrunner"/>
</Item3> </Item3>
</RequiredPackages> </RequiredPackages>
<Units Count="18"> <Units Count="19">
<Unit0> <Unit0>
<Filename Value="wst_test_suite_gui.lpr"/> <Filename Value="wst_test_suite_gui.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -126,6 +126,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="test_generators_runtime"/> <UnitName Value="test_generators_runtime"/>
</Unit17> </Unit17>
<Unit18>
<Filename Value="test_date_utils.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="test_date_utils"/>
</Unit18>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

2
wst/trunk/tests/test_suite/wst_test_suite_gui.lpr
View File

@ -18,7 +18,7 @@ uses
test_basex_encode, json_formatter, server_service_json, test_json, test_basex_encode, json_formatter, server_service_json, test_json,
test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors, test_suite_utils, test_generators, fpcunittestrunner, test_std_cursors,
test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors, test_registry, test_soap_specific, test_rtti_filter, rtti_filters, wst_cursors, test_wst_cursors, test_registry, test_soap_specific,
test_generators_runtime; test_generators_runtime, test_date_utils;
begin begin
Application.Initialize; Application.Initialize;