Merged revisions 8463-8466,8469-8470,8472-8483,8486-8488,8490,8493,8496,8506-8507,8510-8511,8513,8535-8537,8539-8546,8553-8554,8560,8575-8576,8581-8587,8590,8593-8594,8596,8599-8600,8605,8607,8625,8630-8638,8640-8641,8645-8646,8659,8665,8667,8681-8682,8686-8687,8702-8703 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r8463 | joost | 2007-09-13 23:35:11 +0200 (Thu, 13 Sep 2007) | 1 line
  
   * Updated readme and database.ini
........
  r8464 | joost | 2007-09-13 23:45:09 +0200 (Thu, 13 Sep 2007) | 1 line
  
   * Renamed database.ini to database.ini.txt
........
  r8465 | joost | 2007-09-13 23:48:58 +0200 (Thu, 13 Sep 2007) | 1 line
  
   * Updated README
........
  r8466 | joost | 2007-09-13 23:52:55 +0200 (Thu, 13 Sep 2007) | 1 line
  
   * Reverted wrongly comitted file in r8465
........
  r8507 | joost | 2007-09-16 18:02:58 +0200 (Sun, 16 Sep 2007) | 1 line
  
   * Only ask the dialect when needed
........
  r8510 | joost | 2007-09-16 18:57:17 +0200 (Sun, 16 Sep 2007) | 1 line
  
   * Only call CheckError if an error has occured
........
  r8511 | joost | 2007-09-16 20:38:54 +0200 (Sun, 16 Sep 2007) | 1 line
  
   * Removed Dialect property from TMySQLxxConnection
........
  r8513 | joost | 2007-09-16 20:57:32 +0200 (Sun, 16 Sep 2007) | 1 line
  
   * Added test for TSQLConnection.GetFieldNames
........
  r8553 | joost | 2007-09-18 19:32:07 +0200 (Tue, 18 Sep 2007) | 1 line
  
   * fix for using ftString-type parameters on datefields + test
........
  r8599 | joost | 2007-09-21 23:39:09 +0200 (Fri, 21 Sep 2007) | 4 lines
  
   * Added some comments
   * Tests are more generic, ie use BLOB for firebird, TEXT for postgresql etc
   * Added support for SQLite3
........
  r8645 | joost | 2007-09-26 00:55:36 +0200 (Wed, 26 Sep 2007) | 2 lines
  
   * Fixed compilation after r8639
   * Initialize FMySQL
........
  r8646 | joost | 2007-09-26 00:59:58 +0200 (Wed, 26 Sep 2007) | 1 line
  
   * Removed tracking of the status of InitialiseMySQL, since InitialiseMySQL handles this itself using a refcount
........
  r8703 | joost | 2007-09-30 22:55:16 +0200 (Sun, 30 Sep 2007) | 1 line
  
   * Fixed mysql ftLargeInt support+test (mantis 9744)
........

git-svn-id: branches/fixes_2_2@8712 -

.gitattributes

@@ -4189,7 +4189,7 @@ packages/fcl-db/src/sqlite/testds.pas svneol=native#text/plain
 packages/fcl-db/tests/Makefile -text
 packages/fcl-db/tests/Makefile.fpc -text
 packages/fcl-db/tests/README.txt svneol=native#text/plain
-packages/fcl-db/tests/database.ini -text
+packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
 packages/fcl-db/tests/dbftoolsunit.pas -text
 packages/fcl-db/tests/dbtestframework.pas -text
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain

packages/fcl-db/src/README

@@ -9,7 +9,7 @@ memds
 
 sqldb
   contains a framework to work with several SQL-based databases
-  as Interbase, Firebird, MySQL, ODBC and Oracle
+  as Interbase, Firebird, MySQL, ODBC, SQLite3 and Oracle
 
 dbase
   contains the tDbf components, to work with DBASE and FoxPro
@@ -22,11 +22,6 @@ sdf
 sqlite
   contains datases classes to use sqlite and sqlite3
 
-unmaintained
-  contains some obsolete units which were replaced by better
-  alternatives, or which are old tests which are not needed
-  anymore
-
-Enjoy !
+Succes !
 
 Joost van der Sluis.              

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -50,6 +50,7 @@ type
     FBLobSegmentSize     : word;
 
     procedure ConnectFB;
+    function GetDialect: integer;
     procedure SetDBDialect;
     procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
     procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
@@ -94,7 +95,7 @@ type
     procedure DropDB; override;
     property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize;
   published
-    property Dialect  : integer read FDialect write FDialect;
+    property Dialect  : integer read GetDialect write FDialect;
     property DatabaseName;
     property KeepConnection;
     property LoginPrompt;
@@ -154,6 +155,7 @@ begin
   inherited;
   FConnOptions := FConnOptions + [sqSupportParams] + [sqEscapeRepeat];
   FBLobSegmentSize := 80;
+  FDialect := -1;
 end;
 
 
@@ -285,8 +287,8 @@ begin
   if isc_dsql_execute_immediate(@FStatus[0],@ASQLDatabaseHandle,@ASQLTransactionHandle,length(CreateSQL),@CreateSQL[1],Dialect,nil) <> 0 then
     CheckError('CreateDB', FStatus);
 
-  isc_detach_database(@FStatus[0], @ASQLDatabaseHandle);
-  CheckError('CreateDB', FStatus);
+  if isc_detach_database(@FStatus[0], @ASQLDatabaseHandle) <> 0 then
+    CheckError('CreateDB', FStatus);
 {$IfDef LinkDynamically}
   ReleaseIBase60;
 {$EndIf}
@@ -305,18 +307,18 @@ end;
 
 procedure TIBConnection.DoInternalDisconnect;
 begin
+  FDialect := -1;
   if not Connected then
   begin
     FSQLDatabaseHandle := nil;
     Exit;
   end;
 
-  isc_detach_database(@FStatus[0], @FSQLDatabaseHandle);
-  CheckError('Close', FStatus);
+  if isc_detach_database(@FStatus[0], @FSQLDatabaseHandle) <> 0 then
+    CheckError('Close', FStatus);
 {$IfDef LinkDynamically}
   ReleaseIBase60;
 {$EndIf}
-
 end;
 
 
@@ -337,13 +339,15 @@ begin
     case ResBuf[x] of
       isc_info_db_sql_dialect :
         begin
-          Inc(x);
-          Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
-          Inc(x, 2);
-          FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
-          Inc(x, Len);
+        Inc(x);
+        Len := isc_vax_integer(pchar(@ResBuf[x]), 2);
+        Inc(x, 2);
+        FDialect := isc_vax_integer(pchar(@ResBuf[x]), Len);
+        Inc(x, Len);
         end;
       isc_info_end : Break;
+    else
+      inc(x);
     end;
 end;
 
@@ -371,7 +375,13 @@ begin
     @FSQLDatabaseHandle,
          Length(DPB), @DPB[1]) <> 0 then
     CheckError('DoInternalConnect', FStatus);
-  SetDBDialect;
+end;
+
+function TIBConnection.GetDialect: integer;
+begin
+  if FDialect = -1 then
+    SetDBDialect;
+  Result := FDialect;
 end;
 
 procedure TIBConnection.AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
@@ -727,13 +737,20 @@ begin
       begin
       if assigned(in_sqlda^.SQLvar[SQLVarNr].SQLInd) then in_sqlda^.SQLvar[SQLVarNr].SQLInd^ := 0;
 
-      case AParams[ParNr].DataType of
-        ftInteger :
+      case (in_sqlda^.SQLvar[SQLVarNr].sqltype and not 1) of
+        SQL_LONG :
           begin
           i := AParams[ParNr].AsInteger;
           Move(i, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
           end;
-        ftString,ftFixedChar  : if ((in_sqlda^.SQLvar[SQLVarNr].SQLType and not 1) = SQL_BLOB) then SetBlobParam else
+        SQL_SHORT :
+          begin
+          i := AParams[ParNr].AsSmallInt;
+          Move(i, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
+          end;
+        SQL_BLOB :
+          SetBlobParam;
+        SQL_VARYING, SQL_TEXT :
           begin
           s := AParams[ParNr].AsString;
           w := length(s); // a word is enough, since the max-length of a string in interbase is 32k
@@ -747,22 +764,17 @@ begin
             end
           else
             CurrBuff := in_sqlda^.SQLvar[SQLVarNr].SQLData;
-
           Move(s[1], CurrBuff^, w);
           end;
-        ftDate, ftTime, ftDateTime:
+        SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TIMESTAMP :
           SetDateTime(in_sqlda^.SQLvar[SQLVarNr].SQLData, AParams[ParNr].AsDateTime, in_SQLDA^.SQLVar[SQLVarNr].SQLType);
-        ftLargeInt:
+        SQL_INT64:
           begin
           li := AParams[ParNr].AsLargeInt;
           Move(li, in_sqlda^.SQLvar[SQLVarNr].SQLData^, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
           end;
-        ftFloat:
+        SQL_DOUBLE, SQL_FLOAT:
           SetFloat(in_sqlda^.SQLvar[SQLVarNr].SQLData, AParams[ParNr].AsFloat, in_SQLDA^.SQLVar[SQLVarNr].SQLLen);
-        ftBlob, ftMemo:
-          begin
-          SetBlobParam;
-          end;
       else
         DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[ParNr].DataType]],self);
       end {case}

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -75,11 +75,9 @@ Type
 
   TConnectionName = class (TSQLConnection)
   private
-    FDialect: integer;
     FHostInfo: String;
     FServerInfo: String;
     FMySQL : PMySQL;
-    FDidConnect : Boolean;
     function GetClientInfo: string;
     function GetServerStatus: String;
     procedure ConnectMySQL(var HMySQL : PMySQL;H,U,P : pchar);
@@ -126,7 +124,6 @@ Type
     property ClientInfo: string read GetClientInfo;
     property ServerStatus : String read GetServerStatus;
   published
-    property Dialect  : integer read FDialect write FDialect;
     property DatabaseName;
     property HostName;
     property KeepConnection;
@@ -148,7 +145,7 @@ Type
 
 implementation
 
-uses dbconst;
+uses dbconst,ctypes;
 
 { TConnectionName }
 
@@ -192,19 +189,13 @@ end;
 
 function TConnectionName.GetClientInfo: string;
 
-Var
-  B : Boolean;
-
 begin
   // To make it possible to call this if there's no connection yet
-  B:=(MysqlLibraryHandle=Nilhandle);
-  If B then
-    InitialiseMysql;
+  InitialiseMysql;
   Try  
     Result:=strpas(mysql_get_client_info());
   Finally  
-    if B then
-      ReleaseMysql;
+    ReleaseMysql;
   end;  
 end;
 
@@ -295,16 +286,13 @@ end;
 
 procedure TConnectionName.ExecuteDirectMySQL(const query : string);
 
-var ADidConnect : boolean;
-    H,U,P       : String;
+var H,U,P       : String;
     AMySQL      : PMySQL;
 
 begin
   CheckDisConnected;
 
-  ADidConnect:=(MySQLLibraryHandle=NilHandle);
-  if ADidConnect then
-    InitialiseMysql;
+  InitialiseMysql;
 
   H:=HostName;
   U:=UserName;
@@ -317,15 +305,12 @@ begin
 
   mysql_close(AMySQL);
 
-  if ADidConnect then
-    ReleaseMysql;
+  ReleaseMysql;
 end;
 
 procedure TConnectionName.DoInternalConnect;
 begin
-  FDidConnect:=(MySQLLibraryHandle=NilHandle);
-  if FDidConnect then
-    InitialiseMysql;
+  InitialiseMysql;
 {$IFDEF mysql50}
   if copy(strpas(mysql_get_client_info()),1,3)<>'5.0' then
     Raise EInOutError.CreateFmt(SErrNotversion50,[strpas(mysql_get_client_info())]);
@@ -348,8 +333,7 @@ begin
   inherited DoInternalDisconnect;
   mysql_close(FMySQL);
   FMySQL:=Nil;
-  if FDidConnect then
-    ReleaseMysql;
+  ReleaseMysql;
 end;
 
 function TConnectionName.GetHandle: pointer;
@@ -443,7 +427,12 @@ function TConnectionName.MySQLDataType(AType: enum_field_types; ASize, ADecimals
 begin
   Result := True;
   case AType of
-    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
+    FIELD_TYPE_LONGLONG:
+      begin
+      NewType := ftLargeint;
+      NewSize := 0;
+      end;
+    FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG,
     FIELD_TYPE_INT24:
       begin
       NewType := ftInteger;
@@ -576,7 +565,7 @@ var
   row : MYSQL_ROW;
   C : TCursorName;
   li : longint;
-  Lengths : PDWord;
+  Lengths : pculong;
 begin
   C:=Cursor as TCursorName;
   if C.Row=nil then
@@ -849,6 +838,7 @@ constructor TConnectionName.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
+  FMySQL := Nil;
 end;
 
 function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;

packages/fcl-db/tests/README.txt

@@ -15,7 +15,7 @@ connectors are available in the '*toolsunit.pas' files.
 
 Which connector is currently used is dependent on the 'database.ini'
 configuration file. Also some settings which are connector-dependent can be set
-in that file. See 'database.ini' for more information.
+in that file. See 'database.ini.txt' for an example.
 
 I hope this is enough information to get you started,
 

packages/fcl-db/tests/database.ini → packages/fcl-db/tests/database.ini.txt

@@ -1,67 +1,71 @@
-[Database]
 ; This file contains several sections, one for each database-type. Select here
-; which database has to be tested currently.
+; which section has to be used currently.
+[Database]
 type=interbase
 
-
-
 ; These sections are for the several SQLDB-types of databases:
 [postgresql]
-; The connector specifies the connector that has to be used. The 'sql' connector
-; tests the TSQLQuery component
+
+; The connector specifies the DB-component that has to be used. The 'sql'
+; connector tests the SQLDB components
 connector=sql
+
 ; Here you can give some parameters, which are specific for each connector. The
 ; SQL connector uses this parameter to specify the connection that should be
 ; used;
 connectorparams=postgresql
+
 ; The name of the database. The database could be empty. You only need read and
 ; write rights.
 name=testdb
+
 ; user to log in with
 user=
+
 ; password to log in with
 password=
+
 ; hostname of the database-server
-hostname=192.168.3.25
+hostname=127.0.0.1
 
 [mysql40]
 connector=sql
 connectorparams=mysql40
-name=cnoc02
+name=testdb
 user=root
-password=apassword
-hostname=192.168.3.1
+password=
+hostname=127.0.0.1
 
 [mysql41]
 connector=sql
 connectorparams=mysql41
 name=testdb
 user=root
-password=apassword
-hostname=192.168.1.1
+password=
+hostname=127.0.0.1
 
 [mysql50]
 connector=sql
 connectorparams=mysql50
 name=testdb
 user=root
-password=apassword
-hostname=192.168.1.1
+password=
+hostname=127.0.0.1
 
 [oracle]
 connector=sql
 connectorparams=oracle
 name=xe
 user=system
-password=apassword
-hostname=192.168.3.1
+password=
+hostname=127.0.0.1
 
 [interbase]
 connector=sql
 connectorparams=interbase
 name=/opt/firebird/data/testdb.fdb
 user=sysdba
-password=apassword
+password=
 hostname=localhost
 
 [odbc]
@@ -69,19 +73,18 @@ connector=sql
 connectorparams=odbc
 name=testdb
 user=root
-password=apassword
-hostname=192.168.1.1
-
+password=
+hostname=127.0.0.1
 
 
-; This section is for TDbf:
+; This section is for a connector for TDbf:
 [dbf]
 connector=dbf
+
 ; Give here the path where the *.dbf file can be generated
 name=/tmp
 
-
-
-; This section is for MemDS:
+; This section is for a connector for MemDS:
 [memds]
 connector=memds
+

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -7,13 +7,58 @@ interface
 uses
   Classes, SysUtils, toolsunit,
   db,
-  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection;
+  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
 
-type TSQLDBTypes = (mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle);
+type TSQLDBTypes = (mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle,sqlite3);
 
 const MySQLdbTypes = [mysql40,mysql41,mysql50];
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
-             ('MYSQL40','MYSQL41','MYSQL50','POSTGRESQL','INTERBASE','ODBC','ORACLE');
+             ('MYSQL40','MYSQL41','MYSQL50','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
+             
+      FieldtypeDefinitionsConst : Array [TFieldType] of String[15] =
+        (
+          '',
+          'VARCHAR(10)',
+          'SMALLINT',
+          'INTEGER',
+          '',
+          '',
+          'FLOAT',
+          'DECIMAL(18,4)',
+          '',
+          'DATE',
+          'TIMESTAMP',
+          'TIMESTAMP',
+          '',
+          '',
+          '',
+          'BLOB',
+          'BLOB',
+          'BLOB',
+          '',
+          '',
+          '',
+          '',
+          '',
+          'CHAR(10)',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          '',
+          'TIMESTAMP',
+          '',
+          '',
+          ''
+        );
+             
 
 type
 { TSQLDBConnector }
@@ -41,7 +86,8 @@ type
   end;
 
 var SQLDbType : TSQLDBTypes;
-
+    FieldtypeDefinitions : Array [TFieldType] of String[15];
+    
 implementation
 
 { TSQLDBConnector }
@@ -51,11 +97,25 @@ var i : TSQLDBTypes;
 begin
   for i := low(DBTypesNames) to high(DBTypesNames) do
     if UpperCase(dbconnectorparams) = DBTypesNames[i] then sqldbtype := i;
+
+  FieldtypeDefinitions := FieldtypeDefinitionsConst;
     
   if SQLDbType = MYSQL40 then Fconnection := tMySQL40Connection.Create(nil);
   if SQLDbType = MYSQL41 then Fconnection := tMySQL41Connection.Create(nil);
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
-  if SQLDbType = POSTGRESQL then Fconnection := tpqConnection.Create(nil);
+  if SQLDbType = sqlite3 then
+    begin
+    Fconnection := TSQLite3Connection.Create(nil);
+    FieldtypeDefinitions[ftCurrency] := '';
+    FieldtypeDefinitions[ftFixedChar] := '';
+    end;
+  if SQLDbType = POSTGRESQL then
+    begin
+    Fconnection := tpqConnection.Create(nil);
+    FieldtypeDefinitions[ftBlob] := 'TEXT';
+    FieldtypeDefinitions[ftMemo] := 'TEXT';
+    FieldtypeDefinitions[ftGraphic] := '';
+    end;
   if SQLDbType = INTERBASE then Fconnection := tIBConnection.Create(nil);
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
@@ -116,23 +176,41 @@ end;
 
 procedure TSQLDBConnector.CreateFieldDataset;
 var CountID : Integer;
+    FType   : TFieldType;
+    Sql,sql1: String;
 begin
   try
     Ftransaction.StartTransaction;
-    Fconnection.ExecuteDirect('create table FPDEV_FIELD (   ' +
-                              '  ID INT NOT NULL,           ' +
-                              '  FSTRING VARCHAR(10),        ' +
-                              '  FINTEGER INT,               ' +
-                              '  FDATE DATE,         ' +
-                              '  FDATETIME TIMESTAMP,        ' +
-                              '  PRIMARY KEY (ID)           ' +
-                              ')                            ');
+
+    Sql := 'create table FPDEV_FIELD (ID INT NOT NULL,';
+    for FType := low(TFieldType)to high(TFieldType) do
+      if FieldtypeDefinitions[FType]<>'' then
+        sql := sql + 'F' + Fieldtypenames[FType] + ' ' +FieldtypeDefinitions[FType]+ ',';
+    Sql := Sql + 'PRIMARY KEY (ID))';
+
+    FConnection.ExecuteDirect(Sql);
 
     FTransaction.CommitRetaining;
 
     for countID := 0 to testValuesCount-1 do
-      Fconnection.ExecuteDirect('insert into FPDEV_FIELD (ID,FSTRING,FINTEGER,FDATE,FDATETIME)' +
-                                'values ('+inttostr(countID)+','''+testStringValues[CountID]+''','''+inttostr(testIntValues[CountID])+''','''+testDateValues[CountID]+''','''+testDateValues[CountID]+''')');
+      begin
+      
+      Sql :=  'insert into FPDEV_FIELD (ID';
+      Sql1 := 'values ('+IntToStr(countID);
+      for FType := low(TFieldType)to high(TFieldType) do
+        if FieldtypeDefinitions[FType]<>'' then
+          begin
+          sql := sql + ',F' + Fieldtypenames[FType];
+          if testValues[FType,CountID] <> '' then
+            sql1 := sql1 + ',''' + testValues[FType,CountID] + ''''
+          else
+            sql1 := sql1 + ',NULL';
+          end;
+      Sql := sql + ')';
+      Sql1 := sql1+ ')';
+
+      Fconnection.ExecuteDirect(sql + ' ' + sql1);
+      end;
 
     Ftransaction.Commit;
   except

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -1,4 +1,4 @@
- unit TestSQLFieldTypes;
+unit TestSQLFieldTypes;
 
 {$mode objfpc}{$H+}
 
@@ -20,12 +20,15 @@ type
   private
     procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
     procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
-    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer);
+    procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
   protected
     procedure SetUp; override; 
     procedure TearDown; override;
     procedure RunTest; override;
   published
+    procedure TestBug9744;
+    procedure TestCrossStringDateParam;
+    procedure TestGetFieldNames;
     procedure TestUpdateIndexDefs;
     procedure TestSetBlobAsMemoParam;
     procedure TestSetBlobAsStringParam;
@@ -58,7 +61,6 @@ type
     procedure TestDateParamQuery;
     procedure TestIntParamQuery;
     procedure TestFloatParamQuery;
-  published
     procedure TestAggregates;
   end;
 
@@ -395,8 +397,7 @@ procedure TTestFieldTypes.TestChangeBlob;
 var s : string;
 
 begin
-  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT blob)');
-//  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT text)');
+  TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
   TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For interbase
 
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
@@ -437,8 +438,7 @@ end;
 
 procedure TTestFieldTypes.TestBlobGetText;
 begin
-  CreateTableWithFieldType(ftBlob,'BLOB');
-//  CreateTableWithFieldType(ftBlob,'TEXT');
+  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
   TestFieldDeclaration(ftBlob,0);
 
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
@@ -467,7 +467,7 @@ var
   ASQL          : TSQLQuery;
 
 begin
-  CreateTableWithFieldType(ftBlob,'BLOB');
+  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
 //  CreateTableWithFieldType(ftBlob,'TEXT');
   TestFieldDeclaration(ftBlob,0);
 
@@ -495,8 +495,7 @@ var
   i             : byte;
 
 begin
-  CreateTableWithFieldType(ftBlob,'BLOB');
-//  CreateTableWithFieldType(ftBlob,'TEXT');
+  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
   TestFieldDeclaration(ftBlob,0);
 
   TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
@@ -554,7 +553,7 @@ var
   i, corrTestValueCount : byte;
 
 begin
-  CreateTableWithFieldType(ftDateTime,'TIMESTAMP');
+  CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
   TestFieldDeclaration(ftDateTime,8);
   
   if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
@@ -729,7 +728,7 @@ begin
 end;
 
 
-procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer);
+procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
 
 var i : integer;
 
@@ -741,6 +740,7 @@ begin
 
   with TSQLDBConnector(DBConnector).Query do
     begin
+    PacketRecords := -1;
     sql.clear;
     sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
 
@@ -753,13 +753,16 @@ begin
         ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
         ftFloat  : Params.ParamByName('field1').AsFloat   := testFloatValues[i];
         ftString : Params.ParamByName('field1').AsString  := testStringValues[i];
-        ftDate   : Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i]);
+        ftDate   : if cross then
+                     Params.ParamByName('field1').AsString:= testDateValues[i]
+                   else
+                     Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i]);
       else
         AssertTrue('no test for paramtype available',False);
       end;
       ExecSQL;
       end;
-  TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
+    TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
 
     sql.clear;
     sql.append('select * from FPDEV2 order by ID');
@@ -864,6 +867,63 @@ begin
     inherited RunTest;
 end;
 
+procedure TTestFieldTypes.TestBug9744;
+var i : integer;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    try
+      Connection.ExecuteDirect('create table TTTOBJ (         ' +
+                                '  ID INT NOT NULL,           ' +
+                                '  NAME VARCHAR(250),         ' +
+                                '  PRIMARY KEY (ID)           ' +
+                                ')                            ');
+      Connection.ExecuteDirect('create table TTTXY (          ' +
+                                '  ID INT NOT NULL,           ' +
+                                '  NP INT NOT NULL,           ' +
+                                '  X DOUBLE,                  ' +
+                                '  Y DOUBLE,                  ' +
+                                '  PRIMARY KEY (ID,NP)        ' +
+                                ')                            ');
+      for i := 0 to 7 do
+        begin
+        connection.ExecuteDirect('insert into TTTOBJ(ID,NAME) values ('+inttostr(i)+',''A'+inttostr(i)+''')');
+        connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',1,1,1)');
+        connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',2,2,2)');
+        end;
+      Query.SQL.Text := 'select OBJ.ID, OBJ.NAME, count(XY.NP) as NPF from TTTOBJ as OBJ, TTTXY as XY where (OBJ.ID=XY.ID) group by OBJ.ID';
+      query.Prepare;
+      query.open;
+      query.close;
+    finally
+      Connection.ExecuteDirect('drop table TTTXY');
+      Connection.ExecuteDirect('drop table TTTOBJ');
+      end
+    end;
+end;
+
+procedure TTestFieldTypes.TestCrossStringDateParam;
+begin
+  TestXXParamQuery(ftDate,'DATE',testDateValuesCount,True);
+end;
+
+procedure TTestFieldTypes.TestGetFieldNames;
+var FieldNames : TStringList;
+begin
+  with TSQLDBConnector(DBConnector) do
+    begin
+    FieldNames := TStringList.Create;
+    try
+      Connection.GetFieldNames('FpDEv',FieldNames);
+      AssertEquals(2,FieldNames.Count);
+      AssertEquals('ID',UpperCase(FieldNames[0]));
+      AssertEquals('NAME',UpperCase(FieldNames[1]));
+    finally
+      FieldNames.Free;
+      end;
+    end;
+end;
+
 procedure TTestFieldTypes.TestUpdateIndexDefs;
 var ds : TSQLQuery;
 begin
@@ -885,8 +945,7 @@ var
   ASQL          : TSQLQuery;
 
 begin
-  CreateTableWithFieldType(ftBlob,'BLOB');
-//  CreateTableWithFieldType(ftBlob,'TEXT');
+  CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
   TestFieldDeclaration(ftBlob,0);
 
   ASQL := DBConnector.GetNDataset(True,1) as tsqlquery;
@@ -961,6 +1020,7 @@ begin
 end;
 
 procedure TTestFieldTypes.TestParametersAndDates;
+// See bug 7205
 begin
   with TSQLDBConnector(DBConnector).Query do
     begin

packages/fcl-db/tests/toolsunit.pas

@@ -70,7 +70,7 @@ type
      end;
 
 const
-  DataEventnames : Array [TDataEvent] of String[19] =
+  DataEventnames : Array [TDataEvent] of String[21] =
     ('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
      'deLayoutChange', 'deUpdateRecord', 'deUpdateState', 'deCheckBrowseMode',
      'dePropertyChange', 'deFieldListChange', 'deFocusControl' ,'deParentScroll',
@@ -147,10 +147,12 @@ var dbtype,
     dbname,
     dbuser,
     dbhostname,
-    dbpassword        : string;
-    DataEvents        : string;
-    DBConnector       : TDBConnector;
-    
+    dbpassword     : string;
+    DataEvents     : string;
+    DBConnector    : TDBConnector;
+    testValues     : Array [TFieldType,0..testvaluescount -1] of string;
+
+
 procedure InitialiseDBConnector;
 
 implementation
@@ -217,7 +219,17 @@ end;
 
 procedure InitialiseDBConnector;
 var DBConnectorClass : TPersistentClass;
+    i                : integer;
 begin
+  testValues[ftString] := testStringValues;
+  testValues[ftDate] := testDateValues;
+  for i := 0 to testValuesCount-1 do
+    begin
+    testValues[ftFloat,i] := FloatToStr(testFloatValues[i]);
+    testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
+    testValues[ftInteger,i] := IntToStr(testIntValues[i]);
+    end;
+
   if dbconnectorname = '' then raise Exception.Create('There is no db-connector specified');
   DBConnectorClass := GetClass('T'+dbconnectorname+'DBConnector');
   if assigned(DBConnectorClass) then