All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0022107FPCRTLpublic2012-05-23 12:132017-02-22 23:02
ReporterVojtech CihakAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Platformamd64OSLinuxOS Version
Product Version2.5.1Product Build21251 
Target Version3.2.0Fixed in Version3.1.1 
Summary0022107: CompareDateTime gives bad result for negative values
DescriptionFunction 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 Reproduceprogram 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.
TagsNo tags attached.
Fixed in Revision35467
FPCOldBugId
FPCTarget
Attached Files
  • 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;
    comparedatetime.diff (676 bytes)

Activities

2012-05-23 12:16

 

CompareDateTime.zip (4,920 bytes)

Bart Broersma

2017-02-05 12:55

reporter  

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;
comparedatetime.diff (676 bytes)

Bart Broersma

2017-02-05 12:56

reporter   ~0097985

Patch attached.

Michael Van Canneyt

2017-02-22 20:51

administrator   ~0098382

Fixed. Strange that this bugreport went unnoticed so long :(

Issue History

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