* Fix issue ID #38462

git-svn-id: trunk@48580 -

.gitattributes

@@ -16042,6 +16042,7 @@ tests/test/units/cocoaall/tw36362.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
 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/tunitdt1.pp svneol=native#text/pascal
 tests/test/units/dos/hello.pp svneol=native#text/plain

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

@@ -2379,6 +2379,8 @@ begin
 end;
 
 function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
+const
+  EPS = 1E-15;
 
 var len ,ind  : integer;
     yy,mm,dd  : integer;
@@ -2558,44 +2560,59 @@ begin
                        end;
                      end;
                'A' : begin
-                            i:=findimatch(AMPMformatting,@ptrn[pind]);
-                            case i of
-                              0: begin
-                                   i:=findimatch(['AM','PM'],@s[ind]);
-                                   case i of
-                                     0: ;
-                                     1: timeval:=timeval+12*hrfactor;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[0]));
-                                   inc(ind,2);
-                                 end;
-                              1: begin
-                                    case upcase(s[ind]) of
-                                     'A' : ;
-                                     'P' : timeval:=timeval+12*hrfactor;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[1]));
-                                   inc(ind);
-                                 end;
-                               2: begin
-                                    i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
-                                    case i of
-                                     0: inc(ind,length(fmt.timeamstring));
-                                     1: begin
-                                          timeval:=timeval+12*hrfactor;
-                                          inc(ind,length(fmt.timepmstring));
-                                        end;
-                                   else
-                                     arraymatcherror
-                                     end;
-                                   inc(pind,length(AMPMformatting[2]));
-                                 end;
-                            else  // no AM/PM match. Assume 'a' is simply a char
-                                matchchar(ptrn[pind]);
+                        i:=findimatch(AMPMformatting,@ptrn[pind]);
+                        case i of
+                            0: begin
+                                 if timeval >= 13*hrfactor - EPS then
+                                   raiseexception(SAMPMError);
+                                 i:=findimatch(['AM','PM'],@s[ind]);
+                                 case i of
+                                   0: if timeval >= 12*hrfactor then
+                                        timeval := timeval - 12*hrfactor;
+                                   1: if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                        timeval:=timeval+12*hrfactor;
+                                 else
+                                   arraymatcherror
+                                   end;
+                                 inc(pind,length(AMPMformatting[0]));
+                                 inc(ind,2);
+                               end;
+                            1: begin
+                                 if timeval >= 13*hrfactor - EPS then
+                                   raiseexception(SAMPMError);
+                                  case upcase(s[ind]) of
+                                   'A' : if timeval >= 12*hrfactor then
+                                           timeval := timeval - 12*hrfactor;
+                                   'P' : if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                           timeval := timeval + 12*hrfactor;
+                                 else
+                                   arraymatcherror
+                                   end;
+                                 inc(pind,length(AMPMformatting[1]));
+                                 inc(ind);
+                               end;
+                             2: begin
+                                  if timeval >= 13*hrfactor - EPS then
+                                    raiseexception(SAMPMError);
+                                  i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
+                                  case i of
+                                   0: begin
+                                        if timeval >= 12*hrfactor then
+                                          timeval := timeval - 12*hrfactor;
+                                        inc(ind,length(fmt.timeamstring));
+                                      end;
+                                   1: begin
+                                        if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
+                                          timeval:=timeval + 12*hrfactor;
+                                        inc(ind,length(fmt.timepmstring));
+                                      end;
+                                 else
+                                   arraymatcherror
+                                  end;
+                                 inc(pind,length(AMPMformatting[2]));
+                               end;
+                           else  // no AM/PM match. Assume 'a' is simply a char
+                               matchchar(ptrn[pind]);
                              end;
                          end;
                '/' : matchchar(fmt.dateSeparator);

rtl/objpas/sysconst.pp

@@ -145,6 +145,7 @@ const
   SHHMMError                    = 'mm in a sequence hh:mm is interpreted as minutes. No longer versions allowed! (Position : %d).' ;
   SFullpattern                  = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
   SPatternCharMismatch          = 'Pattern mismatch char "%s" at position %d.';
+  SAMPMError                    = 'Hour >= 13 not allowed in AM/PM mode.';
 
   SShortMonthNameJan = 'Jan';
   SShortMonthNameFeb = 'Feb';

tests/test/units/dateutil/test_scandatetime_ampm.pas

@@ -0,0 +1,106 @@
+program test_scandatetime_ampm;
+{$mode objfpc}
+{$h+}
+uses
+  SysUtils, DateUtils, StrUtils;
+
+Var
+ ErrCount : Integer;
+
+function SameDateTime(dt1, dt2: TDateTime): Boolean;
+const
+  EPS = 1/(24*60*60*100*10);  // 0.1 ms
+begin
+  Result := abs(dt1 - dt2) < EPS;
+end;
+
+procedure Test(AExpected: TDateTime; AFormatStr, ADateTimeStr: String; NeedError : Boolean = False);
+var
+  dt: TDateTime;
+begin
+  Write(PadRight(ADateTimeStr, 36), ' --->   ');
+  Write(PadRight(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', dt), 25));
+  try
+    dt := ScanDateTime(AFormatStr, ADateTimeStr);
+    if dt = AExpected then WriteLn('OK') else 
+     begin
+     Inc(ErrCount);
+     WriteLn('ERROR');
+     end;
+  except on E:Exception do
+    begin
+    if not NeedError then
+      inc(errcount);
+    WriteLn('ERROR: ', E.Message);
+    end;
+  end;
+end;
+
+begin
+  errCount:=0;
+  WriteLn('Using current format settings...');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 am');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 AM');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:01 am');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 am');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 am');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:59 am');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 am');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 12:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 12:00:00.001 pm');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 01:01 pm');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 11:00 pm');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz am/pm', 'April 2nd, 2014, 11:59:59.999 pm');
+
+  WriteLn;
+
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 a');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 A');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:01 a');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 a');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 a');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:59 a');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 a');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 12:00 p');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 12:00:00.001 p');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:00 p');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 01:01 p');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn a/p', 'April 2nd, 2014, 11:00 p');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz a/p', 'April 2nd, 2014, 11:59:59.999 p');
+
+  WriteLn;
+
+  FormatSettings.TimeAMString := 'vorm';
+  FormatSettings.TimePMString := 'nachm';
+  WriteLn('Using modified format settings with ampm=', FormatSettings.TimeAMString, '/', FormatSettings.TimePMString);
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2, 0, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 VORM');
+  Test(EncodeDateTime(2014, 4, 2, 0, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:01 vorm');
+  Test(EncodeDateTime(2014, 4, 2, 1, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11,59, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:59 vorm');
+  Test(EncodeDateTime(2014, 4, 2,11,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 vorm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 12:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,12, 0, 0,  1), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 12:00:00.001 nachm');
+  Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,13, 1, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 01:01 nachm');
+  Test(EncodeDateTime(2014, 4, 2,23, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 2nd, 2014, 11:00 nachm');
+  Test(EncodeDateTime(2014, 4, 2,23,59,59,999), 'mmmm dd??, yyyy, hh:nn:ss.zzz ampm', 'April 2nd, 2014, 11:59:59.999 nachm');
+  Test(EncodeDateTime(2014, 4, 3,12, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn ampm', 'April 3rd, 2014, 12:00 nachm');
+  WriteLn('The next test should raise an exception.');
+
+  try
+    Test(EncodeDateTime(2014, 4, 2,13, 0, 0,  0), 'mmmm dd??, yyyy, hh:nn am/pm', 'April 2nd, 2014, 13:00 pm',True);
+   
+  except on E:Exception do
+    begin
+    WriteLn('OK, exception received: ', E.Message);
+    end;
+  end;
+
+  WriteLn;
+  WriteLn('Test complete. Press RETURN to exit.');
+  Halt(Ord(errcount>0));
+//  ReadLn;
+end.