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

* Use own power of ten scaling routine to avoid problems with FPU precision.

Browse Source 
Patch by Lacak2, mantis #20011

git-svn-id: trunk@20154 -
This commit is contained in:
marco 2012-01-22 18:53:43 +00:00
parent b19d53a609
commit c729bd7a3f
1 changed files with 32 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -7,7 +7,7 @@ unit IBConnection;
interface interface
uses uses
Classes, SysUtils, sqldb, db, math, dbconst, bufdataset, Classes, SysUtils, sqldb, db, dbconst, bufdataset,
{$IfDef LinkDynamically} {$IfDef LinkDynamically}
ibase60dyn; ibase60dyn;
{$Else} {$Else}
@ -749,6 +749,19 @@ begin
Result := (retcode = 0); Result := (retcode = 0);
end; end;
function IntPower10(e: integer): double;
const PreComputedPower10: array[0..9] of integer = (1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000);
var n: integer;
begin
n := abs(e); //exponent can't be greater than 18
if n <= 9 then
Result := PreComputedPower10[n]
else
Result := PreComputedPower10[9] * PreComputedPower10[n-9];
if e < 0 then
Result := 1 / Result;
end;
procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams); procedure TIBConnection.SetParameters(cursor : TSQLCursor; aTransation : TSQLTransaction; AParams : TParams);
var ParNr,SQLVarNr : integer; var ParNr,SQLVarNr : integer;
@ -805,8 +818,7 @@ var
// This should be a pointer, because the ORIGINAL variables must // This should be a pointer, because the ORIGINAL variables must
// be modified. // be modified.
VSQLVar: ^XSQLVAR; VSQLVar: ^XSQLVAR;
d : double;
begin begin
{$push} {$push}
{$R-} {$R-}
@ -826,7 +838,7 @@ begin
if VSQLVar^.sqlscale = 0 then if VSQLVar^.sqlscale = 0 then
i := AParams[ParNr].AsInteger i := AParams[ParNr].AsInteger
else else
i := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale)); i := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen); Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
end; end;
SQL_SHORT : SQL_SHORT :
@ -834,7 +846,7 @@ begin
if VSQLVar^.sqlscale = 0 then if VSQLVar^.sqlscale = 0 then
si := AParams[ParNr].AsSmallint si := AParams[ParNr].AsSmallint
else else
si := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale)); si := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
i := si; i := si;
Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen); Move(i, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
end; end;
@ -870,12 +882,9 @@ begin
if VSQLVar^.sqlscale = 0 then if VSQLVar^.sqlscale = 0 then
li := AParams[ParNr].AsLargeInt li := AParams[ParNr].AsLargeInt
else if AParams[ParNr].DataType = ftFMTBcd then else if AParams[ParNr].DataType = ftFMTBcd then
begin li := AParams[ParNr].AsFMTBCD * IntPower10(-VSQLVar^.sqlscale)
d:=AParams[ParNr].AsFMTBCD * IntPower(10, -VSQLVar^.sqlscale);
li := Round(d)
end
else else
li := Round(AParams[ParNr].AsCurrency * IntPower(10, -VSQLVar^.sqlscale)); li := Round(AParams[ParNr].AsCurrency * IntPower10(-VSQLVar^.sqlscale));
Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen); Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
end; end;
SQL_DOUBLE, SQL_FLOAT: SQL_DOUBLE, SQL_FLOAT:
@ -896,9 +905,13 @@ var
CurrBuff : pchar; CurrBuff : pchar;
c : currency; c : currency;
AFmtBcd : tBCD; AFmtBcd : tBCD;
smalli : smallint;
longi : longint; function BcdDivPower10(Dividend: largeint; e: integer): TBCD;
largei : largeint; var d: double;
begin
d := Dividend / IntPower10(e);
Result := StrToBCD( FloatToStr(d) );
end;
begin begin
CreateBlob := False; CreateBlob := False;
@ -937,18 +950,9 @@ begin
ftBCD : ftBCD :
begin begin
case SQLDA^.SQLVar[x].SQLLen of case SQLDA^.SQLVar[x].SQLLen of
2 : begin 2 : c := PSmallint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
Move(CurrBuff^, smalli, 2); 4 : c := PLongint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
c := smalli*intpower(10,SQLDA^.SQLVar[x].SQLScale); 8 : c := PLargeint(CurrBuff)^ / IntPower10(-SQLDA^.SQLVar[x].SQLScale);
end;
4 : begin
Move(CurrBuff^, longi, 4);
c := longi*intpower(10,SQLDA^.SQLVar[x].SQLScale);
end;
8 : begin
Move(CurrBuff^, largei, 8);
c := largei*intpower(10,SQLDA^.SQLVar[x].SQLScale);
end;
else else
Result := False; // Just to be sure, in principle this will never happen Result := False; // Just to be sure, in principle this will never happen
end; {case} end; {case}
@ -957,18 +961,9 @@ begin
ftFMTBcd : ftFMTBcd :
begin begin
case SQLDA^.SQLVar[x].SQLLen of case SQLDA^.SQLVar[x].SQLLen of
2 : begin 2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
Move(CurrBuff^, smalli, 2); 4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
AFmtBCD:= smalli*intpower(10,SQLDA^.SQLVar[x].SQLScale); 8 : AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -SQLDA^.SQLVar[x].SQLScale);
end;
4 : begin
Move(CurrBuff^, longi, 4);
AFmtBcd := longi*intpower(10,SQLDA^.SQLVar[x].SQLScale);
end;
8 : begin
Move(CurrBuff^, largei, 8);
AFmtBcd := largei*intpower(10,SQLDA^.SQLVar[x].SQLScale);
end;
else else
Result := False; // Just to be sure, in principle this will never happen Result := False; // Just to be sure, in principle this will never happen
end; {case} end; {case}