Lazarus

Programming => Databases => Topic started by: lmdamiano on October 16, 2021, 02:46:39 pm

Title: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 16, 2021, 02:46:39 pm
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][+][-]
  1. var
  2.   q : TSQLQuery;
  3.   pCurr : Currency;
  4. begin
  5.  
  6.    Result := True;
  7.    q := TSQLQuery.Create(nil);
  8.    try
  9.       q.Database := ifDB; // firebird connection
  10.       q.SQL.Text := 'UPDATE IF_DIBA_TESTATA SET DIBA_ARTICOLO_BASE_QTA = :par0 WHERE DIBA_ARTICOLO_ID = :par1 ';
  11.       pCurr := 1115;
  12.       q.Params[0].AsCurrency := pCurr;
  13.       q.Params[1].asInteger := impostazioni.DibaArticoloID;
  14.       q.ExecSQL;
  15.  
  16.  
  17.       q.SQL.Text := 'SELECT DIBA_ARTICOLO_BASE_QTA FROM IF_DIBA_TESTATA WHERE DIBA_ARTICOLO_ID = :par0 ';
  18.       q.Params[0].asInteger := impostazioni.DibaArticoloID;
  19.       q.Open;
  20.       if not(q.EOF) then
  21.         begin
  22.             WriteLn('Result: ' + CurrToStrF(q.Fields[0].asCurrency, ffGeneral, 2));
  23.         end;
  24.       q.Close;
  25.  
  26.    except on ex : Exception do
  27.         begin
  28.            Result := False;
  29.            ifDB.Transaction.Rollback;
  30.            Application.MessageBox(PChar('Errore inaspettato nel tentativo di eseguire la query di aggiornamento al database Firebird:' + LineEnding +
  31.              ex.Message), 'Errore inaspettato', MB_OK + MB_ICONERROR);
  32.         end;
  33.    end;
  34.    q.Free;
  35.              
  36.  

The ouput (and value really stored in the database) is: 
Quote
Result: -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?
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: dseligo on October 16, 2021, 04:26:11 pm
Quote from: lmdamiano on October 16, 2021, 02:46:39 pm
on 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.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 16, 2021, 04:34:47 pm
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.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 16, 2021, 04:44:04 pm
Update: 32bit release works fine. Value are stored correctly.
Can we do something with the fpc64?
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: dseligo on October 16, 2021, 04:55:17 pm
Did you check fbclient.dll (bitness, version)?
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 16, 2021, 05:02:49 pm
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.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: ttomas on October 16, 2021, 08:02:44 pm
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.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 16, 2021, 08:05:19 pm
Tried .asCurrency, asFloat, asString. Same results.
Lazarus 32bit works,  Lazarus 64bit doesn't.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: LacaK on October 18, 2021, 06:42:51 pm
Can you provide small compilable example with embeded database and embeded fbclient.dll, which will show error?
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 19, 2021, 08:26:47 pm
here it is.
Every fbclient.dll will produce the error
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: ttomas on October 20, 2021, 01:45:37 am
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; 
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 20, 2021, 12:13:50 pm
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
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: LacaK on October 20, 2021, 07:43:44 pm
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
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on October 20, 2021, 09:31:12 pm
Temporary fix for storing decimal(18,8) or numeric in firebird
Code: Pascal  [Select][+][-]
  1. uses
  2.    fmtbcd;
  3.  


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?
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: ttomas on October 20, 2021, 11:54:21 pm
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.
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: ttomas on October 21, 2021, 12:11:41 am
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;
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: LacaK on October 22, 2021, 08:41:51 am
On Win64 you can reproduce problem by simple test (not related to IBConnection):
Code: Pascal  [Select][+][-]
  1. var
  2.   c: currency;
  3.   d: double;
  4.   i1: int64;
  5. begin
  6.   c:=1115;
  7.   d:=100000000;
  8.   i1:=Round(c*d);
  9.   writeln(i1);
  10. end;
  11.  
Compare result for Win32 and Win64 ...
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: LacaK on October 25, 2021, 08:52:24 am
Something like this may help:

Code: Pascal  [Select][+][-]
  1.       SQL_INT64:
  2.           begin
  3.             if VSQLVar^.sqlscale = 0 then
  4.               li := AParam.AsLargeInt
  5.             else if AParam.DataType = ftFMTBcd then
  6.               li := AParam.AsFMTBCD * IntPower10(-VSQLVar^.sqlscale)
  7.             else if AParam.DataType = ftCurrency then
  8.               if -VSQLVar^.sqlscale >= 4 then
  9.                 li := Round(AParam.AsCurrency * 10000) * Trunc(IntPower10(-VSQLVar^.sqlscale-4))
  10.               else
  11.                 li := Round(AParam.AsCurrency * IntPower10(-VSQLVar^.sqlscale-4))
  12.             else
  13.               li := Round(AParam.AsFloat * IntPower10(-VSQLVar^.sqlscale));
  14.             Move(li, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
  15.           end;
Title: Re: Firebird 3 + Laz64 + TSQLQuery currency error
Post by: lmdamiano on November 04, 2021, 11:35:46 am
The problem can be temporarily solved through a class helper for TParam

Code: Pascal  [Select][+][-]
  1. type
  2.  
  3.   { TParamHelper }
  4.  
  5.   TParamHelper = class helper for TParam
  6.      protected
  7.        procedure setAsCurrencyBCD(pValore : Currency);
  8.        function getAsCurrencyBCD() : Currency;
  9.      published
  10.        property AsCurrency : Currency read GetAsCurrencyBCD write SetAsCurrencyBCD;
  11.   end;  
  12.  

Code: Pascal  [Select][+][-]
  1. { TParamHelper }
  2. procedure TParamHelper.setAsCurrencyBCD(pValore: Currency);
  3. begin
  4.   Self.AsFMTBCD := CurrToBCD(pValore);
  5. end;
  6.  
  7. function TParamHelper.getAsCurrencyBCD(): Currency;
  8. begin
  9.   BCDToCurr(GetAsFMTBCD, Result);
  10. end;  
  11.  

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.
TinyPortal © 2005-2018