* Patch by Werner Pamler to improve ISO8601 to datetime conversion

git-svn-id: trunk@49624 -

.gitattributes

@@ -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

packages/rtl-objpas/src/inc/dateutil.inc

@@ -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;

tests/test/units/dateutil/tisotodt.pp

@@ -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.