fcl-db: sqldb:

- handle quoted table names when retrieving server index informations for quoted TableName
- reset updated flag of ServerIndexDefs when SQL.Text changes
- new tests unit for sqlDB
- tested for FB, MSSQL, MySQL, PostgreSQL, Sqlite, odbc_MSSQL, odbc_PostgreSQL, odbc_Firebird, odbc_MySQL

git-svn-id: trunk@24880 -

.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

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;

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(

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;

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;

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;

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;

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.