View Issue Details

IDProjectCategoryView StatusLast Update
0033795FPCRTLpublic2018-06-09 18:44
ReporterBart BroersmaAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindowsOS Version10
Product Version3.1.1Product Buildr37885 
Target Version3.2.0Fixed in Version3.1.1 
Summary0033795: ERangeError in BCDDivide
DescriptionUnexpected ERangeError can occur in BCDDivide
See testprogram below, it fails on 7,14,21,26,27,28,34,35,37,38, 41,42, 51,52,53,54,56,57,61,63,65,68,70 and 6615.
Steps To Reproduceprogram bcd;
{$mode objfpc}

uses
  sysutils, fmtbcd;

type
  TIntArray = array of Integer;

var
  B,D,R:TBCD;
  S:String;
  Test: TIntArray;
  N: Integer;
begin
  Test := TIntArray.Create(1,6,7,8,13,14,15,21,22,25,26,27,28,29,33,34,35,36,37,38,39,40,41,42,
                           43,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,
                           6615);
  //failed numbers I've found so far.
  //6615(original)7,14,21,26,27,28,34,35,37,38, 41,42, 51,52,53,54,56,57,61,63,65,68,70
  R := StrToBCD('0.0'); //Just to make sure.
  B := StrToBCD('224518.0639999999994919');
  for N in Test do
  begin
    D := IntegerToBCD(N);
    try
      BCDDivide(B,D,R);
      S := BCDtoStr(R);
      writeln(N,' -> ',S);
    except
      on E: ERangeError do writeln(N,' -> ERangeError');
    end;
  end;
end.
Additional InformationOriginally reported in the forum: http://forum.lazarus.freepascal.org/index.php/topic,41379.0.html
TagsFmtBCD
Fixed in Revision39161
FPCOldBugId
FPCTarget
Attached Files
  • unpack_BCD.patch (456 bytes)
    Index: fmtbcd.pp
    ===================================================================
    --- fmtbcd.pp	(revision 39123)
    +++ fmtbcd.pp	(working copy)
    @@ -1022,7 +1022,7 @@
     
         var
           i : {$ifopt r+} __lo_bh + 1 ..__hi_bh {$else} Integer {$endif};
    -      j : {$ifopt r+} -1..__high_fraction {$else} Integer {$endif};
    +      j : {$ifopt r+} -1..__hi_bh {$else} Integer {$endif};
           vv : {$ifopt r+} $00..$99 {$else} Integer {$endif};
     
         begin
    
    unpack_BCD.patch (456 bytes)
  • fmtbcd.pp.diff (789 bytes)
    --- fmtbcd.pp.ori	Thu May 26 15:37:58 2016
    +++ fmtbcd.pp	Tue May 29 08:19:06 2018
    @@ -1042,15 +1042,15 @@
     {$endif}
                   LDig := Plac;
                   FDig := LDig - Prec + 1;
    -              j := 0;
    +              j := -1;
                   i := FDig;
                   while i <= LDig do
                     begin
    -                  vv := Fraction[j];
    -                  Singles[i] := ( vv {AND $f0} ) SHR 4;
    -                  if i < LDig
    -                    then Singles[i+1] := vv AND $0f;
                       Inc ( j );
    +                  vv := Fraction[j];
    +                  Singles[i] :=  vv SHR 4;
    +                  if i < LDig then
    +                    Singles[i+1] := vv AND $0f;
                       Inc ( i, 2 );
                     end;
                  end;
    
    fmtbcd.pp.diff (789 bytes)
  • tfmtbcd.pp.diff (452 bytes)
    --- tfmtbcd.pp.ori	Tue Dec 22 15:17:49 2015
    +++ tfmtbcd.pp	Tue May 29 08:30:22 2018
    @@ -293,6 +293,8 @@
       testBCDDivide(100, -2, -50);
       testBCDDivide(1007, 5, 201.4);
     
    +  testBCDDivide(StrToBCD('224518.0639999999994919',FS), IntegerToBCD(6615), StrToBCD('33.94075041572184421646258503401360544217687074829931972789115646',FS)); // bug #33795
    +
       // test BCDCompare:
       testBCDCompare(100, 100, 0);
       testBCDCompare(-100.1, -100.1, 0);
    
    tfmtbcd.pp.diff (452 bytes)
  • unpack_BCD_2.patch (478 bytes)
    Index: fmtbcd.pp
    ===================================================================
    --- fmtbcd.pp	(revision 39123)
    +++ fmtbcd.pp	(working copy)
    @@ -1022,7 +1022,7 @@
     
         var
           i : {$ifopt r+} __lo_bh + 1 ..__hi_bh {$else} Integer {$endif};
    -      j : {$ifopt r+} -1..__high_fraction {$else} Integer {$endif};
    +      j : {$ifopt r+} __low_fraction..__high_fraction+1 {$else} Integer {$endif};
           vv : {$ifopt r+} $00..$99 {$else} Integer {$endif};
     
         begin
    
    unpack_BCD_2.patch (478 bytes)

Activities

engkin

2018-05-27 23:45

reporter   ~0108551

Caused by wrong definition for a variable.

Patch attached.

engkin

2018-05-27 23:45

reporter  

unpack_BCD.patch (456 bytes)
Index: fmtbcd.pp
===================================================================
--- fmtbcd.pp	(revision 39123)
+++ fmtbcd.pp	(working copy)
@@ -1022,7 +1022,7 @@
 
     var
       i : {$ifopt r+} __lo_bh + 1 ..__hi_bh {$else} Integer {$endif};
-      j : {$ifopt r+} -1..__high_fraction {$else} Integer {$endif};
+      j : {$ifopt r+} -1..__hi_bh {$else} Integer {$endif};
       vv : {$ifopt r+} $00..$99 {$else} Integer {$endif};
 
     begin
unpack_BCD.patch (456 bytes)

LacaK

2018-05-29 08:29

developer   ~0108568

variable "j" is index to Fraction array, which is defined as :
  packed array [ __low_Fraction..__high_Fraction ] of Byte
so it is not good to change index variable to another range.

"__hi_bh" is intended for use with tBCD_helper variables not tBCD variables.
(so mixing __high_fraction with __hi_bh is not a way IMO)

I attached another patch, which fixes problem also with test for test/test/units/fmtbcd/

LacaK

2018-05-29 08:29

developer  

fmtbcd.pp.diff (789 bytes)
--- fmtbcd.pp.ori	Thu May 26 15:37:58 2016
+++ fmtbcd.pp	Tue May 29 08:19:06 2018
@@ -1042,15 +1042,15 @@
 {$endif}
               LDig := Plac;
               FDig := LDig - Prec + 1;
-              j := 0;
+              j := -1;
               i := FDig;
               while i <= LDig do
                 begin
-                  vv := Fraction[j];
-                  Singles[i] := ( vv {AND $f0} ) SHR 4;
-                  if i < LDig
-                    then Singles[i+1] := vv AND $0f;
                   Inc ( j );
+                  vv := Fraction[j];
+                  Singles[i] :=  vv SHR 4;
+                  if i < LDig then
+                    Singles[i+1] := vv AND $0f;
                   Inc ( i, 2 );
                 end;
              end;
fmtbcd.pp.diff (789 bytes)

LacaK

2018-05-29 08:34

developer  

tfmtbcd.pp.diff (452 bytes)
--- tfmtbcd.pp.ori	Tue Dec 22 15:17:49 2015
+++ tfmtbcd.pp	Tue May 29 08:30:22 2018
@@ -293,6 +293,8 @@
   testBCDDivide(100, -2, -50);
   testBCDDivide(1007, 5, 201.4);
 
+  testBCDDivide(StrToBCD('224518.0639999999994919',FS), IntegerToBCD(6615), StrToBCD('33.94075041572184421646258503401360544217687074829931972789115646',FS)); // bug #33795
+
   // test BCDCompare:
   testBCDCompare(100, 100, 0);
   testBCDCompare(-100.1, -100.1, 0);
tfmtbcd.pp.diff (452 bytes)

engkin

2018-05-30 20:22

reporter  

unpack_BCD_2.patch (478 bytes)
Index: fmtbcd.pp
===================================================================
--- fmtbcd.pp	(revision 39123)
+++ fmtbcd.pp	(working copy)
@@ -1022,7 +1022,7 @@
 
     var
       i : {$ifopt r+} __lo_bh + 1 ..__hi_bh {$else} Integer {$endif};
-      j : {$ifopt r+} -1..__high_fraction {$else} Integer {$endif};
+      j : {$ifopt r+} __low_fraction..__high_fraction+1 {$else} Integer {$endif};
       vv : {$ifopt r+} $00..$99 {$else} Integer {$endif};
 
     begin
unpack_BCD_2.patch (478 bytes)

engkin

2018-05-30 20:24

reporter   ~0108594

@Lacak, I agree with you that we should keep variable "j" range compatible with Fraction array. I don't think using -1 is good design. The range should simply include 1 more than __high_Fraction.

Patch attached "unpack_BCD_2.patch"

Whichever solution is taken does not matter, as long the bug is solved.

Michael Van Canneyt

2018-05-30 21:14

administrator   ~0108596

@engkin: Must your patch be applied on top of Lacak's patch or simply be applied to the original code ?

And why is the code dependent on $IFOPT R ? It should simply always take a subrange. ..

engkin

2018-05-31 02:08

reporter   ~0108601

@Michael: Simply applied on the original code.

I have the same question regarding $IFOPT R.

LacaK

2018-05-31 07:31

developer   ~0108603

- I have used "-1" because it was so from the begining. This was changed by mistake by my patch in rev.27845 so I restored original state
(but also your last patch seems okay to me)
- Same is true for {$IFOPT R} it is so from begining so I do not touched original authors code (probably there was reason for such solution)
- Michael do not forget apply patch to test program please ;-)

Michael Van Canneyt

2018-06-02 13:10

administrator   ~0108640

Fixed using last patch. Thanks for the patches !

LacaK

2018-06-04 08:07

developer   ~0108680

Please apply also patch to test program: tfmtbcd.pp.diff

Michael Van Canneyt

2018-06-09 14:28

administrator   ~0108781

Applied patch to test in rev. 39200.

Issue History

Date Modified Username Field Change
2018-05-27 22:57 Bart Broersma New Issue
2018-05-27 23:45 engkin Note Added: 0108551
2018-05-27 23:45 engkin File Added: unpack_BCD.patch
2018-05-29 08:29 LacaK Note Added: 0108568
2018-05-29 08:29 LacaK File Added: fmtbcd.pp.diff
2018-05-29 08:34 LacaK File Added: tfmtbcd.pp.diff
2018-05-29 08:34 LacaK Tag Attached: FmtBCD
2018-05-30 20:22 engkin File Added: unpack_BCD_2.patch
2018-05-30 20:24 engkin Note Added: 0108594
2018-05-30 21:13 Michael Van Canneyt Assigned To => Michael Van Canneyt
2018-05-30 21:13 Michael Van Canneyt Status new => assigned
2018-05-30 21:14 Michael Van Canneyt Note Added: 0108596
2018-05-31 02:08 engkin Note Added: 0108601
2018-05-31 07:31 LacaK Note Added: 0108603
2018-06-02 13:10 Michael Van Canneyt Fixed in Revision => 39161
2018-06-02 13:10 Michael Van Canneyt Note Added: 0108640
2018-06-02 13:10 Michael Van Canneyt Status assigned => resolved
2018-06-02 13:10 Michael Van Canneyt Fixed in Version => 3.1.1
2018-06-02 13:10 Michael Van Canneyt Resolution open => fixed
2018-06-02 13:10 Michael Van Canneyt Target Version => 3.2.0
2018-06-03 13:13 Bart Broersma Status resolved => closed
2018-06-04 08:07 LacaK Note Added: 0108680
2018-06-04 08:07 LacaK Status closed => feedback
2018-06-04 08:07 LacaK Resolution fixed => reopened
2018-06-04 08:07 LacaK Status feedback => assigned
2018-06-09 14:28 Michael Van Canneyt Note Added: 0108781
2018-06-09 14:28 Michael Van Canneyt Status assigned => resolved
2018-06-09 14:28 Michael Van Canneyt Resolution reopened => fixed
2018-06-09 18:44 Bart Broersma Status resolved => closed