* Patch from Laco to fix issue #39261

git-svn-id: trunk@49623 -

packages/rtl-objpas/src/inc/fmtbcd.pp

@@ -1278,6 +1278,25 @@ IMPLEMENTATION
       neg1,
       neg2 : Boolean;
 
+      // real/reduced precision if there are on left side insignificant zero digits
+      function BCDPrec(const BCD: tBCD): word;
+      var scale: word;
+      begin
+        Result := BCD.Precision;
+        scale := BCDScale(BCD);
+        i := Low(BCD.Fraction);
+        while (Result>0) and (Result>scale) do begin
+          // high nibble
+          if BCD.Fraction[i] shr 4 <> 0 then Exit;
+          Dec(Result);
+          if Result <= scale then Exit;
+          // low nibble
+          if BCD.Fraction[i] <> 0 then Exit;
+          Dec(Result);
+          Inc(i);
+        end;
+      end;
+
     begin
 {$ifndef bigger_BCD}
       neg1 := ( BCD1.SignSpecialPlaces AND NegBit ) <> 0;
@@ -1292,8 +1311,8 @@ IMPLEMENTATION
         _WHEN ( NOT neg1 ) AND neg2
           _THEN result := +1;
         _WHENOTHER
-          pr1 := BCD1.Precision;
-          pr2 := BCD2.Precision;
+          pr1 := BCDPrec(BCD1);
+          pr2 := BCDPrec(BCD2);
 {$ifndef bigger_BCD}
           pl1 := BCD1.SignSpecialPlaces AND PlacesMask;
           pl2 := BCD2.SignSpecialPlaces AND PlacesMask;

tests/test/units/fmtbcd/tfmtbcd.pp

@@ -253,7 +253,6 @@ begin
   bcd:=strtobcd('0');
   testFormatBCD('0;;0',bcd, '0');
   testFormatBCD('0;;#',bcd, '');
-  testFormatBCD('0;;0.#',bcd, '0');
   testFormatBCD('0;;0.00',bcd, '0.00');
 
   // test StrToBCD:
@@ -302,6 +301,8 @@ begin
   testBCDCompare(-100.1, 100.1, -1);
   testBCDCompare(-100.1, -100.2, 1);
   testBCDCompare(100, 100.1, -1);
+  testBCDCompare(DoubleToBcd(0), 0, 0);
+  testBCDCompare(CurrToBcd(0), 0, 0);
   testBCDCompare(CurrToBcd(0.01), CurrToBcd(0.001), 1); // BCD values with Precision<Scale
   testBCDCompare(CurrToBcd(0.01), 0.01, 0);