QualityCentral

Public Report

Report From: Delphi-BCB/RTL/Delphi/ConvUtils [ Add a report in this area ]

Report #: 103857

Status: Closed

[x64] StrToCurr doesn't give expected result

Project: Delphi

Build #: 16.0.4358.45540

Version: 16.3

Submitted By: sylvain frere

Report Type: Crash / Data loss / Total failure

Date Reported: 3/2/2012 1:12:00 AM

Severity: Serious / Highly visible problem

Last Updated: 9/5/2012 7:57:48 PM

Platform: All versions

Internal Tracking #: 28260

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: None

Description

[x64]
----------
Note:
  Look like the QC#103589, but for currency instead of BCD
----------

First problem (64bits only):
StrToCurr doesn't support full range of currency, exception not a valid floating point number

Second problem (64bits only) :
Converting a currency to string and then back to currency doesn't always give the same value.

//  c1 :=   922337203685477.5807; // failed, not a valid floating point value
//  c1 :=       99999999999.5897; // ok
//  c1 :=      100000000001.5897; // ok
//  c1 :=      999999999999.5897; // failed
//  c1 :=     1000000000001.5897; // failed
//  c1 :=    10000000000001.0000; // ok
//  c1 :=    10000000000001.5897; // failed
//  c1 :=   100000000000000.0000; // ok
//  c1 :=   100000000000000.5807; // failed
//  c1 :=   100000000000001.0000; // failed
//  c1 :=   200000000000000.0000; // ok
//  c1 :=   200000000000001.0000; // failed

Update:

If it could help this an InternalTextToFloat for currency which works :

function InternalTextToFloat(
  ABuffer: PByte;
  const AIsUnicodeBuffer: Boolean;
  var AValue:Currency; //fix
  const AValueType: TFloatValue;
  const AFormatSettings: TFormatSettings): Boolean;
const
{$IFDEF CPUX64}
  CMaxExponent = 1024;
{$ELSE !CPUX64}
  CMaxExponent = 4999;
{$ENDIF !CPUX64}

  CExponent = 'E'; // DO NOT LOCALIZE;
  CPlus = '+';     // DO NOT LOCALIZE;
  CMinus = '-';    // DO NOT LOCALIZE;

var
{$IFDEF CPUX86}
  LSavedCtrlWord: Word;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
  LSavedMXCSR: UInt32;
{$ENDIF CPUX64}
  LPower: Integer;
  LCurrChar: Char;
  LSign: Currency;  //fix
  LDecimales: Currency; //fix

  procedure NextChar;
  begin
    if AIsUnicodeBuffer then
    begin
      LCurrChar := PWideChar(ABuffer)^;
      Inc(PWideChar(ABuffer));
    end else
    begin
      LCurrChar := Char(PAnsiChar(ABuffer)^);
      Inc(PAnsiChar(ABuffer));
    end;
  end;

  procedure SkipWhitespace();
  begin
    { Skip white spaces }
    while LCurrChar = ' ' do
      NextChar;
  end;

  function ReadSign(): SmallInt;
  begin
    Result := 1;
    if LCurrChar = CPlus then
      NextChar()
    else if LCurrChar = CMinus then
    begin
      NextChar();
      Result := -1;
    end;
  end;

  function ReadNumber(var AOut: Currency): Integer;
  var c10:Currency;
  begin
    c10 := 10;
    Result := 0;
    while CharInSet(LCurrChar, ['0'..'9']) do
    begin
      AOut := AOut * c10;
      AOut := AOut + Ord(LCurrChar) - Ord('0');

      NextChar();
      Inc(Result);
    end;
  end;

  function ReadExponent: SmallInt;
  var
    LSign: SmallInt;
  begin
    LSign := ReadSign();
    Result := 0;
    while CharInSet(LCurrChar, ['0'..'9']) do
    begin
      Result := Result * 10;
      Result := Result + Ord(LCurrChar) - Ord('0');
      NextChar();
    end;

    if Result > CMaxExponent then
      Result := CMaxExponent;

    Result := Result * LSign;
  end;

  function Power10Curr(value:Currency; power:Integer):Currency; //fix
  var c10:Currency;
  begin
    c10 := 10;
    Result := value;
    while power>0 do
     begin
       Result := Result / c10;
       dec(power);
     end;
  end;

begin
  { Prepare }
  Result := False;
  NextChar();

{$IFDEF CPUX86}
  { Prepare the FPU }
  LSavedCtrlWord := Get8087CW();
  TestAndClearFPUExceptions(0);
  Set8087CW(CWNear);
{$ENDIF CPUX86}
{$IFDEF CPUX64}
  { Prepare the FPU }
  LSavedMXCSR := GetMXCSR;
  TestAndClearSSEExceptions(0);
  SetMXCSR(MXCSRNear);
{$ENDIF CPUX64}

  { Skip white spaces }
  SkipWhitespace();

  { Exit if nothing to do }
  if LCurrChar <> #0 then
  begin
    { Detect the sign of the number }
    LSign := ReadSign();
    if LCurrChar <> #0 then
    begin
      { De result }
      AValue := 0;

      { Read the integer and fractionary parts }
      ReadNumber(AValue);
      LDecimales := 0; //fix
      if LCurrChar = AFormatSettings.DecimalSeparator then
      begin
        NextChar();
        LPower := ReadNumber(LDecimales); //fix
      end
      else LPower := 0;

      { Read the exponent and adjust the power }
      if Char(Word(LCurrChar) and $FFDF) = CExponent then
      begin
        NextChar();
        Inc(LPower, ReadExponent());
      end;

      { Skip white spaces }
      SkipWhitespace();

      { Continue only if the buffer is depleted }
      if LCurrChar = #0 then
      begin
        { Calculate the final number }
        AValue := LSign * (AValue + Power10Curr(LDecimales,LPower)); //fix

{$IFDEF CPUX86}
        { Final check that everything went OK }
        Result := TestAndClearFPUExceptions(mIE + mOE);
{$ENDIF CPUX86}
{$IFDEF CPUX64}
        { Final check that everything went OK }
        Result := TestAndClearSSEExceptions(mIE + mOE);
{$ENDIF CPUX64}
      end;
    end;
  end;

  { Clear Math Exceptions }
{$IFDEF CPUX86}
  Set8087CW(LSavedCtrlWord);
{$ENDIF CPUX86}
{$IFDEF CPUX64}
  SetMXCSR(LSavedMXCSR);
{$ENDIF CPUX64}
end;

Steps to Reproduce:

Run this unit test code :

procedure TTest_datatypes.Test_currency_max;
var
  c1, c2: Currency;
  ss: string;
  fs: TFormatSettings;
begin
  fs.ThousandSeparator := #0;
  fs.DecimalSeparator := '.';
  c1 :=   922337203685477.5807; // failed, not a valid floating point value
//  c1 :=       99999999999.5897; // ok
//  c1 :=      100000000001.5897; // ok
//  c1 :=      999999999999.5897; // failed
//  c1 :=     1000000000001.5897; // failed
//  c1 :=    10000000000001.0000; // ok
//  c1 :=    10000000000001.5897; // failed
//  c1 :=   100000000000000.0000; // ok
//  c1 :=   100000000000000.5807; // failed
//  c1 :=   100000000000001.0000; // failed
//  c1 :=   200000000000000.0000; // ok
//  c1 :=   200000000000001.0000; // failed
  ss := CurrToStr(c1,fs);
  c2 := StrToCurr(ss,fs);
  Check(c1=c2,Format('value mismatch %n<>%n',[c1,c2]));
end;

Workarounds

None

Attachment

None

Comments

Tomohiro Takahashi at 5/17/2012 7:35:57 PM -

This report was opened with valid Internal Tracking Number.
Thanks.

Developer Tools

Database Tools