testsqldb.pas 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158
  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. { TTestTSQLQuery }
  12. TTestTSQLQuery = class(TTestCase)
  13. private
  14. protected
  15. procedure SetUp; override;
  16. procedure TearDown; override;
  17. published
  18. procedure TestUpdateServerIndexDefs;
  19. end;
  20. { TTestTSQLConnection }
  21. TTestTSQLConnection = class(TTestCase)
  22. private
  23. protected
  24. procedure SetUp; override;
  25. procedure TearDown; override;
  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. procedure TTestTSQLQuery.SetUp;
  97. begin
  98. inherited;
  99. InitialiseDBConnector;
  100. DBConnector.StartTest;
  101. end;
  102. procedure TTestTSQLConnection.SetUp;
  103. begin
  104. inherited;
  105. InitialiseDBConnector;
  106. DBConnector.StartTest;
  107. end;
  108. procedure TTestTSQLQuery.TearDown;
  109. begin
  110. DBConnector.StopTest;
  111. if assigned(DBConnector) then
  112. with TSQLDBConnector(DBConnector) do
  113. Transaction.Rollback;
  114. FreeDBConnector;
  115. inherited;
  116. end;
  117. procedure TTestTSQLConnection.TearDown;
  118. begin
  119. DBConnector.StopTest;
  120. if assigned(DBConnector) then
  121. with TSQLDBConnector(DBConnector) do
  122. Transaction.Rollback;
  123. FreeDBConnector;
  124. inherited;
  125. end;
  126. initialization
  127. if uppercase(dbconnectorname)='SQL' then
  128. begin
  129. RegisterTest(TTestTSQLQuery);
  130. RegisterTest(TTestTSQLConnection);
  131. end;
  132. end.