Skip to content

Commit 53660a8

Browse files
MWASoftwareMWASoftware
committed
In Firebird 4 or later, large fixed point real numbers (e.g. NUMERIC(34,4)) are supported using 128 bit integers approprately scaled. In FBIntf, numbers this large are handled using the BCD data type. FBIntf uses the Firebird client library to convert a BCD (expressed as a formatted string) to Firebird's internal record format and vice versa. It has been reported that there can be a mis-match between the decimal separator used by the Firebird Client Library and that used by FBIntf, resulting in either a range error or a missing decimal point. In order to avoid this problem, the FBIntf large integer handling has been updated to remove any dependency on the decimal separator used by the Firebird Client Library.
1 parent b8a41ce commit 53660a8

File tree

6 files changed

+90
-28
lines changed

6 files changed

+90
-28
lines changed

‎client/3.0/FB30ClientAPI.pas‎

Lines changed: 63 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -805,11 +805,49 @@ function TFB30ClientAPI.SQLDecFloatDecode(SQLType: cardinal; bufptr: PByte): tBC
805805
procedure TFB30ClientAPI.StrToInt128(scale: integer; aValue: AnsiString;
806806
bufptr: PByte);
807807
var int128: IInt128;
808+
index: integer;
809+
dp: integer;
810+
TruncateBy: integer;
808811
begin
809812
inherited StrToInt128(scale,aValue,bufPtr);
810813

811814
int128 := UtilIntf.getInt128(StatusIntf);
812-
int128.fromString(StatusIntf,scale,PAnsiChar(aValue),FB_I128Ptr(bufptr));
815+
816+
{Unable to trust that the Firebird Client Library using the
817+
decimal separator defined for the locale. Thus we remove it
818+
and adjust the decimal string appropriately.}
819+
820+
{$IF declared(DefaultFormatSettings)}
821+
with DefaultFormatSettings do
822+
{$ELSE}
823+
{$IF declared(FormatSettings)}
824+
with FormatSettings do
825+
{$IFEND}
826+
{$IFEND}
827+
index := Pos(DecimalSeparator,aValue);
828+
if index > 0 then
829+
begin
830+
dp := Length(aValue) - index; {Number of decimal places}
831+
system.Delete(aValue,index,1);{remove decimal separator}
832+
if dp > -scale then
833+
begin
834+
{Truncate to remove any dp greater than field scale}
835+
TruncateBy := dp + scale;
836+
system.Delete(aValue,Length(aValue) - TruncateBy +1,TruncateBy);
837+
end
838+
else
839+
while dp < -scale do
840+
{Add trailing zeroes to align with field scale}
841+
begin
842+
aValue := aValue + '0';
843+
Inc(dp);
844+
end;
845+
end;
846+
{Note 'fromstring' is independent of the actual field scale. Thus we can
847+
set a scale of zero provided the number of "decimal places" in the string
848+
matches the field scale.}
849+
850+
int128.fromString(StatusIntf,0,PAnsiChar(aValue),FB_I128Ptr(bufptr));
813851
Check4DatabaseError;
814852
end;
815853

@@ -823,9 +861,32 @@ function TFB30ClientAPI.Int128ToStr(bufptr: PByte; scale: integer
823861
Result := inherited Int128ToStr(bufPtr,scale);
824862

825863
int128 := UtilIntf.getInt128(StatusIntf);
826-
int128.toString(StatusIntf,FB_I128Ptr(bufptr),scale,buflength,PAnsiChar(@Buffer));
864+
865+
{Unable to trust that the Firebird Client Library using the
866+
decimal separator defined for the locale. Thus we
867+
set the scale to zero to avoid decimal separator formatting issues}
868+
869+
int128.toString(StatusIntf,FB_I128Ptr(bufptr),0,buflength,PAnsiChar(@Buffer));
827870
Check4DatabaseError;
828871
Result := strpas(PAnsiChar(@Buffer));
872+
873+
{Now insert decimal separator from current locale as given by the field scale}
874+
if scale < 0 then
875+
begin
876+
{if string is shorter than the field scale left pad with zeroes}
877+
while Length(Result) + scale < 1 do
878+
Result := '0' + Result;
879+
880+
{Insert locale's decimal separator in position given by field scale}
881+
{$IF declared(DefaultFormatSettings)}
882+
with DefaultFormatSettings do
883+
{$ELSE}
884+
{$IF declared(FormatSettings)}
885+
with FormatSettings do
886+
{$IFEND}
887+
{$IFEND}
888+
system.insert(DecimalSeparator,Result,Length(Result) + scale + 1);
889+
end;
829890
end;
830891

831892
function TFB30ClientAPI.HasLocalTZDB: boolean;

‎client/FBSQLData.pas‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1762,10 +1762,10 @@ function TSQLDataItem.GetDateTimeStrLength(DateTimeFormat: TIBDateTimeFormats
17621762
Result := Length(GetTimeFormatStr)+ 6;
17631763
else
17641764
Result := 0;
1765-
end;end;
1765+
end;
1766+
end;
17661767

17671768
function TSQLDataItem.GetAsBCD: tBCD;
1768-
17691769
begin
17701770
CheckActive;
17711771
if IsNull then
@@ -1784,8 +1784,8 @@ function TSQLDataItem.GetAsBCD: tBCD;
17841784

17851785
SQL_DEC_FIXED,
17861786
SQL_INT128:
1787-
with FFirebirdClientAPI do
1788-
Result := StrToBCD(Int128ToStr(SQLData,scale));
1787+
with FFirebirdClientAPI do
1788+
Result := StrToBCD(Int128ToStr(SQLData,scale));
17891789
else
17901790
if not CurrToBCD(GetAsCurrency,Result) then
17911791
IBError(ibxeBadBCDConversion,[]);

‎testsuite/FB4reference.log‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -656,13 +656,13 @@ Running Test 3: ad hoc queries
656656
Opening inet://localhost/employee
657657
Database Open
658658
Employee Count = 42
659-
Transaction ID = 6752
659+
Transaction ID = 7146
660660
Transaction is Read/Write
661661
Transaction Database Path = inet://localhost/employee
662-
Transaction ID = 6752
663-
Oldest Interesting = 6750
664-
Oldest Action = 6751
665-
Oldest Snapshot = 6751
662+
Transaction ID = 7146
663+
Oldest Interesting = 7144
664+
Oldest Action = 7145
665+
Oldest Snapshot = 7145
666666
Oldest Snapshot Number = 2
667667
Lock Timeout = 0
668668
Transaction Access = isc_info_tra_readwrite
@@ -704,7 +704,7 @@ Elapsed time= 0.001 sec
704704
Cpu = 0.000 sec
705705
Buffers = 2048
706706
Reads = 0
707-
Writes = 0
707+
Writes = 1
708708
Fetches = 3
709709
Select Count = 0 InsertCount = 1 UpdateCount = 0 DeleteCount = 0
710710
Relation Name = EMPLOYEE
@@ -4662,12 +4662,12 @@ BigNumber = 1234561234567.123456
46624662
Special = 0
46634663
Places = 6
46644664
Digits = 12 34 56 12 34 56 71 23 45 60
4665-
BiggerNumber = 11123456123456123456123456123456.1235
4665+
BiggerNumber = 11123456123456123456123456123456.1234
46664666
Precision = 36
46674667
Sign = 0
46684668
Special = 0
46694669
Places = 4
4670-
Digits = 11 12 34 56 12 34 56 12 34 56 12 34 56 12 34 56 12 35
4670+
Digits = 11 12 34 56 12 34 56 12 34 56 12 34 56 12 34 56 12 34
46714671
BigInteger = Null
46724672

46734673
RowID = 4
@@ -5390,12 +5390,12 @@ IBX$SESSIONID = 1
53905390
IBX$TRANSACTIONID = 11
53915391
IBX$OLDTRANSACTIONID = NULL
53925392
IBX$USER = SYSDBA (Charset Id = 4 Codepage = 65001)
5393-
IBX$CREATED = 2025/03/30 11:16:25.0400
5393+
IBX$CREATED = 2025/08/09 11:29:31.0750
53945394
IBX$SESSIONID = 1
53955395
IBX$TRANSACTIONID = 13
53965396
IBX$OLDTRANSACTIONID = 12
53975397
IBX$USER = SYSDBA (Charset Id = 4 Codepage = 65001)
5398-
IBX$CREATED = 2025/03/30 11:16:25.0670
5398+
IBX$CREATED = 2025/08/09 11:29:31.0930
53995399

54005400
Journal Entries
54015401
Journal Entry = jeTransStart(Transaction Start)

‎testsuite/FB5reference.log‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -715,13 +715,13 @@ Running Test 3: ad hoc queries
715715
Opening inet://localhost/employee
716716
Database Open
717717
Employee Count = 42
718-
Transaction ID = 1842
718+
Transaction ID = 2745
719719
Transaction is Read/Write
720720
Transaction Database Path = inet://localhost/employee
721-
Transaction ID = 1842
722-
Oldest Interesting = 1840
723-
Oldest Action = 1841
724-
Oldest Snapshot = 1841
721+
Transaction ID = 2745
722+
Oldest Interesting = 2743
723+
Oldest Action = 2744
724+
Oldest Snapshot = 2744
725725
Oldest Snapshot Number = 2
726726
Lock Timeout = 0
727727
Transaction Access = isc_info_tra_readwrite
@@ -3196,12 +3196,12 @@ Async Wait Called
31963196
Event Signalled
31973197
First Event - usually ignored
31983198
Signal Event
3199-
Event Signalled
32003199
Event Counts: TESTEVENT, Count = 1
32013200
Two more events
32023201
Call Async Wait
32033202
Async Wait Called
32043203
Event Signalled
3204+
Event Signalled
32053205
Deferred Events Caught
32063206
Event Counts: TESTEVENT, Count = 2
32073207
Signal Event
@@ -4724,12 +4724,12 @@ BigNumber = 1234561234567.123456
47244724
Special = 0
47254725
Places = 6
47264726
Digits = 12 34 56 12 34 56 71 23 45 60
4727-
BiggerNumber = 11123456123456123456123456123456.1235
4727+
BiggerNumber = 11123456123456123456123456123456.1234
47284728
Precision = 36
47294729
Sign = 0
47304730
Special = 0
47314731
Places = 4
4732-
Digits = 11 12 34 56 12 34 56 12 34 56 12 34 56 12 34 56 12 35
4732+
Digits = 11 12 34 56 12 34 56 12 34 56 12 34 56 12 34 56 12 34
47334733
BigInteger = Null
47344734

47354735
RowID = 4
@@ -5452,12 +5452,12 @@ IBX$SESSIONID = 1
54525452
IBX$TRANSACTIONID = 11
54535453
IBX$OLDTRANSACTIONID = NULL
54545454
IBX$USER = SYSDBA (Charset Id = 4 Codepage = 65001)
5455-
IBX$CREATED = 2025/03/30 11:17:25.8520
5455+
IBX$CREATED = 2025/08/09 11:28:20.8120
54565456
IBX$SESSIONID = 1
54575457
IBX$TRANSACTIONID = 13
54585458
IBX$OLDTRANSACTIONID = 12
54595459
IBX$USER = SYSDBA (Charset Id = 4 Codepage = 65001)
5460-
IBX$CREATED = 2025/03/30 11:17:25.8860
5460+
IBX$CREATED = 2025/08/09 11:28:20.8360
54615461

54625462
Journal Entries
54635463
Journal Entry = jeTransStart(Transaction Start)

‎testsuite/testApp/TestApplication.pas‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1604,6 +1604,7 @@ procedure TTestApplication.SetFormatSettings;
16041604
ShortDateFormat := 'dd/m/yyyy';
16051605
LongTimeFormat := 'HH:MM:SS';
16061606
DateSeparator := '/';
1607+
DecimalSeparator := '.';
16071608
end;
16081609
end;
16091610

‎testsuite/testsuite.lpi‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@
2828
</PublishOptions>
2929
<RunParams>
3030
<local>
31-
<CommandLineParams Value="-t 19"/>
31+
<CommandLineParams Value="-t 18"/>
3232
</local>
3333
<environment>
3434
<UserOverrides Count="3">
@@ -41,7 +41,7 @@
4141
<Modes Count="1">
4242
<Mode0 Name="default">
4343
<local>
44-
<CommandLineParams Value="-t 19"/>
44+
<CommandLineParams Value="-t 18"/>
4545
</local>
4646
<environment>
4747
<UserOverrides Count="3">

0 commit comments

Comments
 (0)