* Applied tests pach from bug #17303

git-svn-id: trunk@20572 -

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

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -6,14 +6,15 @@ interface
 
 uses
   Classes, SysUtils, toolsunit,
-  db,
+  db, sqldb,
-  sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
+  mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn,
+  ibconnection, pqconnection, odbcconn, oracleconnection, sqlite3conn, mssqlconn;
 
-type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3);
+type TSQLDBTypes = (mysql40,mysql41,mysql50,mysql51,mysql55,postgresql,interbase,odbc,oracle,sqlite3,mssql);
 
 const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
       DBTypesNames : Array [TSQLDBTypes] of String[19] =
-             ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3');
+        ('MYSQL40','MYSQL41','MYSQL50','MYSQL51','MYSQL55','POSTGRESQL','INTERBASE','ODBC','ORACLE','SQLITE3','MSSQL');
              
       FieldtypeDefinitionsConst : Array [TFieldType] of String[20] =
         (
@@ -24,25 +25,25 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
           '',
           'BOOLEAN',
           'FLOAT',
-          '',
+          '',             // ftCurrency
-          'DECIMAL(18,4)',
+          'DECIMAL(18,4)',// ftBCD
           'DATE',
           'TIME',
-          'TIMESTAMP',
+          'TIMESTAMP',    // ftDateTime
           '',
           '',
           '',
-          'BLOB',
+          'BLOB',         // ftBlob
-          'BLOB',
+          'BLOB',         // ftMemo
-          'BLOB',
+          'BLOB',         // ftGraphic
           '',
           '',
           '',
           '',
           '',
-          'CHAR(10)',
+          'CHAR(10)',     // ftFixedChar
           '',
-          'BIGINT',
+          'BIGINT',       // ftLargeInt
           '',
           '',
           '',
@@ -52,9 +53,9 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
           '',
           '',
           '',
-          '',
+          '',             // ftGuid
-          'TIMESTAMP',
+          'TIMESTAMP',    // ftTimestamp
-          'NUMERIC(18,6)',
+          'NUMERIC(18,6)',// ftFmtBCD
           '',
           ''
         );
@@ -156,6 +157,20 @@ 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,mysql55,odbc,interbase] then
     begin
@@ -169,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';
@@ -182,11 +197,15 @@ begin
       end;
     end;
 
-  if SQLDbType in [sqlite3] then
+  // DecimalSeparator must correspond to monetary locale (lc_monetary) set on PostgreSQL server
-    testValues[ftCurrency]:=testValues[ftBCD]; //decimal separator for currencies must be decimal point
+  // 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);
@@ -291,7 +310,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;
@@ -303,7 +325,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;
 

packages/fcl-db/tests/testfieldtypes.pas

@@ -778,12 +778,9 @@ begin
 
     end;
   TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
-
-
 end;
 
 procedure TTestFieldTypes.TestIntParamQuery;
-
 begin
   TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 end;
@@ -793,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;
@@ -821,7 +823,7 @@ end;
 
 procedure TTestFieldTypes.TestVarBytesParamQuery;
 begin
-  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount);
+  TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, SQLDbType<>mssql);
 end;
 
 procedure TTestFieldTypes.TestStringParamQuery;
@@ -835,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);
 
@@ -885,7 +881,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;
@@ -1241,6 +1240,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.');
@@ -1526,10 +1530,11 @@ begin
     begin
     with query do
       begin
-      if (sqlDBtype=interbase) then
+      case sqlDBtype of
-        SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
+        interbase : SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
-      else
+        mssql     : SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
-        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+        else        SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
+      end;
       Open;
       close;
       ServerFilter:='ID=21';
@@ -1650,7 +1655,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
@@ -1820,6 +1825,8 @@ begin
   else
   begin
     datatype:=FieldtypeDefinitions[ftTime];
+    if datatype = '' then
+      Ignore(STestNotApplicable);
     if sqlDBType = sqlite3 then
       testIntervalValuesCount := 5
     else if sqlDBType in MySQLdbTypes then
@@ -1847,6 +1854,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);
 
@@ -1919,14 +1932,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;
@@ -2050,4 +2063,3 @@ end;
 initialization
   if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
 end.
-

packages/fcl-db/tests/toolsunit.pas

@@ -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.
+    testValues[ftCurrency,i] := CurrToStr(testCurrencyValues[i],FormatSettings);
-    // 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[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