Browse Source

* Applied patch from Manfred Hahn to fic bcdSubtract (bug ID 29207)

git-svn-id: trunk@32722 -
michael 9 years ago
parent
commit
dcefe41fe3
1 changed files with 7 additions and 5 deletions
  1. 7 5
      packages/rtl-objpas/src/inc/fmtbcd.pp

+ 7 - 5
packages/rtl-objpas/src/inc/fmtbcd.pp

@@ -1642,7 +1642,7 @@ IMPLEMENTATION
 {$else}
 {$else}
       BCD.Places := 4;
       BCD.Places := 4;
 {$endif}
 {$endif}
-      if Decimals <> 4 then
+      if (Decimals <> 4) or (Decimals > BCD.Precision) then
         Result := NormalizeBCD ( BCD, BCD, Precision, Decimals )
         Result := NormalizeBCD ( BCD, BCD, Precision, Decimals )
       else
       else
         Result := True;
         Result := True;
@@ -2010,15 +2010,14 @@ IMPLEMENTATION
 
 
     var
     var
       bh : tBCD_helper;
       bh : tBCD_helper;
-      tm : {$ifopt r+} 1..maxfmtbcdfractionsize - 1 {$else} Integer {$endif};
+      tm : {$ifopt r+} __lo_bh..__hi_bh {$else} Integer {$endif};
 
 
     begin
     begin
 {$ifopt r+}
 {$ifopt r+}
       if ( Precision < 0 ) OR ( Precision > MaxFmtBCDFractionSize ) then RangeError;
       if ( Precision < 0 ) OR ( Precision > MaxFmtBCDFractionSize ) then RangeError;
       if ( Places < 0 ) OR ( Precision >= MaxFmtBCDFractionSize ) then RangeError;
       if ( Places < 0 ) OR ( Precision >= MaxFmtBCDFractionSize ) then RangeError;
 {$endif}
 {$endif}
-      NormalizeBCD := True;
-      if BCDScale ( InBCD ) > Places then
+      if (BCDScale(InBCD) > Places) or (BCDPrecision(InBCD) < Places) then
         begin
         begin
         unpack_BCD ( InBCD, bh );
         unpack_BCD ( InBCD, bh );
         tm := bh.Plac - Places;
         tm := bh.Plac - Places;
@@ -2027,12 +2026,15 @@ IMPLEMENTATION
         bh.Prec := bh.Prec - tm;
         bh.Prec := bh.Prec - tm;
 {       dec ( LDig, tm );   Dec/Inc error? }
 {       dec ( LDig, tm );   Dec/Inc error? }
         bh.LDig := bh.LDig - tm;
         bh.LDig := bh.LDig - tm;
-        NormalizeBCD := False;
+        NormalizeBCD := tm <= 0;
         if NOT pack_BCD ( bh, OutBCD ) then
         if NOT pack_BCD ( bh, OutBCD ) then
           RAISE eBCDOverflowException.Create ( 'in NormalizeBCD' );
           RAISE eBCDOverflowException.Create ( 'in NormalizeBCD' );
         end
         end
       else
       else
+        begin
         OutBCD := InBCD;
         OutBCD := InBCD;
+        NormalizeBCD := True;
+        end
     end;
     end;
 
 
   procedure BCDMultiply ( const BCDin1,
   procedure BCDMultiply ( const BCDin1,