View Issue Details

IDProjectCategoryView StatusLast Update
0029037FPCRTLpublic2016-03-30 11:45
ReporterLacaKAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version2.6.4Product Build 
Target Version3.1.1Fixed in Version3.0.2 
Summary0029037: StrToCurr('-922337203685477.5808') raises exception for lowest currency value on Win64
DescriptionWhile valid range for currency data type is from -922337203685477.5808 to +922337203685477.5807,
StrToCurr supports only range -922337203685477.5807 to +922337203685477.5807

As StrToCurr calls fpc_Val_Currency_ShortStr() in rtl/inc/sstrings.inc bug is also in:
  var c: currency;
      e: integer;
  begin
    Val('-922337203685477.5808', c, e);
  end;

Additional InformationNote that on Win32 it works, while fpc_Val_real_shortstr() is called (not fpc_Val_Currency_ShortStr()).

In Delphi7 StrToCurr('-922337203685477.5808') works and returns correct value.
TagsNo tags attached.
Fixed in Revision33339
FPCOldBugId0
FPCTarget
Attached Files
  • sstrings.inc.diff (2,608 bytes)
    --- sstrings.inc.ori	Tue Dec 22 12:40:20 2015
    +++ sstrings.inc	Tue Dec 22 14:01:55 2015
    @@ -1983,9 +1983,8 @@
     end;
     {$else EXCLUDE_COMPLEX_PROCS}
     const
    -  MaxInt64 : Int64  = $7FFFFFFFFFFFFFFF;
    -  Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10;
    -  Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10;
    +  MinInt64 : Int64  =-$8000000000000000;
    +  MinInt64Edge : Int64 = (-$8000000000000000 + 10) div 10;
     var
       { to enable taking the address on the JVM target }
       res : array[0..0] of Int64;
    @@ -1996,7 +1995,7 @@
       res[0]:=0;
       len:=Length(s);
       Code:=1;
    -  sign:=1;
    +  sign:=-1;
       power:=0;
       while True do
         if Code > len then
    @@ -2008,10 +2007,12 @@
             break;
       { Read sign }
       case s[Code] of
    -   '+' : Inc(Code);
    +   '+' : begin
    +           Inc(Code);
    +         end;
        '-' : begin
    -           sign:=-1;
    -           inc(code);
    +           sign:=+1;
    +           Inc(Code);
              end;
       end;
       { Read digits }
    @@ -2024,9 +2025,9 @@
               begin
                 j:=Ord(s[code])-Ord('0');
                 { check overflow }
    -            if (res[0] <= Int64Edge) or (res[0] <= (MaxInt64 - j) div 10) then
    +            if (res[0] >= MinInt64Edge) or (res[0] >= (MinInt64 + j) div 10) then
                   begin
    -                res[0]:=res[0]*10 + j;
    +                res[0]:=res[0]*10 - j;
                     Inc(i);
                   end
                 else
    @@ -2035,9 +2036,9 @@
                     exit
                   else
                     begin
    -                  if not FracOverflow and (j >= 5) and (res[0] < MaxInt64) then
    +                  if not FracOverflow and (j >= 5) and (res[0] > MinInt64) then
                         { round if first digit of fractional part overflow }
    -                    Inc(res[0]);
    +                    Dec(res[0]);
                       FracOverflow:=True;
                     end;
               end;
    @@ -2098,7 +2099,7 @@
       if power > 0 then
         begin
           for i:=1 to power do
    -        if res[0] <= Int64Edge2 then
    +        if res[0] >= MinInt64 div 10 then
               res[0]:=res[0]*10
             else
               exit;
    @@ -2106,11 +2107,17 @@
       else
         for i:=1 to -power do
           begin
    -        if res[0] <= MaxInt64 - 5 then
    -          Inc(res[0], 5);
    +        if res[0] >= MinInt64 + 5 then
    +          Dec(res[0], 5);
             res[0]:=res[0] div 10;
           end;
    -  res[0]:=res[0]*sign;
    +
    +  if sign <> 1 then
    +    if res[0] > MinInt64 then
    +      res[0]:=res[0]*sign
    +    else
    +      exit;
    +
       fpc_Val_Currency_ShortStr:=PCurrency(@res[0])^;
       Code:=0;
     end;
    
    sstrings.inc.diff (2,608 bytes)
  • bug29037.lpr (262 bytes)

Relationships

related to 0028737 closedMichael Van Canneyt SysUtils.MinCurrency has invalid value 

Activities

LacaK

2015-11-19 10:25

developer   ~0087398

Last edited: 2015-11-19 10:26

View 2 revisions

IMO this is not duplicate of 0028737 as 0028737 says about constant MinCurrency, but this report says mainly about Val() procedure.
(And MinCurrency constant does not play role in Val() procedure)

LacaK

2015-12-22 14:07

developer  

sstrings.inc.diff (2,608 bytes)
--- sstrings.inc.ori	Tue Dec 22 12:40:20 2015
+++ sstrings.inc	Tue Dec 22 14:01:55 2015
@@ -1983,9 +1983,8 @@
 end;
 {$else EXCLUDE_COMPLEX_PROCS}
 const
-  MaxInt64 : Int64  = $7FFFFFFFFFFFFFFF;
-  Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10;
-  Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10;
+  MinInt64 : Int64  =-$8000000000000000;
+  MinInt64Edge : Int64 = (-$8000000000000000 + 10) div 10;
 var
   { to enable taking the address on the JVM target }
   res : array[0..0] of Int64;
@@ -1996,7 +1995,7 @@
   res[0]:=0;
   len:=Length(s);
   Code:=1;
-  sign:=1;
+  sign:=-1;
   power:=0;
   while True do
     if Code > len then
@@ -2008,10 +2007,12 @@
         break;
   { Read sign }
   case s[Code] of
-   '+' : Inc(Code);
+   '+' : begin
+           Inc(Code);
+         end;
    '-' : begin
-           sign:=-1;
-           inc(code);
+           sign:=+1;
+           Inc(Code);
          end;
   end;
   { Read digits }
@@ -2024,9 +2025,9 @@
           begin
             j:=Ord(s[code])-Ord('0');
             { check overflow }
-            if (res[0] <= Int64Edge) or (res[0] <= (MaxInt64 - j) div 10) then
+            if (res[0] >= MinInt64Edge) or (res[0] >= (MinInt64 + j) div 10) then
               begin
-                res[0]:=res[0]*10 + j;
+                res[0]:=res[0]*10 - j;
                 Inc(i);
               end
             else
@@ -2035,9 +2036,9 @@
                 exit
               else
                 begin
-                  if not FracOverflow and (j >= 5) and (res[0] < MaxInt64) then
+                  if not FracOverflow and (j >= 5) and (res[0] > MinInt64) then
                     { round if first digit of fractional part overflow }
-                    Inc(res[0]);
+                    Dec(res[0]);
                   FracOverflow:=True;
                 end;
           end;
@@ -2098,7 +2099,7 @@
   if power > 0 then
     begin
       for i:=1 to power do
-        if res[0] <= Int64Edge2 then
+        if res[0] >= MinInt64 div 10 then
           res[0]:=res[0]*10
         else
           exit;
@@ -2106,11 +2107,17 @@
   else
     for i:=1 to -power do
       begin
-        if res[0] <= MaxInt64 - 5 then
-          Inc(res[0], 5);
+        if res[0] >= MinInt64 + 5 then
+          Dec(res[0], 5);
         res[0]:=res[0] div 10;
       end;
-  res[0]:=res[0]*sign;
+
+  if sign <> 1 then
+    if res[0] > MinInt64 then
+      res[0]:=res[0]*sign
+    else
+      exit;
+
   fpc_Val_Currency_ShortStr:=PCurrency(@res[0])^;
   Code:=0;
 end;
sstrings.inc.diff (2,608 bytes)

LacaK

2015-12-22 14:10

developer   ~0088170

Possible patch attached.
Instead of addition uses subtraction, which enables minimal int64 value = -922337203685477.5808.
(In case of addition we end at maximal int64 value = 922337203685477.5807)
Please let me know if this patch is acceptable
(I did only basic testing)

Michael Van Canneyt

2015-12-26 16:25

administrator   ~0088275

I tested your sample program on Linux 64 bit, but it works fine, even without patch in 3.0.0.

LacaK

2015-12-27 19:36

developer  

bug29037.lpr (262 bytes)

LacaK

2015-12-27 19:40

developer   ~0088326

When you debug attached program (on 64bit Linux), what complier procedure is called ?
 fpc_val_real_ansistr -> fpc_val_real_shortstr ? (as is case of Win32, where result is correct) ?
or
 fpc_Val_Currency_ShortStr (as is case of Win64, where result is incorrect)

Michael Van Canneyt

2015-12-27 19:56

administrator   ~0088328

it calls val_real_x, I am consulting with the rest of the team.
I'll need to debug this on a win64 system.

Thaddy de Koning

2016-03-24 10:07

reporter   ~0091330

Last edited: 2016-03-24 10:14

View 3 revisions

I tested win64/ppcx64 from today's trunk:


C:\Kol64>ppcx64 bug29037.lpr

C:\Kol64>bug29037
c= 0.000000000000000000E+00 e=22

Delphi XE2:
C:\Kol64>dcc64 -Aclasses=system.classes bug29037.dpr
Embarcadero Delphi for Win64 compiler version 23.0
Copyright (c) 1983,2011 Embarcadero Technologies, Inc.
bug29037.dpr(21)
22 lines, 0.88 seconds, 447344 bytes code, 86428 bytes data.

C:\Kol64>bug29037
c=-9.22337203685478E+0014 e=0

Michael Van Canneyt

2016-03-27 00:55

administrator   ~0091452

Tested on 3 platforms (i386, x64 windows and linux), all checked out fine.

Thank you for the patch.

Issue History

Date Modified Username Field Change
2015-11-19 08:03 LacaK New Issue
2015-11-19 08:32 Jonas Maebe Relationship added duplicate of 0028737
2015-11-19 08:32 Jonas Maebe Status new => resolved
2015-11-19 08:32 Jonas Maebe Resolution open => duplicate
2015-11-19 08:32 Jonas Maebe Assigned To => Jonas Maebe
2015-11-19 10:25 LacaK Note Added: 0087398
2015-11-19 10:25 LacaK Status resolved => feedback
2015-11-19 10:25 LacaK Resolution duplicate => reopened
2015-11-19 10:26 LacaK Note Edited: 0087398 View Revisions
2015-11-19 15:46 Jonas Maebe Assigned To Jonas Maebe =>
2015-11-19 15:46 Jonas Maebe Status feedback => new
2015-11-19 15:47 Jonas Maebe Relationship replaced related to 0028737
2015-12-22 14:07 LacaK File Added: sstrings.inc.diff
2015-12-22 14:10 LacaK Note Added: 0088170
2015-12-26 16:25 Michael Van Canneyt Note Added: 0088275
2015-12-27 19:36 LacaK File Added: bug29037.lpr
2015-12-27 19:40 LacaK Note Added: 0088326
2015-12-27 19:56 Michael Van Canneyt Note Added: 0088328
2016-03-24 08:22 Michael Van Canneyt Assigned To => Michael Van Canneyt
2016-03-24 08:22 Michael Van Canneyt Status new => assigned
2016-03-24 10:07 Thaddy de Koning Note Added: 0091330
2016-03-24 10:09 Thaddy de Koning Note Edited: 0091330 View Revisions
2016-03-24 10:14 Thaddy de Koning Note Edited: 0091330 View Revisions
2016-03-27 00:55 Michael Van Canneyt Fixed in Revision => 33339
2016-03-27 00:55 Michael Van Canneyt Note Added: 0091452
2016-03-27 00:55 Michael Van Canneyt Status assigned => resolved
2016-03-27 00:55 Michael Van Canneyt Fixed in Version => 3.0.2
2016-03-27 00:55 Michael Van Canneyt Resolution reopened => fixed
2016-03-27 00:55 Michael Van Canneyt Target Version => 3.1.1
2016-03-30 11:45 LacaK Status resolved => closed