|
|
@@ -16,7 +16,7 @@
|
|
|
{ "Programming is the time between two bugs" }
|
|
|
{ (last words of the unknown programmer) }
|
|
|
|
|
|
-{ this program was a good test for the compiler: some bugs have been found.
|
|
|
+(* this program was a good test for the compiler: some bugs have been found.
|
|
|
|
|
|
1. WITH in inline funcs produces a compiler error AFTER producing an .exe file
|
|
|
(was already known; I didn't see it in the bug list)
|
|
|
@@ -39,7 +39,7 @@
|
|
|
6. two range check errors in scanner.pas
|
|
|
a) array subscripting
|
|
|
b) value out ouf range
|
|
|
-}
|
|
|
+*)
|
|
|
|
|
|
{ $define debug_version}
|
|
|
|
|
|
@@ -791,8 +791,8 @@ INTERFACE
|
|
|
{ in the tBCD_helper the bcd is stored for computations,
|
|
|
shifted to the right position }
|
|
|
|
|
|
-{ {$define __lo_bhb := 1 * ( __lo_bh + __lo_bh ) } }
|
|
|
-{ {$define __hi_bhb := 1 * ( __hi_bh + __hi_bh + 1 ) } }
|
|
|
+// {$define __lo_bhb := 1 * ( __lo_bh + __lo_bh ) }
|
|
|
+// {$define __hi_bhb := 1 * ( __hi_bh + __hi_bh + 1 ) }
|
|
|
const
|
|
|
__lo_bhb = __lo_bh + __lo_bh - 1;
|
|
|
__hi_bhb = __hi_bh + __hi_bh;
|
|
|
@@ -830,7 +830,7 @@ IMPLEMENTATION
|
|
|
PROTECTED
|
|
|
function GetInstance(const v : TVarData): tObject; OVERRIDE;
|
|
|
PUBLIC
|
|
|
- procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp);
|
|
|
+ procedure BinaryOp(var Left: TVarData; const Right: TVarData; const Operation: TVarOp); override;
|
|
|
end;
|
|
|
|
|
|
TFMTBcdVarData = CLASS(TPersistent)
|
|
|
@@ -1563,7 +1563,6 @@ IMPLEMENTATION
|
|
|
bh : tBCD_helper;
|
|
|
v : {$ifopt r+} 0..high ( myInttype ) {$else} Integer {$endif};
|
|
|
p : {$ifopt r+} low ( bh.Singles ) - 1..0 {$else} Integer {$endif};
|
|
|
- Error,
|
|
|
exitloop : Boolean;
|
|
|
|
|
|
begin
|
|
|
@@ -1589,7 +1588,6 @@ IMPLEMENTATION
|
|
|
else v := +aValue;
|
|
|
LDig := 0;
|
|
|
p := 0;
|
|
|
- Error := False;
|
|
|
REPEAT
|
|
|
Singles[p] := v MOD 10;
|
|
|
v := v DIV 10;
|
|
|
@@ -1598,7 +1596,6 @@ IMPLEMENTATION
|
|
|
if p < low ( Singles )
|
|
|
then begin
|
|
|
exitloop := True;
|
|
|
- Error := True;
|
|
|
(* what to do if error occured? *)
|
|
|
RAISE eBCDOverflowException.create ( 'in IntegerToBCD' );
|
|
|
end;
|
|
|
@@ -1608,12 +1605,13 @@ IMPLEMENTATION
|
|
|
pack_BCD ( bh, result );
|
|
|
_endSELECT;
|
|
|
end;
|
|
|
-
|
|
|
+{$warnings off}
|
|
|
function VarToBCD ( const aValue : Variant ) : tBCD;
|
|
|
|
|
|
begin
|
|
|
not_implemented;
|
|
|
end;
|
|
|
+{$warnings on}
|
|
|
|
|
|
function CurrToBCD ( const Curr : currency;
|
|
|
var BCD : tBCD;
|
yury