paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 17:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied tests pach from bug #17303

Browse Source 
git-svn-id: trunk@20572 -
This commit is contained in:
michael 2012-03-22 13:45:54 +00:00
parent df59758326
commit 386fb374ce
4 changed files with 87 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
packages/fcl-db/tests/database.ini.txt
View File

@ -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

65
packages/fcl-db/tests/sqldbtoolsunit.pas
View File

@ -6,14 +6,15 @@ interface
uses
Classes, SysUtils, toolsunit,
db,
sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, mysql51conn, mysql55conn, pqconnection,odbcconn,oracleconnection,sqlite3conn;
db, sqldb,
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',
'',
'DECIMAL(18,4)',
'', // ftCurrency
'DECIMAL(18,4)',// ftBCD
'DATE',
'TIME',
'TIMESTAMP',
'TIMESTAMP', // ftDateTime
'',
'',
'',
'BLOB',
'BLOB',
'BLOB',
'BLOB', // ftBlob
'BLOB', // ftMemo
'BLOB', // ftGraphic
'',
'',
'',
'',
'',
'CHAR(10)',
'CHAR(10)', // ftFixedChar
'',
'BIGINT',
'BIGINT', // ftLargeInt
'',
'',
'',
@ -52,9 +53,9 @@ const MySQLdbTypes = [mysql40,mysql41,mysql50,mysql51,mysql55];
'',
'',
'',
'',
'TIMESTAMP',
'NUMERIC(18,6)',
'', // ftGuid
'TIMESTAMP', // ftTimestamp
'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
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);
@ -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;

52
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -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
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';
@ -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.

5
packages/fcl-db/tests/toolsunit.pas
View File

@ -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