testsqldb.pas 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145
  1. unit TestSQLDB;
  2. {
  3. Unit tests which are specific to the sqlDB components like TSQLQuery, TSQLConnection.
  4. }
  5. {$mode objfpc}{$H+}
  6. interface
  7. uses
  8. Classes, SysUtils, fpcunit, testregistry,
  9. db;
  10. type
  11. { TSQLDBTestCase }
  12. TSQLDBTestCase = class(TTestCase)
  13. protected
  14. procedure SetUp; override;
  15. procedure TearDown; override;
  16. end;
  17. { TTestTSQLQuery }
  18. TTestTSQLQuery = class(TSQLDBTestCase)
  19. private
  20. published
  21. procedure TestUpdateServerIndexDefs;
  22. end;
  23. { TTestTSQLConnection }
  24. TTestTSQLConnection = class(TSQLDBTestCase)
  25. private
  26. published
  27. procedure ReplaceMe;
  28. end;
  29. implementation
  30. uses sqldbtoolsunit, toolsunit, sqldb;
  31. { TTestTSQLQuery }
  32. procedure TTestTSQLQuery.TestUpdateServerIndexDefs;
  33. var Q: TSQLQuery;
  34. name1, name2, name3: string;
  35. begin
  36. // Test retrieval of information about indexes on unquoted and quoted table names
  37. // (tests also case-sensitivity for DB's that support case-sensitivity of quoted identifiers)
  38. // For ODBC Firebird/Interbase we must define primary key as named constraint and
  39. // in ODBC driver must be set: "quoted identifiers" and "sensitive identifier"
  40. // See also: TTestFieldTypes.TestUpdateIndexDefs
  41. with TSQLDBConnector(DBConnector) do
  42. begin
  43. // SQLite ignores case-sensitivity of quoted table names
  44. // MS SQL Server case-sensitivity of identifiers depends on the case-sensitivity of default collation of the database
  45. // MySQL case-sensitivity depends on case-sensitivity of server's file system
  46. if SQLServerType in [ssMSSQL,ssSQLite{$IFDEF WINDOWS},ssMySQL{$ENDIF}] then
  47. name1 := Connection.FieldNameQuoteChars[0]+'fpdev 2'+Connection.FieldNameQuoteChars[1]
  48. else
  49. name1 := 'FPDEV2';
  50. ExecuteDirect('create table '+name1+' (id integer not null, constraint PK_FPDEV21 primary key(id))');
  51. // same but quoted table name
  52. name2 := Connection.FieldNameQuoteChars[0]+'FPdev2'+Connection.FieldNameQuoteChars[1];
  53. ExecuteDirect('create table '+name2+' (ID2 integer not null, constraint PK_FPDEV22 primary key(ID2))');
  54. // embedded quote in table name
  55. if SQLServerType in [ssMySQL] then
  56. name3 := '`FPdev``2`'
  57. else
  58. name3 := Connection.FieldNameQuoteChars[0]+'FPdev""2'+Connection.FieldNameQuoteChars[1];
  59. ExecuteDirect('create table '+name3+' (Id3 integer not null, constraint PK_FPDEV23 primary key(Id3))');
  60. CommitDDL;
  61. end;
  62. try
  63. Q := TSQLDBConnector(DBConnector).Query;
  64. Q.SQL.Text:='select * from '+name1;
  65. Q.Prepare;
  66. Q.ServerIndexDefs.Update;
  67. CheckEquals(1, Q.ServerIndexDefs.Count);
  68. Q.SQL.Text:='select * from '+name2;
  69. Q.Prepare;
  70. Q.ServerIndexDefs.Update;
  71. CheckEquals(1, Q.ServerIndexDefs.Count, '2.1');
  72. CheckTrue(CompareText('ID2', Q.ServerIndexDefs[0].Fields)=0, '2.2'+Q.ServerIndexDefs[0].Fields);
  73. CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '2.3');
  74. Q.SQL.Text:='select * from '+name3;
  75. Q.Prepare;
  76. Q.ServerIndexDefs.Update;
  77. CheckEquals(1, Q.ServerIndexDefs.Count, '3.1');
  78. CheckTrue(CompareText('ID3', Q.ServerIndexDefs[0].Fields)=0, '3.2');
  79. CheckTrue(Q.ServerIndexDefs[0].Options=[ixPrimary,ixUnique], '3.3');
  80. finally
  81. Q.UnPrepare;
  82. with TSQLDBConnector(DBConnector) do
  83. begin
  84. ExecuteDirect('DROP TABLE '+name1);
  85. ExecuteDirect('DROP TABLE '+name2);
  86. ExecuteDirect('DROP TABLE '+name3);
  87. CommitDDL;
  88. end;
  89. end;
  90. end;
  91. { TTestTSQLConnection }
  92. procedure TTestTSQLConnection.ReplaceMe;
  93. begin
  94. // replace this procedure with any test for TSQLConnection
  95. end;
  96. { TSQLDBTestCase }
  97. procedure TSQLDBTestCase.SetUp;
  98. begin
  99. inherited SetUp;
  100. InitialiseDBConnector;
  101. DBConnector.StartTest;
  102. end;
  103. procedure TSQLDBTestCase.TearDown;
  104. begin
  105. DBConnector.StopTest;
  106. if assigned(DBConnector) then
  107. with TSQLDBConnector(DBConnector) do
  108. Transaction.Rollback;
  109. FreeDBConnector;
  110. inherited TearDown;
  111. end;
  112. initialization
  113. if uppercase(dbconnectorname)='SQL' then
  114. begin
  115. RegisterTest(TTestTSQLQuery);
  116. RegisterTest(TTestTSQLConnection);
  117. end;
  118. end.