paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-24 12:29:24 +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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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/test_scandatetime_ampm.pas svneol=native#text/plain
tests/test/units/dateutil/testscandatetime.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/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/dateutil/tunitdt1.pp svneol=native#text/pascal
tests/test/units/dos/hello.pp svneol=native#text/plain tests/test/units/dos/hello.pp svneol=native#text/plain
tests/test/units/dos/tbreak.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; xYear, xMonth, xDay: LongInt;
begin begin
case Length(aString) of 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, 1, 4), xYear) and
TryStrToInt(Copy(aString, 5, 2), xMonth) and TryStrToInt(Copy(aString, 5, 2), xMonth) and
TryStrToInt(Copy(aString, 7, 2), xDay) and TryStrToInt(Copy(aString, 7, 2), xDay) and
TryEncodeDate(xYear, xMonth, xDay, outDate); TryEncodeDate(xYear, xMonth, xDay, outDate);
10: Result := 10: Result := //YYYY-MM-DD
TryStrToInt(Copy(aString, 1, 4), xYear) and TryStrToInt(Copy(aString, 1, 4), xYear) and
TryStrToInt(Copy(aString, 6, 2), xMonth) and TryStrToInt(Copy(aString, 6, 2), xMonth) and
TryStrToInt(Copy(aString, 9, 2), xDay) and TryStrToInt(Copy(aString, 9, 2), xDay) and
@ -2820,55 +2831,57 @@ begin
end; end;
case xLength of case xLength of
2: Result := 2: Result := // HH
TryStrToInt(aString, xHour) and TryStrToInt(aString, xHour) and
TryEncodeTime(xHour, 0, 0, 0, outTime); TryEncodeTime(xHour, 0, 0, 0, outTime);
4: Result := 4: Result := // HHNN
TryStrToInt(Copy(aString, 1, 2), xHour) and TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime); TryEncodeTime(xHour, xMinute, 0, 0, outTime);
5: Result := 5: Result := // HH:NN
TryStrToInt(Copy(aString, 1, 2), xHour) and TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and (aString[3] = ':') and
TryStrToInt(Copy(aString, 4, 2), xMinute) and TryStrToInt(Copy(aString, 4, 2), xMinute) and
TryEncodeTime(xHour, xMinute, 0, 0, outTime); TryEncodeTime(xHour, xMinute, 0, 0, outTime);
6: Result := 6: Result := // HHNNSS
TryStrToInt(Copy(aString, 1, 2), xHour) and TryStrToInt(Copy(aString, 1, 2), xHour) and
TryStrToInt(Copy(aString, 3, 2), xMinute) and TryStrToInt(Copy(aString, 3, 2), xMinute) and
TryStrToInt(Copy(aString, 5, 2), xSecond) and TryStrToInt(Copy(aString, 5, 2), xSecond) and
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime); 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 else
if xLength >= 9 then if (xLength >= 8) and (aString[3] = ':') and (aString[6] = ':') then
begin begin
Result := Result := // HH:NN:SS
TryStrToInt(Copy(aString, 1, 2), xHour) and TryStrToInt(Copy(aString, 1, 2), xHour) and
(aString[3] = ':') and TryStrToInt(Copy(aString, 4, 2), xMinute) and
TryStrToInt(Copy(aString, 4, 2), xMinute) and TryStrToInt(Copy(aString, 7, 2), xSecond) and
(aString[6] = ':') and TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
TryStrToInt(Copy(aString, 7, 2), xSecond) and if Result and (xLength >= 9) then // HH:NN:SS.[z] (0 or several z)
((aString[9] = '.') or (aString[9] = ',')) and begin
TryEncodeTime(xHour, xMinute, xSecond, 0, outTime); tmp := copy(aString, 10, xLength-9);
if Result then val('.' + tmp, xFractionalSecond, res);
begin Result := (res = 0);
tmp := Copy(aString, 9, xLength-8); if Result then
if tmp <> '' then outTime := outTime + xFractionalSecond * OneSecond;
begin end;
tmp[1] := '.'; end else
val(tmp, xFractionalSecond, res); if (xLength >= 7) and (aString[7] in ['.', ',']) then
Result := res = 0; begin
if Result then Result := // HHNNSS
outTime := outTime + xFractionalSecond * OneSecond; TryStrToInt(Copy(aString, 1, 2), xHour) and
end; TryStrToInt(Copy(aString, 3, 2), xMinute) and
end; TryStrToInt(Copy(aString, 5, 2), xSecond) and
end else TryEncodeTime(xHour, xMinute, xSecond, 0, outTime);
Result := false; 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; end;
if not Result then if not Result then
@ -2883,12 +2896,27 @@ var
begin begin
xLength := Length(aString); 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 begin
sDate:=Copy(aString, 1, 10); sDate:=Copy(aString, 1, 10);
sTime:=Copy(aString, 12, Length(aString)) sTime:=Copy(aString, 12, Length(aString))
end end
else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then else if (xLength>9) and CharInSet(aString[9], [' ', 'T']) then // YYYYMMDDT...
begin begin
sDate:=Copy(aString, 1, 8); sDate:=Copy(aString, 1, 8);
sTime:=Copy(aString, 10, Length(aString)); sTime:=Copy(aString, 10, Length(aString));
@ -2958,21 +2986,25 @@ begin
TZ:='Z'; TZ:='Z';
S:=Copy(S,1,L-1); S:=Copy(S,1,L-1);
end 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 begin
TZ:=Copy(S,L-2,3); TZ:=Copy(S,L-2,3);
S:=Copy(S,1,L-3); S:=Copy(S,1,L-3);
end end
else If (L>4) and (S[L-4] in ['+','-']) then else If (S[L-4] in ['+','-']) then
begin begin
TZ:=Copy(S,L-4,5); TZ:=Copy(S,L-4,5);
S:=Copy(S,1,L-5); S:=Copy(S,1,L-5);
end 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 begin
TZ:=Copy(S,L-5,6); TZ:=Copy(S,L-5,6);
S:=Copy(S,1,L-6); S:=Copy(S,1,L-6);
end; end;
end;
Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset); Result:=TryIsoStrToDateTime(S,aDateTime) and TryISOTZStrToTZOffset(TZ,TZOffset);
if not Result then if not Result then
exit; 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.