Watch, Follow, &
Connect with Us
Public Report
Report From: Delphi-BCB/RTL/Delphi/Date - Time    [ Add a report in this area ]  
Report #:  104458   Status: Closed
[Regression in XE2] Date/time routines raise the EInvalidOp exception if a large negative value is passed as a routine parameter
Project:  Delphi Build #:  16.0.4429.46931
Version:    16.4 Submitted By:   Sergey Mogilnikov
Report Type:  Basic functionality failure Date Reported:  3/27/2012 6:14:41 AM
Severity:    Commonly encountered problem Last Updated: 9/5/2012 7:55:54 PM
Platform:    All platforms Internal Tracking #:   26931
Resolution: Fixed (Resolution Comments) Resolved in Build: : 17.0.4625.53395
Duplicate of:  None
Voting and Rating
Overall Rating: No Ratings Yet
0.00 out of 5
Total Votes: 5
Description
We have found a severe bug in RAD Studio XE2 (reproducible both with the initial release and Update 4) that relates to handling large negative date/time values in date-time routines.

Previously, all IDEs worked just fine with our constant NullDate = -700000. Now, XE2 raises the EInvalidOp exception if this constant value is passed as a parameter to date/time routines.

The exception is raised by the TimeStamp validation introduced by XE2 to the SysUtils.DateTimeToTimeStamp function. We think that only the TimeStampToXXX functions require this validation, because they accept TTimeStamp values as parameters.
Adding the validation to functions with TDateTime parameters is not necessary and must be removed.
We cannot redefine the NullDate constant to the 1/1/1 value in our code to work the problem around, because old NullDate values stored with previous versions of our components to streams, files, and data stores will not work with the new constant value.

We hope that you fix this irritating issue ASAP!

By the way, we examined your code and found that the "ASM" and "PUREPASCAL" implementations do not match. The "PUREPASCAL" implementation does not have a ValidateTimeStamp method call. In 64 and 32 bit mode functions work differently.



{ USc: The behavior in XE2 is the result of the intentional change in RAID #281569, but the docs of System.SysUtils.DecodeDateFully and .DecodeDate do say

"If the given TDateTime value has a negative (BC) year, the year, month, and day return parameters are all set to zero."

and that clearly indicates the implementation of DecodeDateFully

  T := DateTimeToTimeStamp(DateTime).Date;
  if T <= 0 then
  begin
    Year := 0;
    Month := 0;
    Day := 0;
    DOW := 0;
    Result := False;
  end else

So this is clearly REGRESSION

(Without trying) the fix for the issue in DecodeDateFully could be

  if DateTime <= -693594 then
    T := 0
  else
    T := DateTimeToTimeStamp(DateTime).Date;
  if T <= 0 then

For DecodeTime a way to fix it could be using System.Frac of the provided DateTime value }
Steps to Reproduce:
By USc:
- save to following program
- dcc QC104458.dpr
- execute QC104458

expected: output is PASS
actual: output is
FAIL #1 - EInvalidOp/Invalid floating point operation
FAIL #2 - EInvalidOp/Invalid floating point operation
FAIL

program QC104458;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  Counter: Integer = 0;

procedure TestDecodeDate(const DateTime: TDateTime; AExpectedY, AExpectedM,
  AExpectedD: Word; ATest: Integer);
var
  ActualY, ActualM, ActualD, Dummy1, Dummy2, Dummy3, Dummy4: Word;
begin
  try
    DecodeDate(DateTime, ActualY, ActualM, ActualD);
    { DecodeTime here makes sure that System.DateUtils.DecodeDateTime works too,
      but the actual result is the same without this call too DecodeTime}
    DecodeTime(DateTime, Dummy1, Dummy2, Dummy3, Dummy4);
    if (ActualY = AExpectedY) and (ActualM = AExpectedM) and (ActualD = AExpectedD) then
      Inc(Counter)
    else
    begin
      WriteLn('FAIL #', ATest);
      WriteLn('  Expected: ', AExpectedY, '-', AExpectedM, '-', AExpectedD);
      WriteLn('  Actual:   ', ActualY, '-', ActualM, '-', ActualD);
    end;
  except
    on E: EInvalidOp do
      WriteLn('FAIL #', ATest,' - ', E.ClassName, '/', E.Message)
    else
      raise;
  end;
end;

const
  FirstNull = -693594;
  TripleOne = FirstNull + 1;
  NullDateReporter = -700000;
begin
  try
    TestDecodeDate(NullDateReporter, 0, 0, 0, 1);
    TestDecodeDate(FirstNull, 0, 0, 0, 2);
    TestDecodeDate(TripleOne, 1, 1, 1, 3);
    TestDecodeDate(0, 1899, 12, 30, 4);
    TestDecodeDate(36526, 2000, 1, 1, 5);
    if Counter = 5 then
      WriteLn('PASS')
    else
      WriteLn('FAIL');
  except
    on E: Exception do
    begin
      Writeln('FAIL - Exception Error');
      WriteLn('  ClassName=', E.ClassName);
      WriteLn('    Message=', E.Message);
    end;
  end;
end.





Original steps:
procedure TForm20.FormCreate(Sender: TObject);
var
  Y, M, D: Word;
const
  NullDate = -700000;
begin
  DecodeDate(NullDate, Y, M, D);
end;


Added by Sysop
<<<<<<<
Please see also [Workaround] of QC.
>>>>>>>
Workarounds
unit SysUtils;

function DateTimeToTimeStamp(DateTime: TDateTime): TTimeStamp;
{$IFDEF PUREPASCAL}
var
  LTemp, LTemp2: Int64;
begin
  LTemp := Round(DateTime * FMSecsPerDay);
  LTemp2 := (LTemp div IMSecsPerDay);
  Result.Date := DateDelta + LTemp2;
  Result.Time := Abs(LTemp) mod IMSecsPerDay;
end;
{$ELSE !PUREPASCAL}
{$IFDEF X86ASM}
asm
        PUSH    EBX
{$IFDEF PIC}
        PUSH    EAX
        CALL    GetGOT
        MOV     EBX,EAX
        POP     EAX
{$ELSE !PIC}
        XOR     EBX,EBX
{$ENDIF !PIC}
        MOV     ECX,EAX
        FLD     DateTime
        FMUL    [EBX].FMSecsPerDay
        SUB     ESP,8
        FISTP   QWORD PTR [ESP]
        FWAIT
        POP     EAX
        POP     EDX
        OR      EDX,EDX
        JNS     @@1
        NEG     EDX
        NEG     EAX
        SBB     EDX,0
        DIV     [EBX].IMSecsPerDay
        NEG     EAX
        JMP     @@2
@@1:    DIV     [EBX].IMSecsPerDay
@@2:    ADD     EAX,DateDelta
        MOV     [ECX].TTimeStamp.Time,EDX
        MOV     [ECX].TTimeStamp.Date,EAX
// #281569 [vk]
        PUSH    EAX

>> </DevExpress Remove following validation:  

        CALL    ValidateTimeStampDate

>> DevExpress />

        POP     EAX
//
        POP     EBX
end;
{$ENDIF X86ASM}
{$ENDIF !PUREPASCAL}
Attachment
None
Comments

Tomohiro Takahashi at 4/3/2012 7:29:29 PM -
This report was opened with valid Internal Tracking Number.
Thanks.

Server Response from: ETNACODE01