Firebird 3 + Laz64 + TSQLQuery currency error
lazarus / 16-Databases

----------------------------------------------------------------------
lmdamiano · 2021-10-16 12:46

Hello guys,

I've been using Lazarus for a lot years. I've built an entire ERP
system on Lazarus 1.1 32bit but the project has grown so big that gdb
crashes on every start (I think that debug information are too large,
256mb). I think it's time to start to port my project to the newer
Lazarus but on every 64 bit release a find this very disturbing
conversion problem in saving data to Firebird.

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var  q :
TSQLQuery;  pCurr : Currency;begin    Result := True;   q :=
TSQLQuery.Create(nil);   try      q.Database := ifDB; // firebird
connection      q.SQL.Text := 'UPDATE IF_DIBA_TESTATA SET
DIBA_ARTICOLO_BASE_QTA = :par0 WHERE DIBA_ARTICOLO_ID = :par1 ';     
pCurr := 1115;      q.Params[0].AsCurrency := pCurr;     
q.Params[1].asInteger := impostazioni.DibaArticoloID;     
q.ExecSQL;        q.SQL.Text := 'SELECT DIBA_ARTICOLO_BASE_QTA FROM
IF_DIBA_TESTATA WHERE DIBA_ARTICOLO_ID = :par0 ';     
q.Params[0].asInteger := impostazioni.DibaArticoloID;      q.Open;   
 if not(q.EOF) then        begin            WriteLn('Result: ' +
CurrToStrF(q.Fields[0].asCurrency, ffGeneral, 2));        end;     
q.Close;    except on ex : Exception do        begin           Result
:= False;           ifDB.Transaction.Rollback;         
 Application.MessageBox(PChar('Errore inaspettato nel tentativo di
eseguire la query di aggiornamento al database Firebird:' + LineEnding
+             ex.Message), 'Errore inaspettato', MB_OK +
MB_ICONERROR);        end;   end;   q.Free;            
The ouput (and value really stored in the database) is: 
QuoteResult: -729,6744

The same exact code and query worked in older lazarus or with ZeosDB.
The field "DIBA_ARTICOLO_BASE_QTA" is a  decimal( 18, 8 ) in my
firebird database.  What I'm doing wrong?

----------------------------------------------------------------------
dseligo · 2021-10-16 14:26

Quote from: lmdamiano on October 16, 2021, 02:46:39 pmon every 64 bit
release
Is the result OK if you compile to 32 bit (with new version of
Lazarus)?
It could be problem with fbclient.dll.

----------------------------------------------------------------------
lmdamiano · 2021-10-16 14:34

I'm downloading the latest 32bit release.
I've done more testing. It seems values lower than 922 are stored
correctly, Higher than 922 became negative number.

----------------------------------------------------------------------
lmdamiano · 2021-10-16 14:44

Update: 32bit release works fine. Value are stored correctly.
Can we do something with the fpc64?

----------------------------------------------------------------------
dseligo · 2021-10-16 14:55

Did you check fbclient.dll (bitness, version)?

----------------------------------------------------------------------
lmdamiano · 2021-10-16 15:02

Checked: always used Firebird client/server 64bit.
Redownloaded latest fbclient and dll from
https://firebirdsql.org/en/firebird-3-0-7/#Win64 and got the same bug.

----------------------------------------------------------------------
ttomas · 2021-10-16 18:02

decimal( 18, 8 ) is not a currency type try to set param AsFloat.
Maybe a bug in type conversion. Also check Dialect 1 or 3.

----------------------------------------------------------------------
lmdamiano · 2021-10-16 18:05

Tried .asCurrency, asFloat, asString. Same results.
Lazarus 32bit works,  Lazarus 64bit doesn't.

----------------------------------------------------------------------
LacaK · 2021-10-18 16:42

Can you provide small compilable example with embeded database and
embeded fbclient.dll, which will show error?

----------------------------------------------------------------------
lmdamiano · 2021-10-19 18:26

here it is.
Every fbclient.dll will produce the error

----------------------------------------------------------------------
ttomas · 2021-10-19 23:45

I can confirm. 32b is OK, 64b app have bug in setting Params.
Please report this Issue in Fpc, most likely some bad type in
IBConnection.pp.
This is not firebird (fbclient.dll) bug. Zeos and Ibx save correct
data in Db.
FPC 3.2.1

Edited:
Changing test_type2 to numeric(18,4) from numeric(18,8) is OK.
Internally in firebird both types will be saved as Int64 with scale of
-4 or -8. Numeric(18,4) is same as native FPC Currency type.
Bug is after line 1163 in IBConnection.pp
Code: [Select]        SQL_INT64:
          begin
            if VSQLVar^.sqlscale = 0 then
              li := AParam.AsLargeInt
            else if AParam.DataType = ftFMTBcd then
              li := AParam.AsFMTBCD * IntPower10(-VSQLVar^.sqlscale)
            else
              li := Round(AParam.AsCurrency *
IntPower10(-VSQLVar^.sqlscale));
            Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
          end;

----------------------------------------------------------------------
lmdamiano · 2021-10-20 10:13

Thank you.
I can't change every decimal field to (18,4).
Open the issue to fpc bugtracker :
https://gitlab.com/freepascal.org/fpc/source/-/issues/39409

----------------------------------------------------------------------
LacaK · 2021-10-20 17:43

Can you explain where is bug and why it works in 32bit FPC but not in
64bit?
In mentioned code there is value of "-VSQLVar^.sqlscale" = 8 right?

May be that it is currency multiplication problem ... currency * 10^8
causes overflow of int64?
See: https://gitlab.com/freepascal.org/fpc/source/-/issues/36176

----------------------------------------------------------------------
lmdamiano · 2021-10-20 19:31

Temporary fix for storing decimal(18,8) or numeric in firebird
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses  
 fmtbcd; 

Code: [Select]  var
  q : TSQLQuery;
begin

  Result := True;
  q := TSQLQuery.Create(nil);
  try
      q.Database := dbconn;
      q.SQL.Text := 'UPDATE OR INSERT INTO ' + oggetto.TableName + '
(' + oggetto.FieldID + ', ' + oggetto.FieldCurrency + ', ' +
                    oggetto.FieldDecimal + ', ' + oggetto.FieldDouble
+ ') ' +
                    'VALUES(1, :par0, :par1, :par2) ' +
                    'MATCHING (' + oggetto.FieldID + ') ';

      q.Params[0].AsFMTBCD := currToBCD(oggetto.InputValue);
      q.Params[1].AsCurrency := oggetto.InputValue;
      q.Params[2].AsFloat := oggetto.InputValue;
      q.ExecSql;

      dbconn.Transaction.Commit;

      q.SQL.Text := 'SELECT ' + oggetto.FieldCurrency + ' as c0, ' +
oggetto.FieldDecimal + ', ' + oggetto.FieldDouble + ' ' +
                    'FROM ' + oggetto.TableName + ' ' +
                    'WHERE ' + oggetto.FieldID + ' = 1 ';
      q.Open;
      if not(q.EOF) then
        begin
           ShowMessage('Query executed successfully: ' + LineEnding +
                       'DECIMAL ' + CurrToStrF(q.Fields[0].asCurrency,
ffGeneral, 4) + LineEnding +
                       'NUMERIC ' + CurrToStrF(q.Fields[1].asCurrency,
ffGeneral, 4) + LineEnding +
                       'Double ' + CurrToStrF(q.Fields[2].asCurrency,
ffGeneral, 2));

        end;
      q.Close;

  except on ex : Exception do
      begin
          Result := False;
          dbconn.Transaction.Rollback;
          Application.MessageBox(PChar('Unexpected error while doing
the query:' + LineEnding +
            ex.Message), 'Error', MB_OK + MB_ICONERROR);
      end;
  end;
  q.Free;   

however, due the issue Lacak posted, I don't understand if the
currency type is still safe to use under 64bit lazarus.
Do I need to convert everything to FmtBCD?

----------------------------------------------------------------------
ttomas · 2021-10-20 21:54

Something is bad in setting DataType for params.
q.Params[0].DataType is ftUnknown

changing code to
Code: [Select]      q.Params[0].DataType:=ftFMTBcd;
      q.Params[0].NumericScale:=8;
      q.Params[0].Precision:=18;
      q.Params[0].Value := oggetto.InputValue;
This change save correct data. NumericScale and Precision is not
needed work without this two lines. But changing last line to AsFloat
or AsCurrency is not OK.

----------------------------------------------------------------------
ttomas · 2021-10-20 22:11

Reading about currency Issue on x64 function IntPower10  line 1057 in
IBConnection.pp should be checked
Code: [Select]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;

----------------------------------------------------------------------
LacaK · 2021-10-22 06:41

On Win64 you can reproduce problem by simple test (not related to
IBConnection):
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var  c:
currency;  d: double;  i1: int64;begin  c:=1115;  d:=100000000; 
i1:=Round(c*d);  writeln(i1); end; Compare result for Win32 and Win64
...

----------------------------------------------------------------------
LacaK · 2021-10-25 06:52

Something like this may help:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i      
SQL_INT64:          begin            if VSQLVar^.sqlscale = 0 then   
         li := AParam.AsLargeInt            else if AParam.DataType =
ftFMTBcd then              li := AParam.AsFMTBCD *
IntPower10(-VSQLVar^.sqlscale)            else if AParam.DataType =
ftCurrency then              if -VSQLVar^.sqlscale >= 4 then         
     li := Round(AParam.AsCurrency * 10000) *
Trunc(IntPower10(-VSQLVar^.sqlscale-4))              else            
  li := Round(AParam.AsCurrency * IntPower10(-VSQLVar^.sqlscale-4))  
        else              li := Round(AParam.AsFloat *
IntPower10(-VSQLVar^.sqlscale));            Move(li,
VSQLVar^.SQLData^, VSQLVar^.SQLLen);          end;

----------------------------------------------------------------------
lmdamiano · 2021-11-04 10:35

The problem can be temporarily solved through a class helper for
TParam

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i type   {
TParamHelper }   TParamHelper = class helper for TParam     protected 
     procedure setAsCurrencyBCD(pValore : Currency);       function
getAsCurrencyBCD() : Currency;     published       property AsCurrency
: Currency read GetAsCurrencyBCD write SetAsCurrencyBCD;  end; 
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i {
TParamHelper }procedure TParamHelper.setAsCurrencyBCD(pValore:
Currency);begin  Self.AsFMTBCD := CurrToBCD(pValore);end; function
TParamHelper.getAsCurrencyBCD(): Currency;begin 
BCDToCurr(GetAsFMTBCD, Result);end; 
with this little class helper TParam .asCurrency will work without
rewriting all the references. You could put this class helper behind a
conditional formatting like {$IF FPC_FULLVERSION > 30000}.
I like those new tricks.