paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 12:26:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed Inc<Time>() with negative TDateTime values (mantis #27832)

Browse Source 
git-svn-id: trunk@30608 -
This commit is contained in:
Jonas Maebe 2015-04-15 20:46:28 +00:00
parent 77bc87a809
commit e6361c634c
3 changed files with 359 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14392,6 +14392,7 @@ tests/webtbs/tw2778.pp svneol=native#text/plain
tests/webtbs/tw2779.pp svneol=native#text/plain
tests/webtbs/tw2780.pp svneol=native#text/plain
tests/webtbs/tw27811.pp svneol=native#text/plain
tests/webtbs/tw27832.pp svneol=native#text/plain
tests/webtbs/tw2788.pp svneol=native#text/plain
tests/webtbs/tw2789.pp svneol=native#text/plain
tests/webtbs/tw2794.pp svneol=native#text/plain

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

@ -45,10 +45,10 @@ const
DaySunday = 7;
// Fraction of a day
OneHour = 1/HoursPerDay;
OneMinute = 1/MinsPerDay;
OneSecond = 1/SecsPerDay;
OneMillisecond = 1/MSecsPerDay;
OneHour = TDateTime(1)/HoursPerDay;
OneMinute = TDateTime(1)/MinsPerDay;
OneSecond = TDateTime(1)/SecsPerDay;
OneMillisecond = TDateTime(1)/MSecsPerDay;
{ This is actual days per year but you need to know if it's a leap year}
DaysPerYear: array [Boolean] of Word = (365, 366);
@ -1414,15 +1414,44 @@ end;
Increment/decrement functions.
---------------------------------------------------------------------}
{ TDateTime is not defined in the interval [-1.0..0.0[. Additionally, when
negative the time part must be treated using its absolute value (0.25 always
means "6 a.m.") -> skip the gap and convert the time part when crossing the
gap -- and take care of rounding errors }
Procedure MaybeSkipTimeWarp(OldDate: TDateTime; var NewDate: TDateTime);
begin
if (OldDate>0) and (NewDate<0) then
NewDate:=NewDate-0.5
else if (OldDate<-1.0) and (NewDate>-1.0) then
NewDate:=NewDate+0.5;
if (OldDate>=0) and (NewDate<-TDateTimeEpsilon) then
NewDate:=int(NewDate-1.0+TDateTimeEpsilon)-frac(1.0+frac(NewDate))
else if (OldDate<=-1.0) and (NewDate>-1.0+TDateTimeEpsilon) then
NewDate:=int(NewDate+1.0-TDateTimeEpsilon)+frac(1.0-abs(frac(1.0+NewDate)));
end;
function IncNegativeTime(AValue, Addend: TDateTime): TDateTime;
var
newtime: tdatetime;
begin
newtime:=-frac(Avalue)+frac(Addend);
{ handle rounding errors }
if SameValue(newtime,int(newtime)+1,TDateTimeEpsilon) then
newtime:=int(newtime)+1
else if SameValue(newtime,int(newtime),TDateTimeEpsilon) then
newtime:=int(newtime);
{ time underflow -> previous day }
if newtime<-TDateTimeEpsilon then
begin
newtime:=1.0+newtime;
avalue:=int(avalue)-1;
end
{ time overflow -> next day }
else if newtime>=1.0-TDateTimeEpsilon then
begin
newtime:=newtime-1.0;
avalue:=int(avalue)+1;
end;
Result:=int(AValue)+int(Addend)-newtime;
end;
Function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer ): TDateTime;
Var
@ -1470,7 +1499,10 @@ end;
Function IncHour(const AValue: TDateTime; const ANumberOfHours: Int64): TDateTime;
begin
Result:=AValue+ANumberOfHours/HoursPerDay;
if AValue>=0 then
Result:=AValue+ANumberOfHours/HoursPerDay
else
Result:=IncNegativeTime(Avalue,ANumberOfHours/HoursPerDay);
MaybeSkipTimeWarp(AValue,Result);
end;
@ -1483,7 +1515,10 @@ end;
Function IncMinute(const AValue: TDateTime; const ANumberOfMinutes: Int64): TDateTime;
begin
Result:=AValue+ANumberOfMinutes / MinsPerDay;
if AValue>=0 then
Result:=AValue+ANumberOfMinutes/MinsPerDay
else
Result:=IncNegativeTime(Avalue,ANumberOfMinutes/MinsPerDay);
MaybeSkipTimeWarp(AValue,Result);
end;
@ -1496,7 +1531,10 @@ end;
Function IncSecond(const AValue: TDateTime; const ANumberOfSeconds: Int64): TDateTime;
begin
Result:=AValue+ANumberOfSeconds / SecsPerDay;
if AValue>=0 then
Result:=AValue+ANumberOfSeconds/SecsPerDay
else
Result:=IncNegativeTime(Avalue,ANumberOfSeconds/SecsPerDay);
MaybeSkipTimeWarp(AValue,Result);
end;
@ -1509,7 +1547,10 @@ end;
Function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64): TDateTime;
begin
Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay;
if Avalue>=0 then
Result:=AValue+ANumberOfMilliSeconds/MSecsPerDay
else
Result:=IncNegativeTime(Avalue,ANumberOfMilliSeconds/MSecsPerDay);
MaybeSkipTimeWarp(AValue,Result);
end;

305
tests/webtbs/tw27832.pp Normal file
View File

@ -0,0 +1,305 @@
uses
Math,
DateUtils,
SysUtils;
const
dteps = TDateTime(0.5)/(24*60*60*1000);
procedure incday(var d,mo,y: longint; val: longint); overload;
begin
{ only month 12 -> 11 or 1 is supported }
inc(d,val);
if d>=32 then
begin
inc(mo);
dec(d,31);
if mo>=13 then
begin
inc(y);
dec(mo,12);
end;
end
else if d<=0 then
begin
dec(mo);
inc(d,31);
end;
end;
procedure inchour(var d,mo,y,h: longint; val: longint); overload;
begin
inc(h,val);
if h>=24 then
begin
incday(d,mo,y,h div 24);
h:=h mod 24
end
else if h<0 then
begin
incday(d,mo,y,(h-23) div 24);
h:=h mod 24;
if h<>0 then
h:=h+24
end;
end;
procedure incmin(var d,mo,y,h,m: longint; val: longint);
begin
inc(m,val);
if m>=60 then
begin
inchour(d,mo,y,h,m div 60);
m:=m mod 60
end
else if m<0 then
begin
inchour(d,mo,y,h,(m-59) div 60);
m:=m mod 60;
if m<>0 then
m:=m+60;
end;
end;
procedure incsec(var d,mo,y,h,m,s: longint; val: longint);
begin
inc(s,val);
if s>=60 then
begin
incmin(d,mo,y,h,m,s div 60);
s:=s mod 60;
end
else if s<0 then
begin
incmin(d,mo,y,h,m,(s-59) div 60);
s:=s mod 60;
if s<>0 then
s:=s+60;
end;
end;
procedure incmsec(var d,mo,y,h,m,s,mm: longint; val: longint);
begin
inc(mm,val);
if mm>=1000 then
begin
incsec(d,mo,y,h,m,s,mm div 1000);
mm:=mm mod 1000;
end
else if mm<0 then
begin
incsec(d,mo,y,h,m,s,(mm-999) div 1000);
mm:=mm mod 1000;
if mm<>0 then
mm:=mm+1000;
end;
end;
Procedure DoIt(d,mo,y,h,m,s,mm : Word) ;
Var
T : TDateTime;
T2 : TDateTime;
T3 : TDateTime;
error: boolean;
d1, mo1, y1, h1, m1, s1, mm1: longint;
procedure initdatetime;
begin
d1:=d;
mo1:=mo;
y1:=y;
h1:=h;
m1:=m;
s1:=s;
mm1:=mm;
end;
begin
error:=false;
T:=EncodeDateTime(y,mo,d,h,m,s,mm);
{ IncMilliSecond }
initdatetime;
incmsec(d1,mo1,y1,h1,s1,m1,mm1,1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMilliSecond(T);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 1 msec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmsec(d1,mo1,y1,h1,s1,m1,mm1,2*MSecsPerDay);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMilliSecond(T,2*MSecsPerDay);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 1 msec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmsec(d1,mo1,y1,h1,m1,s1,mm1,-1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMilliSecond(T,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 1 msec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmsec(d1,mo1,y1,h1,m1,s1,mm1,-2*MSecsPerDay);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMilliSecond(T,-2*MSecsPerDay);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 2 days -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
{ IncSecond }
initdatetime;
incsec(d1,m1,y1,h1,m1,s1,1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncSecond(T);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 1 sec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incsec(d1,mo1,y1,h1,m1,s1,140);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncSecond(T,140);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 140 sec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incsec(d1,mo1,y1,h1,m1,s1,-1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncSecond(T,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 1 sec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incsec(d1,mo1,y1,h1,m1,s1,-140);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncSecond(T,-140);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 140 sec -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
{ IncMinute }
initdatetime;
incmin(d1,mo1,y1,h1,m1,1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMinute(T);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 1 min -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmin(d1,mo1,y1,h1,m1,200);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMinute(T,200);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 200 min -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmin(d1,mo1,y1,h1,m1,-1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMinute(T,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 1 min -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
incmin(d1,mo1,y1,h1,m1,-2);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncMinute(T3,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 2 min -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
{ IncHour }
initdatetime;
inchour(d1,mo1,y1,h1,1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncHour(T);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 1 hour -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
inchour(d1,mo1,y1,h1,2);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncHour(T3);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' + 2 hours -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
inchour(d1,mo1,y1,h1,-1);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncHour(T,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 1 hour -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
initdatetime;
inchour(d1,mo1,y1,h1,-2);
T2:=EncodeDateTime(y1,mo1,d1,h1,m1,s1,mm1);
T3:=IncHour(T3,-1);
if not samevalue(t2,t3,dteps) then
begin
WriteLn('error: ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T),' - 2 hours -> ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T3),' instead of ',FormatDateTime('yyyy/mm/dd - hh:nn:ss:zzz',T2));
error:=true;
end;
if error then
halt(1);
end;
begin
{ warning: the helpers used by Doit only support month 12 roll-overs (to either
month 1 or month 11) }
Doit(28,12,1899,23,59,59,999);
Doit(28,12,1899,23,59,59,0);
Doit(28,12,1899,23,59,0,0);
Doit(28,12,1899,23,0,0,0);
Doit(29,12,1899,23,59,59,999);
Doit(29,12,1899,23,59,59,0);
Doit(29,12,1899,23,59,0,0);
Doit(29,12,1899,23,0,0,0);
Doit(29,12,1899,0,0,0,0);
Doit(30,12,1899,0,0,0,0);
Doit(30,12,1899,0,0,0,1);
Doit(30,12,1899,0,0,1,0);
Doit(30,12,1899,0,1,0,0);
Doit(30,12,1899,1,0,0,0);
Doit(31,12,1899,0,0,0,1);
Doit(31,12,1899,0,0,1,0);
Doit(31,12,1899,0,1,0,0);
Doit(31,12,1899,1,0,0,0);
end.