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

# revisions: 44530,44531,44634,45363,45494,46756,46065

Browse Source 
git-svn-id: branches/fixes_3_2@47086 -
This commit is contained in:
marco 2020-10-11 13:26:22 +00:00
parent b711f33631
commit 4dc972ceee
7 changed files with 46 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
packages/fcl-db/src/base/bufdataset.pas
View File

@ -998,10 +998,13 @@ procedure TCustomBufDataset.SetPacketRecords(aValue : integer);
begin
if (aValue = -1) or (aValue > 0) then
begin
if (IndexFieldNames='') then
if (IndexFieldNames<>'') and (aValue<>-1) then
DatabaseError(SInvPacketRecordsValueFieldNames)
else
if UniDirectional and (aValue=-1) then
DatabaseError(SInvPacketRecordsValueUniDirectional)
else
FPacketRecords := aValue
else if AValue<>-1 then
DatabaseError(SInvPacketRecordsValueFieldNames);
end
else
DatabaseError(SInvPacketRecordsValue);

1
packages/fcl-db/src/base/dbconst.pas
View File

@ -85,6 +85,7 @@ Resourcestring
SUnsupportedFieldType = 'Fieldtype %s is not supported';
SInvPacketRecordsValue = 'PacketRecords has to be larger then 0';
SInvPacketRecordsValueFieldNames = 'PacketRecords must be -1 if IndexFieldNames is set';
SInvPacketRecordsValueUniDirectional = 'PacketRecords must not be -1 on an unidirectional dataset';
SInvalidSearchFieldType = 'Searching in fields of type %s is not supported';
SDatasetEmpty = 'The dataset is empty';
SFieldIsNull = 'The field is null';

2
packages/fcl-db/src/base/dsparams.inc
View File

@ -389,7 +389,7 @@ begin
else
begin
ParamNameStart:=p;
while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|'])) do
while not (p^ in (SQLDelimiterCharacters+[#0,'=','+','-','*','\','/','[',']','|','<','>'])) do
Inc(p);
ParamName:=Copy(ParamNameStart,1,p-ParamNameStart);
end;

2
packages/fcl-db/src/codegen/fpcgdbcoll.pp
View File

@ -88,7 +88,6 @@ Type
Procedure DoGenerateImplementation(Strings: TStrings); override;
procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); override;
procedure CreateImplementation(Strings: TStrings); override;
Class Function NeedsFieldDefs : Boolean; override;
Function CreateOptions : TCodeGeneratorOptions; override;
//
// New methods
@ -116,6 +115,7 @@ Type
// Code to Load object from fataset (should check usefieldmap)
procedure CreateObjectLoadFromDataset(Strings: TStrings; const ObjectClassName: String); virtual;
Public
Class Function NeedsFieldDefs : Boolean; override;
procedure CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName,
MapAncestorName: String);
procedure CreateListDeclaration(Strings: TStrings; ListMode: TListMode;

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

@ -164,6 +164,7 @@ uses
const
SQL_BOOLEAN_INTERBASE = 590;
SQL_BOOLEAN_FIREBIRD = 32764;
SQL_NULL = 32767;
INVALID_DATA = -1;
procedure TIBConnection.CheckError(ProcName : string; Status : PISC_STATUS);
@ -834,7 +835,7 @@ begin
begin
if ((SQLType and not 1) = SQL_VARYING) then
SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen+2)
else
else if SQLType <> SQL_NULL then
SQLData := AllocMem(in_SQLDA^.SQLVar[x].SQLLen);
// Always force the creation of slqind for parameters. It could be
// that a database trigger takes care of inserting null values, so
@ -1211,7 +1212,8 @@ begin
SQL_BOOLEAN_FIREBIRD:
PByte(VSQLVar^.SQLData)^ := Byte(AParam.AsBoolean);
else
DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
if (VSQLVar^.sqltype <> SQL_NULL) then
DatabaseErrorFmt(SUnsupportedParameter,[FieldTypeNames[AParam.DataType]],self);
end {case}
end;
end;

9
packages/fcl-db/src/sqldb/odbc/odbcconn.pas
View File

@ -999,7 +999,14 @@ begin
SQL_TINYINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
SQL_BIGINT: begin FieldType:=ftLargeint; FieldSize:=0; end;
SQL_BINARY: begin FieldType:=ftBytes; FieldSize:=ColumnSize; end;
SQL_VARBINARY: begin FieldType:=ftVarBytes; FieldSize:=ColumnSize; end;
SQL_VARBINARY:
begin
FieldSize:=ColumnSize;
if FieldSize=BLOB_BUF_SIZE then // SQL_VARBINARY declared as VARBINARY(MAX) must be ftBlob - variable data size
FieldType:=ftBlob
else
FieldType:=ftVarBytes;
end;
SQL_LONGVARBINARY: begin FieldType:=ftBlob; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
SQL_TYPE_DATE: begin FieldType:=ftDate; FieldSize:=0; end;
SQL_SS_TIME2,

25
packages/fcl-db/tests/testsqldb.pas
View File

@ -60,6 +60,7 @@ type
procedure TestReturningUpdate;
procedure TestMacros;
Procedure TestPrepareCount;
Procedure TestNullTypeParam;
end;
{ TTestTSQLConnection }
@ -797,6 +798,30 @@ begin
end;
procedure TTestTSQLQuery.TestNullTypeParam;
begin
if not (SQLServerType in [ssSQLite, ssFirebird]) then
Ignore(STestNotApplicable);
CreateAndFillIDField;
try
With SQLDBConnector.Query do
begin
UsePrimaryKeyAsKey:=False; // Disable server index defs etc
SQL.Text:='Select ID from FPDEV2 where (:ID IS NULL or ID = :ID)';
Open;
AssertEquals('Correct record count param NULL',10,RecordCount);
Close;
ParamByname('ID').AsInteger:=1;
Open;
AssertEquals('Correct record count param 1',1,RecordCount);
AssertEquals('Correct field value: ',1,Fields[0].AsInteger);
Close;
end;
finally
SQLDBConnector.Connection.OnLog:=Nil;
end;
end;
{ TTestTSQLConnection }