diff --git a/.gitattributes b/.gitattributes index 02a6b2cdaf..957abeb1e1 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2212,6 +2212,7 @@ packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain packages/fcl-db/tests/testleaks.sh svneol=native#text/plain packages/fcl-db/tests/testspecifictbufdataset.pas svneol=native#text/plain packages/fcl-db/tests/testspecifictdbf.pas svneol=native#text/plain +packages/fcl-db/tests/testsqldb.pas svneol=native#text/pascal packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp index 70e0c8fc5d..32cd6ccf2f 100644 --- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp +++ b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp @@ -1385,6 +1385,11 @@ begin if not assigned(Transaction) then DatabaseError(SErrConnTransactionnSet); + if (length(TableName)>2) and (TableName[1]='"') and (TableName[length(TableName)]='"') then + TableName := AnsiDequotedStr(TableName, '"') + else + TableName := UpperCase(TableName); + qry := tsqlquery.Create(nil); qry.transaction := Transaction; qry.database := Self; @@ -1408,7 +1413,7 @@ begin 'rel_con.rdb$index_name = ind.rdb$index_name '+ 'where '+ '(ind_seg.rdb$index_name = ind.rdb$index_name) and '+ - '(ind.rdb$relation_name=''' + UpperCase(TableName) +''') '+ + '(ind.rdb$relation_name=' + QuotedStr(TableName) + ') '+ 'order by '+ 'ind.rdb$index_name;'); open; diff --git a/packages/fcl-db/src/sqldb/odbc/odbcconn.pas b/packages/fcl-db/src/sqldb/odbc/odbcconn.pas index b27237188a..3d4ec584fb 100644 --- a/packages/fcl-db/src/sqldb/odbc/odbcconn.pas +++ b/packages/fcl-db/src/sqldb/odbc/odbcconn.pas @@ -1284,6 +1284,7 @@ end; procedure TODBCConnection.UpdateIndexDefs(IndexDefs: TIndexDefs; TableName: string); var + Len: integer; StmtHandle:SQLHSTMT; Res:SQLRETURN; IndexDef: TIndexDef; @@ -1299,6 +1300,13 @@ var const DEFAULT_NAME_LEN = 255; begin + Len := length(TableName); + if Len > 2 then + if (TableName[1] in ['"','`']) and (TableName[Len] in ['"','`']) then + TableName := AnsiDequotedStr(TableName, TableName[1]) + else if (TableName[1] in ['[']) and (TableName[Len] in [']']) then + TableName := copy(TableName, 2, Len-2); + // allocate statement handle StmtHandle := SQL_NULL_HANDLE; ODBCCheckResult( diff --git a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp index ce1907ed7c..322cb37e0c 100644 --- a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp +++ b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp @@ -1041,11 +1041,17 @@ end; procedure TPQConnection.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); var qry : TSQLQuery; + relname : string; begin if not assigned(Transaction) then DatabaseError(SErrConnTransactionnSet); + if (length(TableName)>2) and (TableName[1]='"') and (TableName[length(TableName)]='"') then + relname := QuotedStr(AnsiDequotedStr(TableName, '"')) + else + relname := 'lower(' + QuotedStr(TableName) + ')'; // unquoted names are stored lower case in PostgreSQL which is incompatible with the SQL standard + qry := tsqlquery.Create(nil); qry.transaction := Transaction; qry.database := Self; @@ -1072,7 +1078,7 @@ begin '(ia.attrelid = i.indexrelid) and '+ '(ic.oid = i.indexrelid) and '+ '(ta.attnum = i.indkey[ia.attnum-1]) and '+ - '(upper(tc.relname)=''' + UpperCase(TableName) +''') '+ + '(tc.relname = ' + relname + ') '+ 'order by '+ 'ic.relname;'); open; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 4be67d9f9f..53250c8984 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -1579,8 +1579,7 @@ begin FreeFldBuffers; // Some SQLConnections does not support statement [un]preparation, // so let them do cleanup f.e. cancel pending queries and/or free resultset - if not FStatement.Prepared then - FStatement.DoUnprepare; + if not Prepared then FStatement.DoUnprepare; end else begin @@ -1892,8 +1891,9 @@ begin Execute; finally // Cursor has to be assigned, or else the prepare went wrong before PrepareStatment was - // called, so UnPrepareStatement shoudn't be called either - if (not IsPrepared) and (assigned(database)) and (assigned(Cursor)) then TSQLConnection(database).UnPrepareStatement(Cursor); + // called, so UnPrepareStatement shoudn't be called either + // Don't deallocate cursor; f.e. RowsAffected is requested later + if not Prepared and (assigned(Database)) and (assigned(Cursor)) then TSQLConnection(Database).UnPrepareStatement(Cursor); end; end; @@ -1983,6 +1983,7 @@ begin inherited OnChangeSQL(Sender); If CheckParams and Assigned(FMasterLink) then FMasterLink.RefreshParamNames; + FQuery.ServerIndexDefs.Updated:=false; end; destructor TQuerySQLStatement.Destroy; diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas index 20337d8771..a78ea2ff7c 100644 --- a/packages/fcl-db/tests/sqldbtoolsunit.pas +++ b/packages/fcl-db/tests/sqldbtoolsunit.pas @@ -23,54 +23,13 @@ type TSQLConnType = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql,sybase); TSQLServerType = (ssFirebird, ssInterbase, ssMSSQL, ssMySQL, ssOracle, ssPostgreSQL, ssSQLite, ssSybase, ssUnknown); -const MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55]; - SQLConnTypesNames : Array [TSQLConnType] of String[19] = +const + MySQLConnTypes = [mysql40,mysql41,mysql50,mysql51,mysql55]; + SQLConnTypesNames : Array [TSQLConnType] of String[19] = ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL','SYBASE'); - FieldtypeDefinitionsConst : Array [TFieldType] of String[20] = - ( - '', - 'VARCHAR(10)', - 'SMALLINT', - 'INTEGER', - '', // ftWord - 'BOOLEAN', - 'DOUBLE PRECISION', // ftFloat - '', // ftCurrency - 'DECIMAL(18,4)',// ftBCD - 'DATE', - 'TIME', - 'TIMESTAMP', // ftDateTime - '', // ftBytes - '', // ftVarBytes - '', // ftAutoInc - 'BLOB', // ftBlob - 'BLOB', // ftMemo - 'BLOB', // ftGraphic - '', - '', - '', - '', - '', - 'CHAR(10)', // ftFixedChar - '', // ftWideString - 'BIGINT', // ftLargeInt - '', - '', - '', - '', - '', - '', - '', - '', - '', - '', // ftGuid - 'TIMESTAMP', // ftTimestamp - 'NUMERIC(18,6)',// ftFmtBCD - '', // ftFixedWideChar - '' // ftWideMemo - ); - + STestNotApplicable = 'This test does not apply to this sqldb-connection type'; + type { TSQLDBConnector } @@ -96,6 +55,7 @@ type public destructor Destroy; override; constructor Create; override; + procedure ExecuteDirect(const SQL: string); procedure CommitDDL; property Connection : TSQLConnection read FConnection; property Transaction : TSQLTransaction read FTransaction; @@ -117,6 +77,50 @@ type end; const + FieldtypeDefinitionsConst : Array [TFieldType] of String[20] = + ( + '', + 'VARCHAR(10)', + 'SMALLINT', + 'INTEGER', + '', // ftWord + 'BOOLEAN', + 'DOUBLE PRECISION', // ftFloat + '', // ftCurrency + 'DECIMAL(18,4)',// ftBCD + 'DATE', + 'TIME', + 'TIMESTAMP', // ftDateTime + '', // ftBytes + '', // ftVarBytes + '', // ftAutoInc + 'BLOB', // ftBlob + 'BLOB', // ftMemo + 'BLOB', // ftGraphic + '', + '', + '', + '', + '', + 'CHAR(10)', // ftFixedChar + '', // ftWideString + 'BIGINT', // ftLargeInt + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', // ftGuid + 'TIMESTAMP', // ftTimestamp + 'NUMERIC(18,6)',// ftFmtBCD + '', // ftFixedWideChar + '' // ftWideMemo + ); + // names as returned by ODBC SQLGetInfo(..., SQL_DBMS_NAME, ...) and GetConnectionInfo(citServerType) SQLServerTypesMap : array [0..7] of TSQLServerTypesMapItem = ( (s: 'Firebird'; t: ssFirebird), @@ -239,7 +243,7 @@ begin end; ssPostgreSQL: begin - FieldtypeDefinitions[ftCurrency] := 'MONEY'; + FieldtypeDefinitions[ftCurrency] := 'MONEY'; // ODBC?! FieldtypeDefinitions[ftBlob] := 'BYTEA'; FieldtypeDefinitions[ftMemo] := 'TEXT'; FieldtypeDefinitions[ftGraphic] := ''; @@ -320,7 +324,7 @@ begin database := Fconnection; end; -Function TSQLDBConnector.CreateQuery : TSQLQuery; +function TSQLDBConnector.CreateQuery: TSQLQuery; begin Result := TSQLQuery.create(nil); @@ -512,6 +516,11 @@ begin end; end; +procedure TSQLDBConnector.ExecuteDirect(const SQL: string); +begin + Connection.ExecuteDirect(SQL); +end; + procedure TSQLDBConnector.CommitDDL; begin // Commits schema definition and manipulation statements; diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index cd3bc39049..fb9d3fd01b 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/packages/fcl-db/tests/testfieldtypes.pas @@ -164,8 +164,6 @@ const '', #0, #0#1#2#3#4#5#6#7#8#9 ); - STestNotApplicable = 'This test does not apply to this sqldb-connection type'; - procedure TTestFieldTypes.TestpfInUpdateFlag; var ds : TCustomBufDataset; diff --git a/packages/fcl-db/tests/testsqldb.pas b/packages/fcl-db/tests/testsqldb.pas new file mode 100644 index 0000000000..3024511f79 --- /dev/null +++ b/packages/fcl-db/tests/testsqldb.pas @@ -0,0 +1,158 @@ +unit TestSQLDB; + +{ + Unit tests which are specific to the sqlDB components like TSQLQuery, TSQLConnection. +} + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testregistry, + db; + +type + + { TTestTSQLQuery } + + TTestTSQLQuery = class(TTestCase) + private + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure TestUpdateServerIndexDefs; + end; + + { TTestTSQLConnection } + + TTestTSQLConnection = class(TTestCase) + private + protected + procedure SetUp; override; + procedure TearDown; override; + published + procedure ReplaceMe; + end; + + +implementation + +uses sqldbtoolsunit, toolsunit, sqldb; + +{ TTestTSQLQuery } + +procedure TTestTSQLQuery.TestUpdateServerIndexDefs; +var Q: TSQLQuery; + name1, name2, name3: string; +begin + // Test retrieval of information about indexes on unquoted and quoted table names + // (tests also case-sensitivity for DB's that support case-sensitivity of quoted identifiers) + // For ODBC Firebird/Interbase we must define primary key as named constraint and + // in ODBC driver must be set: "quoted identifiers" and "sensitive identifier" + // See also: TTestFieldTypes.TestUpdateIndexDefs + with TSQLDBConnector(DBConnector) do + begin + // SQLite ignores case-sensitivity of quoted table names + // MS SQL Server case-sensitivity of identifiers depends on the case-sensitivity of default collation of the database + // MySQL case-sensitivity depends on case-sensitivity of server's file system + if SQLServerType in [ssMSSQL,ssSQLite{$IFDEF WINDOWS},ssMySQL{$ENDIF}] then + name1 := Connection.FieldNameQuoteChars[0]+'fpdev 2'+Connection.FieldNameQuoteChars[1] + else + name1 := 'FPDEV2'; + ExecuteDirect('create table '+name1+' (id integer not null, constraint PK_FPDEV21 primary key(id))'); + // same but quoted table name + name2 := Connection.FieldNameQuoteChars[0]+'FPdev2'+Connection.FieldNameQuoteChars[1]; + ExecuteDirect('create table '+name2+' (ID2 integer not null, constraint PK_FPDEV22 primary key(ID2))'); + // embedded quote in table name + if SQLServerType in [ssMySQL] then + name3 := '`FPdev``2`' + else + name3 := Connection.FieldNameQuoteChars[0]+'FPdev""2'+Connection.FieldNameQuoteChars[1]; + ExecuteDirect('create table '+name3+' (Id3 integer not null, constraint PK_FPDEV23 primary key(Id3))'); + CommitDDL; + end; + + try + Q := TSQLDBConnector(DBConnector).Query; + Q.SQL.Text:='select * from '+name1; + Q.Prepare; + Q.ServerIndexDefs.Update; + CheckEquals(1, Q.ServerIndexDefs.Count); + + Q.SQL.Text:='select * from '+name2; + Q.Prepare; + Q.ServerIndexDefs.Update; + CheckEquals(1, Q.ServerIndexDefs.Count, '2.1'); + CheckTrue(CompareText('ID2', Q.ServerIndexDefs[0].Fields)=0, '2.2'+Q.ServerIndexDefs[0].Fields); + CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '2.3'); + + Q.SQL.Text:='select * from '+name3; + Q.Prepare; + Q.ServerIndexDefs.Update; + CheckEquals(1, Q.ServerIndexDefs.Count, '3.1'); + CheckTrue(CompareText('ID3', Q.ServerIndexDefs[0].Fields)=0, '3.2'); + CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '3.3'); + finally + Q.UnPrepare; + with TSQLDBConnector(DBConnector) do + begin + ExecuteDirect('DROP TABLE '+name1); + ExecuteDirect('DROP TABLE '+name2); + ExecuteDirect('DROP TABLE '+name3); + CommitDDL; + end; + end; +end; + +{ TTestTSQLConnection } + +procedure TTestTSQLConnection.ReplaceMe; +begin + // replace this procedure with any test for TSQLConnection +end; + + +procedure TTestTSQLQuery.SetUp; +begin + inherited; + InitialiseDBConnector; + DBConnector.StartTest; +end; + +procedure TTestTSQLConnection.SetUp; +begin + inherited; + InitialiseDBConnector; + DBConnector.StartTest; +end; + +procedure TTestTSQLQuery.TearDown; +begin + DBConnector.StopTest; + if assigned(DBConnector) then + with TSQLDBConnector(DBConnector) do + Transaction.Rollback; + FreeDBConnector; + inherited; +end; + +procedure TTestTSQLConnection.TearDown; +begin + DBConnector.StopTest; + if assigned(DBConnector) then + with TSQLDBConnector(DBConnector) do + Transaction.Rollback; + FreeDBConnector; + inherited; +end; + + +initialization + if uppercase(dbconnectorname)='SQL' then + begin + RegisterTest(TTestTSQLQuery); + RegisterTest(TTestTSQLConnection); + end; +end.