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

Date "utils" routine with tests

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@666 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa 2009-01-19 17:51:35 +00:00
parent cff1351132
commit 2b47043b52
2 changed files with 157 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
wst/trunk/date_utils.pas
View File

@ -24,6 +24,9 @@ type
MinuteOffset : Shortint;
end;
const
ZERO_DATE : TDateTimeRec = ( Date : 0; HourOffset : 0; MinuteOffset : 0; );
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
function xsd_StrToDate(const AStr : string) : TDateTimeRec;
@ -33,6 +36,9 @@ type
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;
resourcestring
SERR_InvalidDate = '"%s" is not a valid date.';
@ -50,6 +56,29 @@ begin
Result := DateOf(AValue) + DateUtils.IncMinute(TimeOf(AValue),ANumberOfMinutes);
end;
function NormalizeToUTC(const ADate : TDateTimeRec) : TDateTime;
begin
Result := ADate.Date;
if ( ADate.HourOffset <> 0 ) then
Result := IncHour(Result,-ADate.HourOffset);
if ( ADate.MinuteOffset <> 0 ) then
Result := IncMinute(Result,-ADate.MinuteOffset);
end;
function DateEquals(const AA,AB: TDateTimeRec) : Boolean;
var
e, a : TDateTime;
e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms : Word;
a_y, a_m, a_d, a_h, a_mn, a_ss, a_ms : Word;
begin
e := NormalizeToUTC(AA);
a := NormalizeToUTC(AB);
DecodeDateTime(e, e_y, e_m, e_d, e_h, e_mn, e_ss, e_ms);
DecodeDateTime(a, a_y, a_m, a_d, a_h, a_mn, a_ss, a_ms);
Result := ( e_y = a_y ) and ( e_m = a_m ) and ( e_d = a_d ) and
(e_h = a_h ) and ( e_mn = a_mn ) and ( e_ss = a_ss ) and ( e_ms = a_ms );
end;
function xsd_TryStrToDate(const AStr : string; out ADate : TDateTimeRec) : Boolean;
const
DATE_SEP_CHAR = '-'; TIME_MARKER_CHAR = 'T'; TIME_SEP_CHAR = ':';
@ -79,10 +108,37 @@ var
if Result then
Result := TryStrToInt(Copy(buffer,locStartPos,(bufferPos-locStartPos)),AValue);
end;
function ReadMiliSeconds(out AValue : Integer; const ASeparatorAtEnd : Char) : Boolean;
var
locDigitCount, locRes, itemp, locErcode : Integer;
begin
while ( bufferPos <= bufferLen ) and ( buffer[bufferPos] < #33 ) do begin
Inc(bufferPos);
end;
locRes := 0;
locDigitCount := 0;
while ( locDigitCount < 3 ) and ( bufferPos <= bufferLen ) and ( buffer[bufferPos] in ['0'..'9'] ) do begin
Val(buffer[bufferPos],itemp,locErcode);
locRes := ( locRes * 10 ) + itemp;
Inc(bufferPos);
Inc(locDigitCount);
end;
Result := ( locDigitCount > 0 );
if Result then begin
if ( locDigitCount < 3 ) and ( locRes > 0 ) then begin
while ( locDigitCount < 3 ) do begin
locRes := locRes * 10;
Inc(locDigitCount);
end;
end;
AValue := locRes;
end;
end;
var
d, m, y : Integer;
hh, mn, ss : Integer;
hh, mn, ss, ssss : Integer;
tz_hh, tz_mn : Integer;
tz_negative : Boolean;
ok : Boolean;
@ -108,6 +164,7 @@ begin
hh := 0;
mn := 0;
ss := 0;
ssss := 0;
ok := True;
end else begin
ok := ( buffer[bufferPos -1] = TIME_MARKER_CHAR ) and ReadInt(hh,TIME_SEP_CHAR);
@ -117,6 +174,12 @@ begin
if ok then begin
Inc(bufferPos);
ok := ReadInt(ss,#0);
if ok and ( bufferPos < bufferLen ) and ( buffer[bufferPos] = '.' ) then begin
Inc(bufferPos);
ok := ReadMiliSeconds(ssss,#0);
end else begin
ssss := 0;
end;
if ok and ( bufferPos < bufferLen ) then begin
tz_negative := ( buffer[bufferPos] = '-' );
Inc(bufferPos);
@ -134,10 +197,10 @@ begin
end;
end;
if ok then begin
if ( ( y + m + d + hh + mn + ss ) = 0 ) then
if ( ( y + m + d + hh + mn + ss + ssss ) = 0 ) then
ADate.Date := 0
else
ADate.Date := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,0);
ADate.Date := EncodeDate(y,m,d) + EncodeTime(hh,mn,ss,ssss);
ADate.HourOffset := tz_hh;
ADate.MinuteOffset := tz_mn;
Result := True;
@ -200,6 +263,15 @@ begin
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';
end;

81
wst/trunk/tests/test_suite/test_date_utils.pas
View File

@ -28,6 +28,7 @@ type
published
procedure xsd_TryStrToDate_date_only();
procedure xsd_TryStrToDate_date_time();
procedure xsd_TryStrToDate_date_time_fractional_second();
procedure xsd_TryStrToDate_date_bad_separator();
procedure xsd_TryStrToDate_date_time_bad_separator();
procedure xsd_TryStrToDate_date_time_timezone_z();
@ -37,6 +38,8 @@ type
procedure xsd_DateTimeToStr_1();
procedure xsd_DateTimeToStr_2();
procedure xsd_DateTimeToStr_fractional_second_1();
procedure xsd_DateTimeToStr_fractional_second_2();
procedure xsd_DateTimeToStr_timezone_1();
end;
@ -75,6 +78,48 @@ begin
CheckEquals(sDATE_2, xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_DateTimeToStr_fractional_second_1();
const
sDATE_1 = '1976-10-12T23:34:56.007Z';
sDATE_2 = '1976-10-12T23:34:56.078Z';
sDATE_3 = '1976-10-12T23:34:56.789Z';
var
d : TDateTimeRec;
begin
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,7);
CheckEquals(sDATE_1, xsd_DateTimeToStr(d));
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,78);
CheckEquals(sDATE_2, xsd_DateTimeToStr(d));
FillChar(d,SizeOf(d),#0);
d.Date := EncodeDate(1976,10,12) + EncodeTime(23,34,56,789);
CheckEquals(sDATE_3, xsd_DateTimeToStr(d));
end;
procedure TTest_DateUtils.xsd_DateTimeToStr_fractional_second_2();
const
sDATE_1 = '1976-10-12T23:34:56.007Z';
sDATE_2 = '1976-10-12T23:34:56.078Z';
sDATE_3 = '1976-10-12T23:34:56.789Z';
var
d : TDateTime;
begin
FillChar(d,SizeOf(d),#0);
d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,7);
CheckEquals(sDATE_1, xsd_DateTimeToStr(d));
FillChar(d,SizeOf(d),#0);
d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,78);
CheckEquals(sDATE_2, xsd_DateTimeToStr(d));
FillChar(d,SizeOf(d),#0);
d := EncodeDate(1976,10,12) + EncodeTime(23,34,56,789);
CheckEquals(sDATE_3, 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
@ -149,6 +194,42 @@ 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_fractional_second();
procedure do_check(
const AString : string;
const AY, AM, ADY : Word;
const AHH, AMN, ASS, ASSSS : Word
);
var
d : TDateTimeRec;
y,m,dy : Word;
hh,mn,ss, ssss : Word;
begin
d := xsd_StrToDate(AString);
DecodeDate(d.Date,y,m,dy);
CheckEquals(AY,y,'Year');
CheckEquals(AM,m,'Month');
CheckEquals(ADY,dy,'Day');
DecodeTime(d.Date,hh,mn,ss,ssss);
CheckEquals(AHH,hh,'Hour');
CheckEquals(AMN,mn,'Minute');
CheckEquals(ASS,ss,'Second');
CheckEquals(ASSSS,ssss,'MiliSecond');
CheckEquals(0,d.HourOffset,'HourOffset');
CheckEquals(0,d.MinuteOffset,'MinuteOffset');
end;
begin
//'-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss ('.' s+)? (zzzzzz)?
do_check('1976-10-12T23:34:56.7', 1976,10,12, 23,34,56,700);
do_check('1976-10-12T23:34:56.07', 1976,10,12, 23,34,56,70);
do_check('1976-10-12T23:34:56.007', 1976,10,12, 23,34,56,7);
do_check('1976-10-12T23:34:56.789', 1976,10,12, 23,34,56,789);
do_check('1976-10-12T23:34:56.78', 1976,10,12, 23,34,56,780);
do_check('1976-10-12T23:34:56.078', 1976,10,12, 23,34,56,78);
end;
procedure TTest_DateUtils.xsd_TryStrToDate_date_time_timezone_1();
var
s : string;