paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 00:09:26 +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/cpu/tcpu1.pp svneol=native#text/pascal
tests/test/units/crt/tcrt.pp svneol=native#text/plain tests/test/units/crt/tcrt.pp svneol=native#text/plain
tests/test/units/crt/tctrlc.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/testscandatetime.pas 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

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

@ -2379,6 +2379,8 @@ begin
end; end;
function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime; function scandatetime(const pattern:string;const s:string;const fmt:TFormatSettings;startpos:integer=1) : tdatetime;
const
EPS = 1E-15;
var len ,ind : integer; var len ,ind : integer;
yy,mm,dd : integer; yy,mm,dd : integer;
@ -2558,44 +2560,59 @@ begin
end; end;
end; end;
'A' : begin 'A' : begin
i:=findimatch(AMPMformatting,@ptrn[pind]); i:=findimatch(AMPMformatting,@ptrn[pind]);
case i of case i of
0: begin 0: begin
i:=findimatch(['AM','PM'],@s[ind]); if timeval >= 13*hrfactor - EPS then
case i of raiseexception(SAMPMError);
0: ; i:=findimatch(['AM','PM'],@s[ind]);
1: timeval:=timeval+12*hrfactor; case i of
else 0: if timeval >= 12*hrfactor then
arraymatcherror timeval := timeval - 12*hrfactor;
end; 1: if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
inc(pind,length(AMPMformatting[0])); timeval:=timeval+12*hrfactor;
inc(ind,2); else
end; arraymatcherror
1: begin end;
case upcase(s[ind]) of inc(pind,length(AMPMformatting[0]));
'A' : ; inc(ind,2);
'P' : timeval:=timeval+12*hrfactor; end;
else 1: begin
arraymatcherror if timeval >= 13*hrfactor - EPS then
end; raiseexception(SAMPMError);
inc(pind,length(AMPMformatting[1])); case upcase(s[ind]) of
inc(ind); 'A' : if timeval >= 12*hrfactor then
end; timeval := timeval - 12*hrfactor;
2: begin 'P' : if (timeval + EPS >= hrfactor) and (timeval + EPS <= 12*hrfactor) then
i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]); timeval := timeval + 12*hrfactor;
case i of else
0: inc(ind,length(fmt.timeamstring)); arraymatcherror
1: begin end;
timeval:=timeval+12*hrfactor; inc(pind,length(AMPMformatting[1]));
inc(ind,length(fmt.timepmstring)); inc(ind);
end; end;
else 2: begin
arraymatcherror if timeval >= 13*hrfactor - EPS then
end; raiseexception(SAMPMError);
inc(pind,length(AMPMformatting[2])); i:=findimatch([fmt.timeamstring,fmt.timepmstring],@s[ind]);
end; case i of
else // no AM/PM match. Assume 'a' is simply a char 0: begin
matchchar(ptrn[pind]); 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;
end; end;
'/' : matchchar(fmt.dateSeparator); '/' : 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).' ; 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.'; SFullpattern = 'Couldn''t match entire pattern string. Input too short at pattern position %d.';
SPatternCharMismatch = 'Pattern mismatch char "%s" at position %d.'; SPatternCharMismatch = 'Pattern mismatch char "%s" at position %d.';
SAMPMError = 'Hour >= 13 not allowed in AM/PM mode.';
SShortMonthNameJan = 'Jan'; SShortMonthNameJan = 'Jan';
SShortMonthNameFeb = 'Feb'; 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.