View Issue Details
ID | Project | Category | View Status | Date Submitted | Last Update |
---|---|---|---|---|---|
0022107 | FPC | RTL | public | 2012-05-23 12:13 | 2017-02-22 23:02 |
Reporter | Vojtech Cihak | Assigned To | Michael Van Canneyt | ||
Priority | normal | Severity | minor | Reproducibility | always |
Status | resolved | Resolution | fixed | ||
Platform | amd64 | OS | Linux | OS Version | |
Product Version | 2.5.1 | Product Build | 21251 | ||
Target Version | 3.2.0 | Fixed in Version | 3.1.1 | ||
Summary | 0022107: CompareDateTime gives bad result for negative values | ||||
Description | Function CompareDateTime(const A, B: TDateTime): TValueRelationship; from dateutils gives bad results for negative dates (the same day but another time). Please see: http://www.lazarus.freepascal.org/index.php/topic,17039.msg93480/topicseen.html#new There is some analysis and patch from another user. | ||||
Steps To Reproduce | program Project1; {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, clocale, math, dateutils, sysutils; var a,b :TDateTime; R: TValueRelationship; begin a := EncodeDateTime (1899,3,5,22,1,1,1); b := EncodeDateTime (1899,3,5,23,1,1,1); WriteLn('a '+floattostr(a)); WriteLn('b '+floattostr(b)); R:= CompareDateTime(a,b); if r=-1 then WriteLn (DateTimeToSTr (a) + ' is less than '+DateTimeToSTr (b)); if r=1 then WriteLn (DateTimeToSTr (a) + ' is greater than '+DateTimeToSTr (b)); end. | ||||
Tags | No tags attached. | ||||
Fixed in Revision | 35467 | ||||
FPCOldBugId | |||||
FPCTarget | |||||
Attached Files |
|
2012-05-23 12:16
|
CompareDateTime.zip (4,920 bytes) |
|
comparedatetime.diff (676 bytes)
Index: packages/rtl-objpas/src/inc/dateutil.inc =================================================================== --- packages/rtl-objpas/src/inc/dateutil.inc (revision 35221) +++ packages/rtl-objpas/src/inc/dateutil.inc (working copy) @@ -1915,10 +1915,14 @@ begin If SameDateTime(A,B) then Result:=EqualsValue - else If A>B then - Result:=GreaterThanValue - else - Result:=LessThanValue + else if trunc(a)=trunc(b) then + begin + if abs(frac(a)) > abs(frac(b)) then result := GreaterThanValue + else result := LessThanValue; + end else begin + if a > b then result := GreaterThanValue + else result := LessThanValue; + end; end; |
|
Patch attached. |
|
Fixed. Strange that this bugreport went unnoticed so long :( |
Date Modified | Username | Field | Change |
---|---|---|---|
2012-05-23 12:13 | Vojtech Cihak | New Issue | |
2012-05-23 12:16 | Vojtech Cihak | File Added: CompareDateTime.zip | |
2017-02-05 12:55 | Bart Broersma | File Added: comparedatetime.diff | |
2017-02-05 12:56 | Bart Broersma | Note Added: 0097985 | |
2017-02-05 16:41 | Michael Van Canneyt | Assigned To | => Michael Van Canneyt |
2017-02-05 16:41 | Michael Van Canneyt | Status | new => assigned |
2017-02-22 20:51 | Michael Van Canneyt | Fixed in Revision | => 35467 |
2017-02-22 20:51 | Michael Van Canneyt | Note Added: 0098382 | |
2017-02-22 20:51 | Michael Van Canneyt | Status | assigned => resolved |
2017-02-22 20:51 | Michael Van Canneyt | Fixed in Version | => 3.1.1 |
2017-02-22 20:51 | Michael Van Canneyt | Resolution | open => fixed |
2017-02-22 20:51 | Michael Van Canneyt | Target Version | => 3.2.0 |