Browse Source

--- Merging r20546 into '.':
U packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/tests/sqldbtoolsunit.pas
--- Merging r20572 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
U packages/fcl-db/tests/database.ini.txt
G packages/fcl-db/tests/sqldbtoolsunit.pas
U packages/fcl-db/tests/toolsunit.pas
--- Merging r20585 into '.':
G packages/fcl-db/tests/testfieldtypes.pas
G packages/fcl-db/tests/sqldbtoolsunit.pas
G packages/fcl-db/tests/toolsunit.pas
--- Merging r20637 into '.':
U packages/dblib/src/dblib.pp
--- Merging r20680 into '.':
U packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
G packages/dblib/src/dblib.pp

# revisions: 20546,20572,20585,20637,20680
------------------------------------------------------------------------
r20546 | marco | 2012-03-20 22:14:36 +0100 (Tue, 20 Mar 2012) | 2 lines
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas

* Tests for Mysql 5.5, from Lacak2. Mantis #21511

------------------------------------------------------------------------
------------------------------------------------------------------------
r20572 | michael | 2012-03-22 14:45:54 +0100 (Thu, 22 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/database.ini.txt
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Applied tests pach from bug #17303
------------------------------------------------------------------------
------------------------------------------------------------------------
r20585 | michael | 2012-03-23 10:05:01 +0100 (Fri, 23 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/sqldbtoolsunit.pas
M /trunk/packages/fcl-db/tests/testfieldtypes.pas
M /trunk/packages/fcl-db/tests/toolsunit.pas

* Patch to reorder datetime testing values, so out-of-range comes last
------------------------------------------------------------------------
------------------------------------------------------------------------
r20637 | michael | 2012-03-27 09:17:07 +0200 (Tue, 27 Mar 2012) | 4 lines
Changed paths:
M /trunk/packages/dblib/src/dblib.pp

Patch from bug #17303:
- C char mapped to shortint instead of char
- added comments to data types to be clear (32 vs. 64 bit env.)

------------------------------------------------------------------------
------------------------------------------------------------------------
r20680 | michael | 2012-03-31 11:18:01 +0200 (Sat, 31 Mar 2012) | 1 line
Changed paths:
M /trunk/packages/dblib/src/dblib.pp
M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

* Applied patch from 21583
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@21020 -

marco 13 years ago
parent
commit
09538b9c8b

+ 19 - 12
packages/dblib/src/dblib.pp

@@ -43,7 +43,11 @@ const
   {$IFDEF ntwdblib}'ntwdblib.dll'{$ENDIF}
   {$IFDEF freetds} 'dblib.dll'   {$ENDIF}
 {$ELSE}
-  'libsybdb.so'
+  {$IFDEF DARWIN}
+    'libsybdb.dylib'
+  {$ELSE}
+    'libsybdb.so'
+  {$ENDIF}
 {$ENDIF}
   ;
 
@@ -150,6 +154,9 @@ const
 
   DBUNKNOWN = 2; //FALSE = 0, TRUE = 1
 
+  // Error codes:
+  SYBEFCON = 20002;      // SQL Server connection failed
+
 type
   PLOGINREC=Pointer;
   PDBPROCESS=Pointer;
@@ -163,13 +170,13 @@ type
   ULONG=longword;
 
   // DB-Library datatypes
-  DBCHAR=char;
-  DBTINYINT=byte;
-  DBSMALLINT=smallint;
-  DBINT=longint;
-	DBUSMALLINT=word;
-  DBFLT8=double;
+  DBCHAR=shortint;
   DBBIT=byte;
+  DBTINYINT=byte;
+  DBSMALLINT=smallint;   // 16-bit int (short)
+  DBUSMALLINT=word;      // 16-bit unsigned int (unsigned short)
+  DBINT=longint;         // 32-bit int (int)
+  DBFLT8=double;         // 64-bit real (double)
   DBBINARY=byte;
 
   {$PACKRECORDS C}
@@ -230,7 +237,7 @@ type
 
   DBVARYCHAR=packed record
     len: {$IFDEF freetds}DBINT{$ELSE}DBSMALLINT{$ENDIF};
-    str: array[0..DBMAXCHAR-1] of CHAR;
+    str: array[0..DBMAXCHAR-1] of AnsiChar;
   end;
 
   DBERRHANDLE_PROC=function(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
@@ -241,9 +248,9 @@ type
   {$ENDIF}
   DBCOL=record
    	SizeOfStruct: DBINT;
-   	Name: array[0..MAXCOLNAMELEN] of char;
-   	ActualName: array[0..MAXCOLNAMELEN] of char;
-   	TableName: array[0..MAXTABLENAME] of char;
+   	Name: array[0..MAXCOLNAMELEN] of AnsiChar;
+   	ActualName: array[0..MAXCOLNAMELEN] of AnsiChar;
+   	TableName: array[0..MAXTABLENAME] of AnsiChar;
    	Typ: SHORT;
    	UserType: DBINT;
    	MaxLength: DBINT;
@@ -396,7 +403,7 @@ begin
     if DBLibLibraryHandle = nilhandle then
     begin
       RefCount := 0;
-      raise EInOutError.CreateFmt('Can not load DB-Lib client library "%s". Check your installation.'#13'%s',
+      raise EInOutError.CreateFmt('Can not load DB-Lib client library "%s". Check your installation.'+LineEnding+'%s',
                                   [libname, SysErrorMessage(GetLastOSError)]);
     end;
 

+ 21 - 17
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -54,6 +54,7 @@ type
     FDBProc : PDBPROCESS;
     Ftds    : integer;     // TDS protocol version
     Fstatus : STATUS;      // current result/rows fetch status
+    function CheckError(const Ret: RETCODE): RETCODE;
     procedure DBExecute(const cmd: string);
     function TranslateFldType(SQLDataType: integer): TFieldType;
     function ClientCharset: TClientCharset;
@@ -178,34 +179,19 @@ var
 
 function DBErrHandler(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
 begin
-  DBErrorStr:=DBErrorStr+#13+dberrstr;
+  DBErrorStr:=DBErrorStr+LineEnding+dberrstr;
   DBErrorNo :=dberr;
   Result    :=INT_CANCEL;
 end;
 
 function DBMsgHandler(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PChar; line:DBUSMALLINT):INT; cdecl;
 begin
-  DBMsgStr:=DBMsgStr+#13+msgtext;
+  DBMsgStr:=DBMsgStr+LineEnding+msgtext;
   DBMsgNo :=msgno;
   Result  :=0;
 end;
 
 
-function CheckError(const Ret: RETCODE): RETCODE;
-var E: EMSSQLDatabaseError;
-begin
-  if Ret=FAIL then
-  begin
-    E:=EMSSQLDatabaseError.Create(DBErrorStr+#13+DBMsgStr);
-    E.DBErrorCode:=DBErrorNo;
-    DBErrorStr:='';
-    DBMsgStr:='';
-    raise E;
-  end;
-  Result:=Ret;
-end;
-
-
 { TDBLibCursor }
 
 function TDBLibCursor.ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string;
@@ -245,6 +231,24 @@ begin
   Result := (Ftds=DBTDS_50) or (Ftds=DBTDS_42);
 end;
 
+function TMSSQLConnection.CheckError(const Ret: RETCODE): RETCODE;
+var E: EMSSQLDatabaseError;
+begin
+  if Ret=FAIL then
+  begin
+    if DBErrorStr = '' then
+      case DBErrorNo of
+        SYBEFCON: DBErrorStr:='SQL Server connection failed!';
+      end;
+    E:=EMSSQLDatabaseError.CreateFmt('%s Error %d: %s'+LineEnding+'%s', [ClassName, DBErrorNo, DBErrorStr, DBMsgStr]);
+    E.DBErrorCode:=DBErrorNo;
+    DBErrorStr:='';
+    DBMsgStr:='';
+    raise E;
+  end;
+  Result:=Ret;
+end;
+
 constructor TMSSQLConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);

+ 9 - 0
packages/fcl-db/tests/database.ini.txt

@@ -94,6 +94,15 @@ connector=sql
 connectorparams=sqlite3
 name=test.db
 
+; MS SQL Server database:
+[mssql]
+connector=sql
+connectorparams=mssql
+name=pubs
+user=sa
+password=
+hostname=127.0.0.1
+
 ; TDBf: DBase/FoxPro database:
 [dbf]
 connector=dbf

+ 49 - 22
packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -6,14 +6,15 @@ interface
 
 uses
   Classes, SysUtils, toolsunit,
-  db,
-  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
+  db, sqldb,
+  mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn,
+  ibconnection, pqconnection, odbcconn, oracleconnection, sqlite3conn, mssqlconn;
 
-type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,postgresql,interbase,odbc,oracle,sqlite3);
+type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql);
 
-const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
+const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
-             ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
+        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL');
              
       FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
         (
@@ -24,26 +25,25 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           'BOOLEAN',
           'FLOAT',
-          '',
-          'DECIMAL(18,4)',
+          '',             // ftCurrency
+          'DECIMAL(18,4)',// ftBCD
           'DATE',
           'TIME',
-          'TIMESTAMP',
-          '',
+          'TIMESTAMP',    // ftDateTime
           '',
           '',
-          'BLOB',
-          'BLOB',
-          'BLOB',
           '',
+          'BLOB',         // ftBlob
+          'BLOB',         // ftMemo
+          'BLOB',         // ftGraphic
           '',
           '',
           '',
           '',
-          'CHAR(10)',
           '',
-          'BIGINT',
+          'CHAR(10)',     // ftFixedChar
           '',
+          'BIGINT',       // ftLargeInt
           '',
           '',
           '',
@@ -53,8 +53,9 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51];
           '',
           '',
           '',
-          'TIMESTAMP',
-          'NUMERIC(18,6)',
+          '',             // ftGuid
+          'TIMESTAMP',    // ftTimestamp
+          'NUMERIC(18,6)',// ftFmtBCD
           '',
           ''
         );
@@ -111,6 +112,7 @@ begin
   if SQLDbType = MYSQL41 then Fconnection := tMySQL41Connection.Create(nil);
   if SQLDbType = MYSQL50 then Fconnection := tMySQL50Connection.Create(nil);
   if SQLDbType = MYSQL51 then Fconnection := tMySQL51Connection.Create(nil);
+  if SQLDbType = MYSQL55 then Fconnection := tMySQL55Connection.Create(nil);
   if SQLDbType in [mysql40,mysql41] then
     begin
     // Mysql versions prior to 5.0.3 removes the trailing spaces on varchar
@@ -155,8 +157,22 @@ begin
     end;
   if SQLDbType = ODBC then Fconnection := tODBCConnection.Create(nil);
   if SQLDbType = ORACLE then Fconnection := TOracleConnection.Create(nil);
+  if SQLDbType = MSSQL then
+    begin
+    Fconnection := TMSSQLConnection.Create(nil);
+    FieldtypeDefinitions[ftBoolean] := 'BIT';
+    FieldtypeDefinitions[ftCurrency]:= 'MONEY';
+    FieldtypeDefinitions[ftDate]    := 'DATETIME';
+    FieldtypeDefinitions[ftTime]    := '';
+    FieldtypeDefinitions[ftDateTime]:= 'DATETIME';
+    FieldtypeDefinitions[ftBytes]   := 'BINARY(5)';
+    FieldtypeDefinitions[ftVarBytes]:= 'VARBINARY(10)';
+    FieldtypeDefinitions[ftBlob]    := 'IMAGE';
+    FieldtypeDefinitions[ftMemo]    := 'TEXT';
+    FieldtypeDefinitions[ftGraphic] := '';
+    end;
 
-  if SQLDbType in [mysql40,mysql41,mysql50,mysql51,odbc,interbase] then
+  if SQLDbType in [mysql40,mysql41,mysql50,mysql51,mysql55,odbc,interbase] then
     begin
     // Some DB's do not support milliseconds in datetime and time fields.
     // Firebird support miliseconds, see BUG 17199 (when resolved, then interbase can be excluded)
@@ -168,7 +184,7 @@ begin
         testValues[ftDateTime,t] := copy(testValues[ftDateTime,t],1,19)+'.000';
       end;
     end;
-  if SQLDbType in [postgresql,interbase] then
+  if SQLDbType in [postgresql,interbase,mssql] then
     begin
     // Some db's do not support times > 24:00:00
     testTimeValues[3]:='13:25:15.000';
@@ -181,11 +197,15 @@ begin
       end;
     end;
 
-  if SQLDbType in [sqlite3] then
-    testValues[ftCurrency]:=testValues[ftBCD]; //decimal separator for currencies must be decimal point
+  // DecimalSeparator must correspond to monetary locale (lc_monetary) set on PostgreSQL server
+  // Here we assume, that locale on client side is same as locale on server
+  if SQLDbType in [postgresql] then
+    for t := 0 to testValuesCount-1 do
+      testValues[ftCurrency,t] := QuotedStr(CurrToStr(testCurrencyValues[t]));
 
   // SQLite does not support fixed length CHAR datatype
   // MySQL by default trimms trailing spaces on retrieval; so set sql-mode="PAD_CHAR_TO_FULL_LENGTH" - supported from MySQL 5.1.20
+  // MSSQL set SET ANSI_PADDING ON
   if SQLDbType in [sqlite3] then
     for t := 0 to testValuesCount-1 do
       testValues[ftFixedChar,t] := PadRight(testValues[ftFixedChar,t], 10);
@@ -223,6 +243,7 @@ begin
     begin
     database := Fconnection;
     transaction := Ftransaction;
+    PacketRecords := -1;  // To avoid: "Connection is busy with results for another hstmt" (ODBC,MSSQL)
     end;
 end;
 
@@ -290,7 +311,10 @@ begin
           begin
           sql := sql + ',F' + Fieldtypenames[FType];
           if testValues[FType,CountID] <> '' then
-            sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
+            if FType in [ftCurrency] then
+              sql1 := sql1 + ',' + testValues[FType,CountID]
+            else
+              sql1 := sql1 + ',' + QuotedStr(testValues[FType,CountID])
           else
             sql1 := sql1 + ',NULL';
           end;
@@ -302,7 +326,10 @@ begin
 
     Ftransaction.Commit;
   except
-    if Ftransaction.Active then Ftransaction.Rollback
+    on E: Exception do begin
+      //writeln(E.Message);
+      if Ftransaction.Active then Ftransaction.Rollback;
+    end;
   end;
 end;
 

+ 53 - 48
packages/fcl-db/tests/testfieldtypes.pas

@@ -140,16 +140,16 @@ const
     '1991-03-01',
     '2040-10-16',
     '1977-09-29',
+    '1899-12-29',
+    '1899-12-30',
+    '1899-12-31',
+    '1900-01-01',
     '1800-03-30',
-    '1650-05-10',
     '1754-06-04',
+    '1650-05-10',
     '0904-04-12',
     '0199-07-09',
-    '0001-01-01',
-    '1899-12-29',
-    '1899-12-30',
-    '1899-12-31',
-    '1900-01-01'
+    '0001-01-01'
   );
 
   testBytesValuesCount = 5;
@@ -394,10 +394,7 @@ begin
     Open;
     for i := 0 to testValuesCount-1 do
       begin
-      if (SQLDbType in [mysql40,mysql41]) then
-        AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL < 5.0.3 automatically trims strings
-      else
-        AssertEquals(testValues[i],fields[0].AsString);
+      AssertEquals(testValues[i], Fields[0].AsString);
       Next;
       end;
     close;
@@ -611,16 +608,7 @@ const
     '2000-01-01 10:00:00',
     '2000-01-01 23:59:59',
     '1994-03-06 11:54:30',
-    '2040-10-16',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
-    '1400-02-03 12:21:53',
-    '0354-11-20 21:25:15',
-    '1333-02-03 21:44:21',
-    '1800-03-30',
-    '1650-05-10',
-    '1754-06-04',
-    '0904-04-12',
-    '0199-07-09',
-    '0001-01-01',
+    '1754-06-04',                   // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
     '1899-12-29',
     '1899-12-30',
     '1899-12-31',
@@ -631,20 +619,26 @@ const
     '1899-12-29 18:00:51',
     '1903-04-02 01:04:02',
     '1815-09-24 03:47:22',
-    '2100-01-01 01:01:01'
+    '2040-10-16',
+    '2100-01-01 01:01:01',
+    '1400-02-03 12:21:53',          // MS SQL 2005 doesn't support datetimes before 1753
+    '0354-11-20 21:25:15',
+    '1333-02-03 21:44:21',
+    '1800-03-30',
+    '1650-05-10',
+    '0904-04-12',
+    '0199-07-09',
+    '0001-01-01'
   );
 
 var
-  i, corrTestValueCount : byte;
+  i : byte;
 
 begin
   CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
   TestFieldDeclaration(ftDateTime,8);
 
-  if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
-    else corrTestValueCount := testValuesCount;
-
-  for i := 0 to corrTestValueCount-1 do
+  for i := 0 to testValuesCount-1 do
     if SQLDbType=oracle then
       TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
     else
@@ -653,7 +647,7 @@ begin
   with TSQLDBConnector(DBConnector).Query do
     begin
     Open;
-    for i := 0 to corrTestValueCount-1 do
+    for i := 0 to testValuesCount-1 do
       begin
       if length(testValues[i]) < 12 then
         AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
@@ -784,12 +778,9 @@ begin
 
     end;
   TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-
-
 end;
 
 procedure TTestFieldTypes.TestIntParamQuery;
-
 begin
   TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 end;
@@ -799,9 +790,14 @@ begin
   TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
 end;
 
+procedure TTestFieldTypes.TestDateParamQuery;
+begin
+  TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
+end;
+
 procedure TTestFieldTypes.TestTimeParamQuery;
 begin
-  TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
+  TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
 end;
 
 procedure TTestFieldTypes.TestDateTimeParamQuery;
@@ -827,7 +823,7 @@ end;
 
 procedure TTestFieldTypes.TestVarBytesParamQuery;
 begin
-  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount);
+  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, SQLDbType<>mssql);
 end;
 
 procedure TTestFieldTypes.TestStringParamQuery;
@@ -841,12 +837,6 @@ begin
   TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
 end;
 
-procedure TTestFieldTypes.TestDateParamQuery;
-
-begin
-  TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
-end;
-
 
 procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
 
@@ -863,7 +853,6 @@ begin
 
   with TSQLDBConnector(DBConnector).Query do
     begin
-    PacketRecords := -1;
     sql.clear;
     sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
 
@@ -891,7 +880,10 @@ begin
                      Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
                    else
                      Params.ParamByName('field1').AsBlob := testBytesValues[i];
-        ftVarBytes:Params.ParamByName('field1').AsString := testBytesValues[i];
+        ftVarBytes:if cross then
+                     Params.ParamByName('field1').AsString := testBytesValues[i]
+                   else
+                     Params.ParamByName('field1').AsBlob := testBytesValues[i];
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -1247,6 +1239,11 @@ begin
       Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
       Query.SQL.Text:='execute procedure FPDEV_PROC';
     end
+    else if SQLDbType = mssql then
+    begin
+      Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
+      Query.SQL.Text:='execute FPDEV_PROC';
+    end
     else
     begin
       Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
@@ -1532,10 +1529,11 @@ begin
     begin
     with query do
       begin
-      if (sqlDBtype=interbase) then
-        SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
-      else
-        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      case sqlDBtype of
+        interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
+        mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
+        else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      end;
       Open;
       close;
       ServerFilter:='ID=21';
@@ -1656,7 +1654,7 @@ end;
 procedure TTestFieldTypes.TestBug9744;
 var i : integer;
 begin
-  if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
+  if SQLDbType in [interbase,postgresql,mssql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
 
   with TSQLDBConnector(DBConnector) do
     begin
@@ -1826,6 +1824,8 @@ begin
   else
   begin
     datatype:=FieldtypeDefinitions[ftTime];
+    if datatype = '' then
+      Ignore(STestNotApplicable);
     if sqlDBType = sqlite3 then
       testIntervalValuesCount := 5
     else if sqlDBType in MySQLdbTypes then
@@ -1853,6 +1853,12 @@ begin
     values:='DEFAULT VALUES';
     fieldtype:=ftInteger;
   end
+  else if sqlDBType = mssql then
+  begin
+    datatype:='INTEGER IDENTITY';
+    values:='DEFAULT VALUES';
+    fieldtype:=ftAutoInc;
+  end
   else
     Ignore(STestNotApplicable);
 
@@ -1925,14 +1931,14 @@ end;
 
 procedure TTestFieldTypes.TestTemporaryTable;
 begin
-  if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
+  if SQLDbType in [interbase,mssql] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t support temporary tables');
 
   with TSQLDBConnector(DBConnector).Query do
     begin
     SQL.Clear;
     SQL.Add('CREATE TEMPORARY TABLE TEMP1 (id int)');
     ExecSQL;
-    SQL.Text :=  'INSERT INTO TEMP1(id) values (5)';
+    SQL.Text := 'INSERT INTO TEMP1(id) values (5)';
     ExecSQL;
     SQL.Text := 'SELECT * FROM TEMP1';
     Open;
@@ -2056,4 +2062,3 @@ end;
 initialization
   if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
 end.
-

+ 14 - 17
packages/fcl-db/tests/toolsunit.pas

@@ -138,25 +138,25 @@ const
     '2004-03-01',
     '1991-02-28',
     '1991-03-01',
+    '1997-11-29',
     '2040-10-16',
     '1977-09-29',
+    '1977-12-31',
+    '1917-12-29',
+    '1900-01-01',
+    '1899-12-31',
+    '1899-12-30',
+    '1899-12-29',
     '1800-03-30',
-    '1650-05-10',
     '1754-06-04',
+    '1753-01-01',
+    '1650-05-10',
     '0904-04-12',
     '0199-07-09',
-    '0001-01-01',
-    '0031-11-02',
-    '1899-12-29',
-    '1899-12-30',
-    '1899-12-31',
-    '1977-09-29',
-    '1917-12-29',
     '0079-11-29',
-    '1997-11-29',
-    '0001-01-01',
-    '1997-11-29',
-    '1900-01-01'
+    '0031-11-02',
+    '0001-12-31',
+    '0001-01-01'
   );
 
   testTimeValues : Array[0..testValuesCount-1] of string = (
@@ -177,7 +177,7 @@ const
     '15:35:12.000',
     '16:45:12.010',
     '13:55:12.200',
-    '13:46:12.542',
+    '13:46:12.543',
     '15:35:12.000',
     '17:25:12.530',
     '19:45:12.003',
@@ -315,10 +315,7 @@ begin
     testValues[ftSmallint,i] := IntToStr(testSmallIntValues[i]);
     testValues[ftInteger,i] := IntToStr(testIntValues[i]);
     testValues[ftLargeint,i] := IntToStr(testLargeIntValues[i]);
-    // The decimalseparator was set to a comma for currencies and to a dot for ftBCD values.
-    // DecimalSeparator for PostgreSQL must correspond to monetary locale set on PostgreSQL server
-    // Here we assume, that locale on client side is same as locale on server
-    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i]);
+    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
     testValues[ftBCD,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
     // For date '0001-01-01' other time-part like '00:00:00' causes "Invalid variant type cast", because of < MinDateTime constant
     if (testDateValues[i]>'0001-01-01') and (testTimeValues[i]>='00:00:01') and (testTimeValues[i]<'24:00:00') then