* New more delphi compat intstrtotime by Bart Broersma #15505 + test

git-svn-id: trunk@14854 -

.gitattributes

@@ -9445,6 +9445,7 @@ tests/test/units/system/tval3.pp svneol=native#text/plain
 tests/test/units/system/tval4.pp svneol=native#text/plain
 tests/test/units/system/tval5.pp svneol=native#text/plain
 tests/test/units/system/tvalc.pp svneol=native#text/plain
+tests/test/units/sysutils/strtotimetest.pp svneol=native#text/plain
 tests/test/units/sysutils/tastrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tastrcmp1.pp svneol=native#text/plain
 tests/test/units/sysutils/texec1.pp svneol=native#text/plain

rtl/objpas/sysutils/dati.inc

@@ -533,92 +533,169 @@ end;
     if S does not represent a valid time value an
     EConvertError will be raised   }
 
+
 function IntStrToTime(Out ErrorMsg : AnsiString; const S: PChar; Len : integer;const defs:TFormatSettings; separator : char = #0): TDateTime;
+const
+  AMPM_None = 0;
+  AMPM_AM = 1;
+  AMPM_PM = 2;
+  tiHour = 0;
+  tiMin = 1;
+  tiSec = 2;
+  tiMSec = 3;
+type
+  TTimeValues = array[tiHour..tiMSec] of Word;
 var
-   Current: integer; PM: integer;
+   AmPm: integer;
+   TimeValues: TTimeValues;
 
     function StrPas(Src : PChar; len: integer = 0) : ShortString;
-    var
-       tmp : integer;
     begin
-        {tmp := IndexChar(Src[0], len, #0);
+        //this is unsafe for len > 255, it will trash memory (I tested this)
-        len :=ifthen(tmp >= 0, tmp, len);
+        //reducing it is safe, since whenever we use this a string > 255 is invalid anyway
-        len :=ifthen(len > 255, 255, len);}
+        if len > 255 then len := 255;
         SetLength(Result, len);
         move(src[0],result[1],len);
     end;
 
-   function GetElement: integer;
+   function SplitElements(out TimeValues: TTimeValues; out AmPm: Integer): Boolean;
+   //Strict version. It does not allow #32 as Separator, it will treat it as whitespace always
+   const
+     Digits = ['0'..'9'];
    var
-     j, c: integer;
+      Cur, Offset, ElemLen, Err, TimeIndex, FirstSignificantDigit: Integer;
-     CurrentChar : Char;
+      Value: Word;
+      DigitPending, MSecPending: Boolean;
+      AmPmStr: ShortString;
+      CurChar: Char;
    begin
-   result := -1;
+     Result := False;
-   while (result = -1) and (Current < Len) do
+     AmPm := AMPM_None; //No Am or PM in string found yet
+     MSecPending := False;
+     TimeIndex := 0; //indicating which TTimeValue must be filled next
+     FillChar(TimeValues, SizeOf(TTimeValues), 0);
+     Cur := 0;
+     //skip leading blanks
+     While (Cur < Len) and (S[Cur] =#32) do Inc(Cur);
+     Offset := Cur;
+     //First non-blank cannot be Separator or DecimalSeparator
+     if (Cur > Len - 1) or (S[Cur] = Separator) or (S[Cur] = defs.Decimalseparator) then Exit;
+     DigitPending := (S[Cur] in Digits);
+     While (Cur < Len) do
      begin
-       CurrentChar := S[Current];
+       //writeln;
-       if CurrentChar in ['0'..'9'] then
+       //writeln('Main While loop:  Cur = ',Cur,' S[Cur] = "',S[Cur],'" Len = ',Len);
-          begin
+       CurChar := S[Cur];
-            j := Current;
+       if CurChar in Digits then
-            while (Current+1 < Len) and (s[Current + 1] in ['0'..'9']) do
+       begin//Digits
-              Inc(Current);
+         //HH, MM, SS, or Msec?
-            val(StrPas(S+j, 1 + current - j), result, c);
+         //writeln('Digit');
-          end
+         //Digits are only allowed after starting Am/PM or at beginning of string or after Separator
-       else if ((defs.TimeAMString<>'') and (CurrentChar = defs.TimeAMString[1])) or (S[Current] in ['a', 'A']) then
+         //and TimeIndex must be <= tiMSec
-          begin
+         //Uncomment "or (#32 = Separator)" and it will allllow #32 as separator
-            pm:=1;
+         if (not (DigitPending {or (#32 = Separator)})) or (TimeIndex > tiMSec) then Exit;
-            Current := 1 + Len;
+         OffSet := Cur;
-          end
+         if (CurChar <> '0') then FirstSignificantDigit := OffSet else FirstSignificantDigit := -1;
-       else if ((defs.TimePMString<>'') and (CurrentChar = defs.TimePMString[1])) or (S[Current] in ['p', 'P']) then
+         while (Cur < Len -1) and (S[Cur + 1] in Digits) do
          begin
-           Current := 1 + Len;
+           //Mark first Digit that is not '0'
-           PM := 2;
+           if (FirstSignificantDigit = -1) and (S[Cur] <> '0') then FirstSignificantDigit := Cur;
+           Inc(Cur);
+         end;
+         if (FirstSignificantDigit = -1) then FirstSignificantDigit := Cur;
+         ElemLen := 1 + Cur - FirstSignificantDigit;
+         //writeln('  S[FirstSignificantDigit] = ',S[FirstSignificantDigit], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
+         //writeln('  Cur = ',Cur);
+         //this way we know that Val() will never overflow Value !
+         if (ElemLen <= 2) or ((ElemLen <= 3) and (TimeIndex = tiMSec) ) then
+         begin
+           Val(StrPas(S + FirstSignificantDigit, ElemLen), Value, Err);
+           //writeln('  Value = ',Value,' HH = ',TimeValues[0],' MM = ',TimeValues[1],' SS = ',TimeValues[2],' MSec = ',Timevalues[3]);
+           //This is safe now, because we know Value < High(Word)
+           TimeValues[TimeIndex] := Value;
+           Inc(TimeIndex);
+           DigitPending := False;
          end
-      else if (CurrentChar = Separator) or (CurrentChar = ' ') then
+         else  Exit; //Value to big, so it must be a wrong timestring
-         Inc(Current)
+       end//Digits
-      else
+       else if (CurChar = #32) then
-        ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S)]);
+       begin
-      end ;
+         //writeln('#32');
-   end ;
+         //just skip, but we must adress this, or it will be parsed by either AM/PM or Separator
+       end
+       else if (CurChar = Separator) then
+       begin
+         //writeln('Separator');
+         if DigitPending or (TimeIndex > tiSec) then Exit;
+         DigitPending := True;
+         MSecPending := False;
+       end
+       else if (CurChar = defs.DecimalSeparator) then
+       begin
+         //writeln('DecimalSeparator');
+         if DigitPending or MSecPending or (TimeIndex <> tiMSec) then Exit;
+         DigitPending := True;
+         MSecPending := True;
+       end
+       else
+       begin//AM/PM?
+         //None of the above, so this char _must_ be the start of AM/PM string
+         //If we already have found AM/PM or we expect a digit then then timestring must be wrong at this point
+         //writeln('AM/PM?');
+         if (AmPm <> AMPM_None) or DigitPending then Exit;
+         OffSet := Cur;
+         while (Cur < Len -1) and (not (S[Cur + 1] in [Separator, #32, defs.DecimalSeparator]))
+           and not (S[Cur + 1] in Digits) do Inc(Cur);
+         ElemLen := 1 + Cur - OffSet;
+         //writeln('  S[Offset] = ',S[Offset], ' S[Cur] = ',S[Cur],' ElemLen = ',ElemLen,' -> ', StrPas(S + Offset, ElemLen));
+         //writeln('  Cur = ',Cur);
+         AmPmStr := StrPas(S + OffSet, ElemLen);
 
-var
+         //writeln('AmPmStr = ',ampmstr,' (',length(ampmstr),')');
-   i: integer;
+         //We must compare to TimeAMString before hardcoded 'AM' for delphi compatibility
-   TimeValues: array[0..4] of integer;
+         //Also it is perfectly legal, though insane to have TimeAMString = 'PM' and vice versa
+         if (AnsiCompareText(AmPmStr, defs.TimeAMString) = 0) then AmPm := AMPM_AM
+         else if (AnsiCompareText(AmPmStr, defs.TimePMString) = 0) then AmPm := AMPM_PM
+         else if (CompareText(AmPmStr, 'AM') = 0) then AmPm := AMPM_AM
+         else if (CompareText(AmPmStr, 'PM') = 0) then AmPm := AMPM_PM
+         else Exit; //If text does not match any of these, timestring must be wrong;
+         //if AM/PM is at beginning of string, then a digit is mandatory after it
+         if (TimeIndex = tiHour) then
+         begin
+           DigitPending := True;
+         end
+         //otherwise, no more TimeValues allowed after this
+         else
+         begin
+           TimeIndex := tiMSec + 1;
+           DigitPending := False;
+         end;
+       end;//AM/PM
+       Inc(Cur)
+     end;//while
+
+     //If we arrive here, parsing the elements has been successfull
+     //if not at least Hours specified then input is not valid
+     //when am/pm is specified Hour must be <= 12 and not 0
+     if (TimeIndex = tiHour) or ((AmPm <> AMPM_None) and ((TimeValues[tiHour] > 12) or (TimeValues[tiHour] = 0))) or DigitPending then Exit;
+     Result := True;
+   end;
 
 begin
   if separator = #0 then
         separator := defs.TimeSeparator;
-  Current := 0;
+  AmPm := AMPM_None;
-  PM := 0;
+  if not SplitElements(TimeValues, AmPm) then
-  for i:=0 to 4 do
+  begin
-    timevalues[i]:=0;
+    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
-  i := 0;
-  TimeValues[i] := GetElement;
-  If ErrorMsg<>'' then 
     Exit;
-  while (i < 5) and (TimeValues[i] <> -1) do 
+  end;
-    begin
+  if (AmPm=AMPM_PM) and (TimeValues[tiHour]<>12) then Inc(TimeValues[tiHour], 12)
-     i := i + 1;
+  else if (AmPm=AMPM_AM) and (TimeValues[tiHour]=12) then TimeValues[tiHour]:=0;
-     Inc(Current);
-     TimeValues[i] := GetElement;
-     If ErrorMsg<>'' then
-        Exit;
-   end ;
-  If (i<5) and (TimeValues[I]=-1) then
-    TimeValues[I]:=0;
-  if PM=2 then
-    begin
-     if (TimeValues[0] <> 12) then
-       Inc(TimeValues[0], 12);
-    end
-  else
-    begin
-      if (pm=1) and ((TimeValues[0]=12)) then
-        TimeValues[0]:=0;
-    end;
 
-  if not TryEncodeTime(TimeValues[0], TimeValues[1], TimeValues[2], TimeValues[3],result) Then
+  if not TryEncodeTime(TimeValues[tiHour], TimeValues[tiMin], TimeValues[tiSec], TimeValues[tiMSec], result) Then
-    errormsg:='Invalid time.';
+    //errormsg:='Invalid time.';
+    ErrorMsg:=Format(SErrInvalidTimeFormat,[StrPas(S, Len)]);
 end ;
 
 function StrToTime(const S: PChar; Len : integer; separator : char = #0): TDateTime;

tests/test/units/sysutils/strtotimetest.pp

@@ -0,0 +1,159 @@
+program strtmtest;
+
+{$ifdef FPC}
+  {$mode objfpc}{$H+}
+{$else}
+  {$apptype console}
+{$endif}
+
+uses sysutils,sysconst{$ifndef fpc},windows{$endif};
+
+{$ifndef fpc}
+function defaultformatsettings:TFormatSettings;
+begin
+  GetLocaleFormatSettings(getsystemdefaultlcid,result);
+end;
+{$endif}
+var exitwitherror:integer =0;
+    fmt : TFormatSettings;
+
+Procedure Check(TestNo : Integer; inputstr : String;shouldfailstrtotime:boolean=false;shouldfailcomparison:boolean=false;resultstr:string='');
+
+var dt :TDateTime;
+    outputstr:ansistring;
+
+begin
+  if TryStrToTime(inputstr,dt,fmt) then
+   begin
+     if shouldfailstrtotime then
+       begin
+         writeln('test ',TestNo,' should fail on strtotime while it didn''t ',timetostr(dt,fmt));
+         exitwitherror:=1;
+       end
+     else
+       begin
+         outputstr:=TimeToStr(dt,fmt); // note because of this bugs can also be in timetostr
+         if resultstr<>'' then
+            begin
+              if outputstr<>resultstr then
+                begin
+                  writeln('test ',TestNo,' should be "',resultstr,'" is "',outputstr,'"');
+                  exitwitherror:=1;
+                end;
+              exit; // don't do other comparisons
+            end;
+
+         if inputstr<>outputstr then
+           begin
+            if not shouldfailcomparison then
+              begin
+                writeln('test ',TestNo,' failed "',inputstr,'" <> "',outputstr,'"');
+                exitwitherror:=1;
+              end;
+           end
+         else
+           begin
+            if shouldfailcomparison then
+              begin
+                writeln('test ',TestNo,' succeeded "',inputstr,'" = "',outputstr,'", while it shouldn''t');
+                exitwitherror:=1;
+              end;
+           end;
+       end;
+   end
+  else
+    if not shouldfailstrtotime then
+     begin
+       Writeln('Test ',TestNo,' failed: ',inputstr);
+       exitwitherror:=1;
+    end;
+end;
+
+procedure setdecimalsep(c:char);
+begin
+  fmt.DecimalSeparator:=c;
+  fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz';
+end;
+
+var value: word;
+  code : longint;
+begin
+  fmt:=defaultformatsettings;
+  fmt.TimeSeparator:=':';
+  fmt.TimeAmstring:='AM';
+  fmt.TimePmstring:='PM';
+
+  setdecimalsep('.');
+  Check( 0,'12:34:45.789',false,false);
+  Check( 1,'12:34:45,789',true,false);
+
+  setdecimalsep(',');
+  Check( 2,'12:34:45.789',true,false);
+  Check( 3,'12:34:45,789',false,false);
+
+  Check( 4,'12 am',false,false,'00:00:00,000');
+  Check( 5,'pm 12:34',false,false,'12:34:00,000');
+  Check( 6,'12::45',true,false);
+  Check( 7,'12:34:56 px',true,false);
+  Check( 8,'12:34:5x',true,false);
+  Check( 9,'12:34:56:78:90',true,false);
+  Check(10,'5 am',false,false,'05:00:00,000');
+  Check(11,'5 pm',false,false,'17:00:00,000');
+  Check(12,'am 5',false,false,'05:00:00,000');
+  Check(13,'pm 5',false,false,'17:00:00,000');
+  fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz am/pm';
+  Check(14,'5 am',false,false,'05:00:00,000 am');
+  Check(15,'5 pm',false,false,'05:00:00,000 pm');
+  Check(16,'am 5',false,false,'05:00:00,000 am');
+  Check(17,'pm 5',false,false,'05:00:00,000 pm');
+  fmt.TimeAmstring:='AM';
+  fmt.TimePmstring:='PM';
+  fmt.longtimeformat:='hh:nn:ss'+fmt.DecimalSeparator+'zzz a/p';
+  Check(18,'am 5',false,false,'05:00:00,000 a');
+  Check(19,'pm 5',false,false,'05:00:00,000 p');
+
+  fmt.TimeAMString:='a'; fmt.TimePMString:='p';
+
+  Check(20,'a 5',false,false,'05:00:00,000 a');
+  Check(21,'p 5',false,false,'05:00:00,000 p');
+  Check(22,'12:',True,false);
+  Check(23,'13:14:',True,false);
+  Check(24,'a 17:00',True,false);
+  Check(25,'p 19:00',True,false);
+  Check(26,'1:2:3',false,false,'01:02:03,000 a');
+  Check(27,'1:4',false,false,'01:04:00,000 a');
+  Check(28,'111:2:3',True,false);
+  Check(29,'1:444',True,false);
+  Check(30,'1:2:333',True,false);
+  Check(31,'1:4:55,4',False,false,'01:04:55,004 a');
+  Check(32,'1:4:55,12',False,false,'01:04:55,012 a');
+  Check(33,'1:4:55,004',False,false,'01:04:55,004 a');
+  Check(34,'1:4:55,0012',False,false,'01:04:55,012 a');
+  Check(35,'1:4:55,004'#9'am',true,false,'01:04:55,004'#9'am');
+  Check(36,#9'1:4:55,0012',true,false,'01:04:55,012 a');
+  Check(37,' 1:4:55,4',False,false,'01:04:55,004 a');
+  Check(38,'1: 4:55,12',False,false,'01:04:55,012 a');
+  Check(39,'1:4: 55,004',False,false,'01:04:55,004 a');
+  Check(40,'1:4:55, 2',False,false,'01:04:55,002 a');
+  Check(41,'1:4:55,   4',False,false,'01:04:55,004 a'); // note more padding then needed
+  Check(42,'1:    4:55,   4',False,false,'01:04:55,004 a'); // note more padding then needed
+  Check(43,'1:  4:   55,   4',False,false,'01:04:55,004 a'); // note more padding then needed
+  Check(44,'1:  4:  55,   4',False,false,'01:04:55,004 a'); // note more padding then needed
+  Check(45,'1 4 55 4',True,false);
+  fmt.timeseparator:=' ';
+  Check(46,'01 04 55',True,false);
+  Check(47,'a 01',false,false,'01 00 00,000 a');
+  Check(52,'a01',false,false,'01 00 00,000 a');
+  fmt.TimeSeparator:=':';
+  Check(48,'1:4:55,0000000000000000000000012',false,false,'01:04:55,012 a');
+  Check(49,'1:4:55,0000100012',True,false);
+  Check(50,'1:4:55,000001012',True,false);
+  Check(51,'12:034:00056',false,false,'12:34:56,000 p');
+
+  exitcode:=exitwitherror;
+
+ {$ifndef fpc} // halt in delphi ide  
+  readln;
+ {$endif}
+end.
+