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

* Fix issue ID #38462

Browse Source 
git-svn-id: trunk@48580 -
This commit is contained in:
michael 2021-02-10 11:00:22 +00:00
parent ecce39a3b2
commit 47be45830c
4 changed files with 163 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

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

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

1
rtl/objpas/sysconst.pp
View File

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

106
tests/test/units/dateutil/test_scandatetime_ampm.pas Normal file
View File

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