paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 00:48:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch by Werner Pamler to improve ISO8601 to datetime conversion

Browse Source 
git-svn-id: trunk@49624 -
This commit is contained in:
michael 2021-07-21 15:59:37 +00:00
parent 573917706f
commit 4fac31d1c7
3 changed files with 301 additions and 42 deletions
.gitattributes
packages/rtl-objpas/src/inc
dateutil.inc
tests/test/units/dateutil
tisotodt.pp

1
.gitattributes vendored
View File

@ -16223,6 +16223,7 @@ tests/test/units/crt/tctrlc.pp svneol=native#text/plain
tests/test/units/dateutil/test_scandatetime_ampm.pas svneol=native#text/plain
tests/test/units/dateutil/testscandatetime.pas svneol=native#text/plain
tests/test/units/dateutil/tiso8601.pp svneol=native#text/plain
tests/test/units/dateutil/tisotodt.pp svneol=native#text/plain
tests/test/units/dateutil/tunitdt1.pp svneol=native#text/pascal
tests/test/units/dos/hello.pp svneol=native#text/plain
tests/test/units/dos/tbreak.pp svneol=native#text/plain

116
packages/rtl-objpas/src/inc/dateutil.inc
View File

@ -2762,12 +2762,23 @@ var
xYear, xMonth, xDay: LongInt;
begin
case Length(aString) of
8: Result :=
4: Result := // YYYY
TryStrToInt(aString, xYear) and
TryEncodeDate(xYear, 1, 1, outDate);
6: Result := // YYYYMM
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 5, 2), xMonth) and
TryEncodeDate(xYear, xMonth, 1, outDate);
7: Result := // YYYY-MM
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 6, 2), xMonth) and
TryEncodeDate(xYear, xMonth, 1, outDate);
8: Result := // YYYYMMDD
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 5, 2), xMonth) and
TryStrToInt(Copy(aString, 7, 2), xDay) and
TryEncodeDate(xYear, xMonth, xDay, outDate);
10: Result :=
10: Result := //YYYY-MM-DD
TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 6, 2), xMonth) and
TryStrToInt(Copy(aString, 9, 2), xDay) and
@ -2820,55 +2831,57 @@ begin
end;
case xLength of
2: Result :=
2: Result := // HH
TryStrToInt(aString, xHour) and
TryEncodeTime(xHour, 0, 0, 0, outTime);
4: Result :=
4: Result := // HHNN
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime);
5: Result :=
5: Result := // HH:NN
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime);
6: Result :=
6: Result := // HHNNSS
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryStrToInt(Copy(aString, 5, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
8: Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
(aString[6] = ':') and
TryStrToInt(Copy(aString, 7, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
else
if xLength >= 9 then
begin
Result :=
TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
(aString[6] = ':') and
TryStrToInt(Copy(aString, 7, 2), xSecond) and
((aString[9] = '.') or (aString[9] = ',')) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
if Result then
begin
tmp := Copy(aString, 9, xLength-8);
if tmp <> '' then
begin
tmp[1] := '.';
val(tmp, xFractionalSecond, res);
Result := res = 0;
if Result then
outTime := outTime + xFractionalSecond * OneSecond;
end;
end;
end else
Result := false;
if (xLength >= 8) and (aString[3] = ':') and (aString[6] = ':') then
begin
Result := // HH:NN:SS
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 4, 2), xMinute) and
TryStrToInt(Copy(aString, 7, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
if Result and (xLength >= 9) then // HH:NN:SS.[z] (0 or several z)
begin
tmp := copy(aString, 10, xLength-9);
val('.' + tmp, xFractionalSecond, res);
Result := (res = 0);
if Result then
outTime := outTime + xFractionalSecond * OneSecond;
end;
end else
if (xLength >= 7) and (aString[7] in ['.', ',']) then
begin
Result := // HHNNSS
TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryStrToInt(Copy(aString, 5, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
tmp := copy(aString, 8, xLength-7);
if Result and (tmp <> '') then
begin // HHNNSS.[z] (0 or several z)
val('.'+tmp, xFractionalSecond, res);
Result := res = 0;
if Result then
outTime := outTime + xFractionalSecond * OneSecond;
end;
end else
Result := false;
end;
if not Result then
@ -2883,12 +2896,27 @@ var
begin
xLength := Length(aString);
if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then
if (xLength = 0) then
exit(false);
if (aString[1]='T') then
begin
Result := TryISOStrToTime(copy(aString, 2, Length(aString)-1), outDateTime);
exit;
end;
if (xLength in [4 {YYYY}, 7 {YYYY-MM}, 8 {YYYYMMDD}, 10 {YYYY-MM-DD}]) then
begin
Result := TryISOStrToDate(aString, outDateTime);
exit;
end;
if (xLength>11) and CharInSet(aString[11], [' ', 'T']) then // YYYY-MM-DDT...
begin
sDate:=Copy(aString, 1, 10);
sTime:=Copy(aString, 12, Length(aString))
end
else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then
else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then // YYYYMMDDT...
begin
sDate:=Copy(aString, 1, 8);
sTime:=Copy(aString, 10, Length(aString));
@ -2958,21 +2986,25 @@ begin
TZ:='Z';
S:=Copy(S,1,L-1);
end
else If (L>2) and (S[L-2] in ['+','-']) then
else if ((L>11) and ((S[11] in ['T',' ']) or (S[9] in ['T',' ']))) or // make sure that we dont't have date-only
(S[1]='T') then
begin
If (S[L-2] in ['+','-']) then
begin
TZ:=Copy(S,L-2,3);
S:=Copy(S,1,L-3);
end
else If (L>4) and (S[L-4] in ['+','-']) then
else If (S[L-4] in ['+','-']) then
begin
TZ:=Copy(S,L-4,5);
S:=Copy(S,1,L-5);
end
else If (L>5) and (S[L-5] in ['+','-']) then
else If (S[L-5] in ['+','-']) and ((L > 13) or (S[1]='T')) then // do not confuse with '2021-05-21T13'
begin
TZ:=Copy(S,L-5,6);
S:=Copy(S,1,L-6);
end;
end;
Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
if not Result then
exit;

226
tests/test/units/dateutil/tisotodt.pp Normal file
View File

@ -0,0 +1,226 @@
program Project1;
{$mode objfpc}
uses
DateUtils;
var
ErrorCount: Integer = 0;
ExpectedErrorCount: Integer = 0;
procedure Test(s: String; const Comment: String = '');
var
dt: TDateTime;
begin
if Comment <> '' then
inc(ExpectedErrorCount);
Write(s:35, ' ---> ');
try
dt := ISO8601ToDate(s, true);
WriteLn(dt:0:15);
except
WriteLn('ERROR (', Comment, ')');
inc(ErrorCount);
end;
end;
begin
WriteLn('This test tries to decode a variety of ISO8601-formatted date/time strings.');
WriteLn('When the conversion was not successful the text ''ERROR'' appears.');
WriteLn;
WriteLn('PART 1: The following tests are expected to produce no errors.');
// 1 - Test string with separators, dot decimal separator.
Test('2021-05-22T13:57:49.191021Z');
Test('2021-05-22T13:57:49.191Z');
Test('2021-05-22T13:57:49.19Z');
Test('2021-05-22T13:57:49.1Z');
Test('2021-05-22T13:57:49.Z');
Test('2021-05-22T13:57:49Z');
Test('2021-05-22T13:57Z');
Test('2021-05-22T13Z');
WriteLn;
// 2 - Test string without separators
Test('20210522T135749.191021Z');
Test('20210522T135749.191Z');
Test('20210522T135749.19Z');
Test('20210522T135749.1Z');
Test('20210522T135749.Z');
Test('20210522T135749Z');
Test('20210522T1357Z');
Test('20210522T13Z');
WriteLn;
// 3 - Fractional seconds, with separators, comma decimal separator.
Test('2021-05-22T13:57:49,191021Z');
Test('2021-05-22T13:57:49,191Z');
Test('2021-05-22T13:57:49,19Z');
Test('2021-05-22T13:57:49,1Z');
Test('2021-05-22T13:57:49,Z');
WriteLn;
// 4 - Fractional seconds, no separators, comma decimal separator.
Test('20210522T135749,191021Z');
Test('20210522T135749,191Z');
Test('20210522T135749,19Z');
Test('20210522T135749,1Z');
Test('20210522T135749,Z');
WriteLn;
// 5 - like 1, but positive time zone offset hh:nn
Test('2021-05-22T13:57:49.191021+02:00');
Test('2021-05-22T13:57:49.191+02:00');
Test('2021-05-22T13:57:49.19+02:00');
Test('2021-05-22T13:57:49.1+02:00');
Test('2021-05-22T13:57:49.+02:00');
Test('2021-05-22T13:57:49+02:00');
Test('2021-05-22T13:57+02:00');
Test('2021-05-22T13+02:00');
WriteLn;
// 6 - like 1, but negative time zone offset hh:nn
Test('2021-05-22T13:57:49.191021-02:00');
Test('2021-05-22T13:57:49.191-02:00');
Test('2021-05-22T13:57:49.19-02:00');
Test('2021-05-22T13:57:49.1-02:00');
Test('2021-05-22T13:57:49.-02:00');
Test('2021-05-22T13:57:49-02:00');
Test('2021-05-22T13:57-02:00');
Test('2021-05-22T13-02:00');
WriteLn;
// 7 - like 1, but positive time zone offset hhnn
Test('2021-05-22T13:57:49.191021+0200');
Test('2021-05-22T13:57:49.191+0200');
Test('2021-05-22T13:57:49.19+0200');
Test('2021-05-22T13:57:49.1+0200');
Test('2021-05-22T13:57:49.+0200');
Test('2021-05-22T13:57:49+0200');
Test('2021-05-22T13:57+0200');
Test('2021-05-22T13+0200');
WriteLn;
// 8 - like 1, but negative time zone offset hhnn
Test('2021-05-22T13:57:49.191021-0200');
Test('2021-05-22T13:57:49.191-0200');
Test('2021-05-22T13:57:49.19-0200');
Test('2021-05-22T13:57:49.1-0200');
Test('2021-05-22T13:57:49.-0200');
Test('2021-05-22T13:57:49-0200');
Test('2021-05-22T13:57-0200');
Test('2021-05-22T13-0200');
WriteLn;
// 9 - like 1, but positive time zone offset hh
Test('2021-05-22T13:57:49.191021+02');
Test('2021-05-22T13:57:49.191+02');
Test('2021-05-22T13:57:49.19+02');
Test('2021-05-22T13:57:49.1+02');
Test('2021-05-22T13:57:49.+02');
Test('2021-05-22T13:57:49+02');
Test('2021-05-22T13:57+02');
Test('2021-05-22T13+02');
WriteLn;
// 10 - like 1, but negative time zone offset hh
Test('2021-05-22T13:57:49.191021-02');
Test('2021-05-22T13:57:49.191-02');
Test('2021-05-22T13:57:49.19-02');
Test('2021-05-22T13:57:49.1-02');
Test('2021-05-22T13:57:49.-02');
Test('2021-05-22T13:57:49-02');
Test('2021-05-22T13:57-02');
Test('2021-05-22T13-02');
WriteLn;
// 11 - like 1, no Z
Test('2021-05-22T13:57:49.191021');
Test('2021-05-22T13:57:49.191');
Test('2021-05-22T13:57:49.19');
Test('2021-05-22T13:57:49.1');
Test('2021-05-22T13:57:49.');
Test('2021-05-22T13:57:49');
Test('2021-05-22T13:57');
Test('2021-05-22T13');
Test('20210522T13');
WriteLn;
// 12 - Date only
Test('2021-05-22');
Test('2021-05');
Test('2021/05/22');
Test('2021/05');
Test('2021');
WriteLn;
// 13 - Date only, no separator
Test('20210522');
// 14 - Time only, UTC
Test('T13:57:49.191021Z');
Test('T13:57:49.191Z');
Test('T13:57:49.19Z');
Test('T13:57:49.1Z');
Test('T13:57:49.Z');
Test('T13:57:49Z');
Test('T13:57Z');
Test('T13Z');
WriteLn;
// 15 - Time only, timezone hh:nn
Test('T13:57:49.191021-02:00');
Test('T13:57:49.191-02:00');
Test('T13:57:49.19-02:00');
Test('T13:57:49.1-02:00');
Test('T13:57:49.-02:00');
Test('T13:57:49-02:00');
Test('T13:57-02:00');
Test('T13-02:00');
WriteLn;
// 16 - Time only, timezone hhnn
Test('T13:57:49.191021-0200');
Test('T13:57:49.191-0200');
Test('T13:57:49.19-0200');
Test('T13:57:49.1-0200');
Test('T13:57:49.-0200');
Test('T13:57:49-0200');
Test('T13:57-0200');
Test('T13-0200');
WriteLn;
// 17 - Time only, timezone hh
Test('T13:57:49.191021-02');
Test('T13:57:49.191-02');
Test('T13:57:49.19-02');
Test('T13:57:49.1-02');
Test('T13:57:49.-02');
Test('T13:57:49-02');
Test('T13:57-02');
Test('T13-02');
if ErrorCount = 0 then
WriteLn('No error found in part 1 of the test (0 errors expected)')
else
begin
WriteLn(ErrorCount, ' errors found in part 1 of the test (0 errors expected)');
Halt(1);
end;
WriteLn('PART 2: The following tests are expected to produce errors');
ErrorCount := 0;
ExpectedErrorCount := 0;
Test('21-05-22T13:57:49.191021Z', '2-digit year');
Test('210522T13:57:49.191021Z', '2-digit year');
Test('202105', '6-digit date YYYYMM');
Test('210502', '6-digit date with two-digit year YYMMDD');
Test('20210522X13:57:491Z', 'wrong "T" separator');
WriteLn(ErrorCount, ' errors found in part 2 of the test (', ExpectedErrorCount, ' errors expected).');
WriteLn;
If ErrorCount<>ExpectedErrorCount then
Halt(2);
end.