paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-10 09:29:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Lacak. Better fix for mantis 30853

Browse Source 
git-svn-id: trunk@48876 -
This commit is contained in:
marco 2021-03-04 10:37:50 +00:00
parent 01a351f804
commit 81f0442e5d
1 changed files with 11 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
packages/rtl-objpas/src/inc/fmtbcd.pp
View File

@ -797,10 +797,12 @@ INTERFACE
{$endif}
function __get_null : tBCD; Inline;
function __get_zero : tBCD; Inline;
function __get_one : tBCD; Inline;
PROPERTY
NullBCD : tBCD Read __get_null;
ZeroBCD : tBCD Read __get_zero;
OneBCD : tBCD Read __get_one;
//{$define __lo_bh := 1 * ( -( MaxFmtBCDFractionSize * 1 + 2 ) ) }
@ -887,16 +889,20 @@ IMPLEMENTATION
OneBCD_ : tBCD;
function __get_null : tBCD; Inline;
begin
__get_null := NullBCD_;
end;
end;
function __get_zero : tBCD; Inline;
begin
__get_zero := NullBCD_;
__get_zero.Precision := 1;
end;
function __get_one : tBCD; Inline;
begin
__get_one := OneBCD_;
end;
end;
type
range_digits = 1..maxfmtbcdfractionsize;
@ -1584,7 +1590,7 @@ IMPLEMENTATION
begin
_SELECT
_WHEN aValue = 0
_THEN result := NullBCD;
_THEN result := ZeroBCD;
_WHEN aValue = 1
_THEN result := OneBCD;
_WHEN aValue = low ( myInttype )
@ -4130,12 +4136,6 @@ begin
else { array or something like that }
not_implemented;
end;
// peephole, avoids problems with databases, mantis #30853
if (Result.Precision = 0) and (Result.SignSpecialPlaces = 0) then
begin
Result.Precision := 10;
Result.SignSpecialPlaces := 2;
end;
end;
function VarToBCD ( const aValue : Variant ) : tBCD;