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

fcl-db: sqlite: map INTEGER PRIMARY KEY columns (ROWID) to TAutoIncField (as part of adding support for Refreshing AutoInc fields)

Browse Source 
Update tests (use as test table FPDEV2, which is automatically removed at end of test, remove unused variables)

git-svn-id: trunk@29243 -
This commit is contained in:
lacak 2014-12-10 07:31:58 +00:00
parent 8f4430e795
commit 6c10d2ddad
3 changed files with 79 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
View File

@ -67,12 +67,12 @@ type
procedure PrepareStatement(cursor: TSQLCursor; ATransaction : TSQLTransaction; buf: string; AParams : TParams); override;
procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); override;
function Fetch(cursor : TSQLCursor) : boolean; override;
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TFieldDefs); override;
procedure UnPrepareStatement(cursor : TSQLCursor); override;
procedure FreeFldBuffers(cursor : TSQLCursor); override;
function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
function LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; override;
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
function GetTransactionHandle(trans : TSQLHandle): pointer; override;
function Commit(trans : TSQLHandle) : boolean; override;
@ -193,8 +193,9 @@ begin
if P.IsNull then
checkerror(sqlite3_bind_null(fstatement,I))
else
case P.datatype of
case P.DataType of
ftInteger,
ftAutoInc,
ftBoolean,
ftSmallint: checkerror(sqlite3_bind_int(fstatement,I,P.AsInteger));
ftWord: checkerror(sqlite3_bind_int(fstatement,I,P.AsWord));
@ -304,7 +305,7 @@ begin
FieldNameQuoteChars:=DoubleQuotes;
end;
procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
procedure TSQLite3Connection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
var
int1: integer;
@ -425,16 +426,31 @@ Const
}
);
procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor;
FieldDefs: TfieldDefs);
procedure TSQLite3Connection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs);
var
i : integer;
FN,FD : string;
ft1 : tfieldtype;
i, fi : integer;
FN, FD, PrimaryKeyFields : string;
ft1 : TFieldType;
size1, size2 : integer;
fi : integer;
st : psqlite3_stmt;
function GetPrimaryKeyFields: string;
var IndexDefs: TServerIndexDefs;
i: integer;
begin
if FieldDefs.Dataset is TSQLQuery then
begin
IndexDefs := (FieldDefs.DataSet as TSQLQuery).ServerIndexDefs;
for i:=IndexDefs.Count-1 downto 0 do
if ixPrimary in IndexDefs[i].Options then
begin
Result := IndexDefs[i].Fields;
Exit;
end;
end;
Result := '';
end;
function ExtractPrecisionAndScale(decltype: string; var precision, scale: integer): boolean;
var p: integer;
begin
@ -460,6 +476,7 @@ var
end;
begin
PrimaryKeyFields := GetPrimaryKeyFields;
st:=TSQLite3Cursor(cursor).fstatement;
for i:= 0 to sqlite3_column_count(st) - 1 do
begin
@ -472,6 +489,10 @@ begin
ft1:=FieldMap[fi].t;
break;
end;
// Column declared as INTEGER PRIMARY KEY [AUTOINCREMENT] becomes ROWID for given table
// declared data type must be INTEGER (not INT, BIGINT, NUMERIC etc.)
if (FD='INTEGER') and SameText(FN, PrimaryKeyFields) then
ft1:=ftAutoInc;
// In case of an empty fieldtype (FD='', which is allowed and used in calculated
// columns (aggregates) and by pragma-statements) or an unknown fieldtype,
// use the field's affinity:
@ -506,9 +527,9 @@ begin
else if (size2-size1>MaxBCDPrecision-MaxBCDScale) or (size1>MaxBCDScale) then
ft1:=ftFmtBCD;
end;
ftUnknown : DatabaseError('Unknown record type: '+FN);
ftUnknown : DatabaseErrorFmt('Unknown or unsupported data type %s of column %s', [FD, FN]);
end; // Case
Fielddefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
FieldDefs.Add(FieldDefs.MakeNameUnique(FN),ft1,size1,false,i+1);
end;
end;
@ -617,7 +638,7 @@ begin
Result:=ComposeDateTime(ParseSQLiteDate(DS),ParseSQLiteTime(TS,False));
end;
function TSQLite3Connection.LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
function TSQLite3Connection.LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
var
st1: TStorageType;
@ -636,7 +657,8 @@ begin
result:= st1 <> stnull;
if Not result then
Exit;
case FieldDef.datatype of
case FieldDef.DataType of
ftAutoInc,
ftInteger : pinteger(buffer)^ := sqlite3_column_int(st,fnum);
ftSmallInt : psmallint(buffer)^ := sqlite3_column_int(st,fnum);
ftWord : pword(buffer)^ := sqlite3_column_int(st,fnum);

2
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -833,7 +833,7 @@ begin
begin
datatype:='INTEGER PRIMARY KEY';
values:='DEFAULT VALUES';
fieldtype:=ftInteger;
fieldtype:=ftAutoInc;
updatable:=true;
end;
ssPostgreSQL:

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

@ -185,7 +185,7 @@ end;
Procedure TTestTSQLQuery.TestKeepOpenOnCommit;
var Q: TSQLQuery;
I, J : Integer;
I: Integer;
begin
// Test that for a SQL query with Options=sqoKeepOpenOnCommit, calling commit does not close the dataset.
// Test also that an edit still works.
@ -216,7 +216,7 @@ begin
Q.Close;
Q.SQL.Text:='select * from testdiscon where (id=20) and (a=''abc'')';
Q.Open;
AssertTrue('Have modified data record in database',not (Q.EOF AND Q.BOF));
AssertTrue('Have modified data record in database', not (Q.EOF AND Q.BOF));
end;
end;
@ -266,7 +266,7 @@ end;
Procedure TTestTSQLQuery.TestAutoApplyUpdatesPost;
var Q: TSQLQuery;
I, J : Integer;
I: Integer;
begin
// Test that if sqoAutoApplyUpdates is in QueryOptions, then POST automatically does an ApplyUpdates
// Test also that POST afterpost event is backwards compatible.
@ -303,7 +303,7 @@ end;
Procedure TTestTSQLQuery.TestAutoApplyUpdatesDelete;
var Q: TSQLQuery;
I, J : Integer;
I: Integer;
begin
// Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
with SQLDBConnector do
@ -341,7 +341,7 @@ end;
Procedure TTestTSQLQuery.TestCheckRowsAffected;
var Q: TSQLQuery;
I, J : Integer;
I: Integer;
begin
// Test that if sqoAutoApplyUpdates is in QueryOptions, then Delete automatically does an ApplyUpdates
with SQLDBConnector do
@ -367,7 +367,7 @@ end;
Procedure TTestTSQLQuery.TestAutoCommit;
var
I, J : Integer;
I : Integer;
begin
with SQLDBConnector do
begin
@ -399,8 +399,7 @@ end;
Procedure TTestTSQLQuery.TestRefreshSQL;
var
Q: TSQLQuery;
T : TSQLTransaction;
I, J : Integer;
begin
with SQLDBConnector do
begin
@ -427,8 +426,6 @@ Procedure TTestTSQLQuery.TestGeneratedRefreshSQL;
var
Q: TSQLQuery;
T : TSQLTransaction;
I, J : Integer;
begin
with SQLDBConnector do
@ -461,8 +458,6 @@ end;
Procedure TTestTSQLQuery.TestGeneratedRefreshSQL1Field;
var
Q: TSQLQuery;
T : TSQLTransaction;
I, J : Integer;
begin
with SQLDBConnector do
@ -569,27 +564,46 @@ begin
end;
Procedure TTestTSQLQuery.TestFetchAutoInc;
var datatype: string;
id: largeint;
begin
with SQLDBConnector do
begin
if not (sqLastInsertID in Connection.ConnOptions) then
Ignore(STestNotApplicable);
TryDropIfExist('testautoinc');
// Syntax may vary. This works for MySQL.
ExecuteDirect('create table testautoinc (id integer auto_increment, a varchar(5), constraint PK_AUTOINC primary key(id))');
case SQLServerType of
ssMySQL:
datatype := 'integer auto_increment';
ssSQLite:
datatype := 'integer';
else
Ignore(STestNotApplicable);
end;
TryDropIfExist('FPDEV2');
ExecuteDirect('create table FPDEV2 (id '+datatype+' primary key, f varchar(5))');
CommitDDL;
end;
FMyQ:=SQLDBConnector.Query;
FMyQ.SQL.Text:='select * from testautoinc';
FMyQ.Open;
FMyQ.Insert;
FMyQ.FieldByName('a').AsString:='b';
FMyQ.Post;
AssertTrue('ID field null after post',FMyQ.FieldByname('id').IsNull);
FMyQ.ApplyUpdates(0);
AssertTrue('ID field no longer null after applyupdates',Not FMyQ.FieldByname('id').IsNull);
// Should be 1 after the table was created, but this is not guaranteed... So we just test positive values.
AssertTrue('ID field has positive value',FMyQ.FieldByname('id').AsLargeInt>0);
with SQLDBConnector.Query do
begin
SQL.Text:='select * from FPDEV2';
Open;
Insert;
FieldByName('f').AsString:='a';
Post;
Append;
FieldByName('f').AsString:='b';
Post;
AssertTrue('ID field is not null after Post', FieldByName('id').IsNull);
First;
ApplyUpdates(0);
AssertTrue('ID field is still null after ApplyUpdates', Not FieldByName('id').IsNull);
// Should be 1 after the table was created, but this is not guaranteed... So we just test positive values.
id := FieldByName('id').AsLargeInt;
AssertTrue('ID field has not positive value', id>0);
Next;
AssertTrue('Next ID value is not greater than previous', FieldByName('id').AsLargeInt>id);
end;
end;
@ -645,7 +659,7 @@ procedure TTestTSQLConnection.TestImplicitTransactionOK;
var
Q : TSQLQuery;
T : TSQLTransaction;
I, J : Integer;
I : Integer;
begin
with SQLDBConnector do
begin