paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 11:18:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add support for int128 integers. Patch by Lacak, fixes issue #41178

Browse Source
This commit is contained in:
Michaël Van Canneyt 2025-03-07 09:07:15 +01:00
parent 7210366766
commit 6215d7e8d2
2 changed files with 43 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -195,11 +195,6 @@ uses
StrUtils, FmtBCD;
{$ENDIF FPC_DOTTEDUNITS}
const
SQL_BOOLEAN_INTERBASE = 590;
SQL_BOOLEAN_FIREBIRD = 32764;
SQL_NULL = 32767;
INVALID_DATA = -1;
procedure TIBConnection.CheckError(const ProcName : string; Status : PISC_STATUS);
@ -804,6 +799,9 @@ begin
TrType := ftFloat;
SQL_BOOLEAN_INTERBASE, SQL_BOOLEAN_FIREBIRD :
TrType := ftBoolean;
SQL_INT128,
SQL_DEC16, SQL_DEC34:
TrType := ftFmtBCD;
else
TrType := ftUnknown;
end;
@ -1083,7 +1081,7 @@ begin
TranslateFldType(PSQLVar^.SQLType, PSQLVar^.sqlsubtype, PSQLVar^.SQLLen, PSQLVar^.SQLScale,
TransType, TransLen, TransPrec);
// [var]AnsiChar or blob column character set NONE or OCTETS overrides connection charset
// [var]char or blob column character set NONE or OCTETS overrides connection charset
if (((TransType in [ftString, ftFixedChar]) and (PSQLVar^.sqlsubtype and $FF in [CS_NONE,CS_BINARY])) and not UseConnectionCharSetIfNone)
or
((TransType = ftMemo) and (PSQLVar^.relname_length>0) and (PSQLVar^.sqlname_length>0) and (GetBlobCharset(@PSQLVar^.relname,@PSQLVar^.sqlname) in [CS_NONE,CS_BINARY])) then
@ -1200,6 +1198,7 @@ var
li : LargeInt;
CurrBuff : PAnsiChar;
w : word;
i128 : Int128Rec;
begin
{$push}
@ -1283,6 +1282,15 @@ begin
SetDateTime(VSQLVar^.SQLData, AParam.AsDateTime, VSQLVar^.SQLType);
SQL_BOOLEAN_FIREBIRD:
PByte(VSQLVar^.SQLData)^ := Byte(AParam.AsBoolean);
SQL_INT128:
begin
i128 := BCDToInt128(AParam.AsFMTBCD);
Move(i128, VSQLVar^.SQLData^, VSQLVar^.SQLLen);
end;
SQL_DEC16:
begin
// ToDo
end;
else
if (VSQLVar^.sqltype <> SQL_NULL) then
DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
@ -1294,12 +1302,14 @@ end;
function TIBConnection.LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
type
PInt128Rec = ^Int128Rec;
var
VSQLVar : PXSQLVAR;
VarcharLen : word;
CurrBuff : PAnsiChar;
c : currency;
AFmtBcd : tBCD;
CurrBuff : PAnsiChar;
c : currency;
AFmtBcd : tBCD;
function BcdDivPower10(Dividend: largeint; e: integer): TBCD;
var d: double;
@ -1358,15 +1368,22 @@ begin
end;
ftFMTBcd :
begin
case VSQLVar^.SQLLen of
2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -VSQLVar^.SQLScale);
4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^, -VSQLVar^.SQLScale);
8 : if Dialect < 3 then
AFmtBcd := PDouble(CurrBuff)^
else
AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -VSQLVar^.SQLScale);
case (VSQLVar^.sqltype and not 1) of
SQL_DEC16:
// ToDo
AFmtBcd := 0;
else
Result := False; // Just to be sure, in principle this will never happen
case VSQLVar^.SQLLen of
2 : AFmtBcd := BcdDivPower10(PSmallint(CurrBuff)^, -VSQLVar^.SQLScale);
4 : AFmtBcd := BcdDivPower10(PLongint(CurrBuff)^, -VSQLVar^.SQLScale);
8 : if Dialect < 3 then
AFmtBcd := PDouble(CurrBuff)^
else
AFmtBcd := BcdDivPower10(PLargeint(CurrBuff)^, -VSQLVar^.SQLScale);
16: AFmtBcd := Int128ToBcd(PInt128Rec(CurrBuff)^);
else
Result := False; // Just to be sure, in principle this will never happen
end; {case}
end; {case}
Move(AFmtBcd, buffer^ , sizeof(AFmtBcd));
end;

9
packages/ibase/src/ibase60.inc
View File

@ -1657,6 +1657,15 @@ type
SQL_INT64 = 580;
{ Historical alias for pre V6 applications }
SQL_DATE = SQL_TIMESTAMP;
// Moved here from ibconnection
SQL_BOOLEAN_INTERBASE = 590;
SQL_INT128 = 32752;
SQL_DEC16 = 32760;
SQL_DEC34 = 32762;
SQL_BOOLEAN_FIREBIRD = 32764;
SQL_NULL = 32767;
INVALID_DATA = -1;
{ }
{ Blob Subtypes }
{ }