PageRenderTime 69ms CodeModel.GetById 28ms RepoModel.GetById 0ms app.codeStats 0ms

/packages/fcl-db/tests/testfieldtypes.pas

https://github.com/slibre/freepascal
Pascal | 2286 lines | 1929 code | 274 blank | 83 comment | 69 complexity | a80a47ecf165eafd751103b400d33a60 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
  1. unit TestFieldTypes;
  2. {$mode objfpc}{$H+}
  3. {$modeswitch nestedprocvars}
  4. interface
  5. uses
  6. Classes, SysUtils, fpcunit, testutils, testregistry,
  7. db;
  8. type
  9. TParamProc = procedure(AParam:TParam; i : integer);
  10. TFieldProc = procedure(AField:TField; i : integer);
  11. TGetSQLTextProc = function(const i: integer) : string; { is nested;}
  12. TCheckFieldValueProc = procedure(AField:TField; i : integer) is nested;
  13. { TTestFieldTypes }
  14. TTestFieldTypes= class(TTestCase)
  15. private
  16. procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
  17. procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
  18. procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
  19. ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
  20. ACheckFieldValueProc: TCheckFieldValueProc);
  21. procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
  22. procedure TestSetBlobAsParam(asWhat : integer);
  23. protected
  24. procedure SetUp; override;
  25. procedure TearDown; override;
  26. procedure RunTest; override;
  27. published
  28. procedure TestEmptyUpdateQuery; // bug 13654
  29. procedure TestParseJoins; // bug 10148
  30. procedure TestDoubleFieldNames; // bug 8457
  31. procedure TestParseUnion; // bug 8442
  32. procedure TestInsertLargeStrFields; // bug 9600
  33. procedure TestNumericNames; // Bug9661
  34. procedure TestApplyUpdFieldnames; // Bug 12275;
  35. procedure TestServerFilter; // bug 15456
  36. procedure Test11Params;
  37. procedure TestRowsAffected; // bug 9758
  38. procedure TestLocateNull;
  39. procedure TestLocateOnMoreRecords;
  40. procedure TestStringsReplace;
  41. procedure TestCircularParams;
  42. procedure TestBug9744;
  43. procedure TestCrossStringDateParam;
  44. procedure TestGetFieldNames;
  45. procedure TestUpdateIndexDefs;
  46. procedure TestMultipleFieldPKIndexDefs;
  47. procedure TestGetIndexDefs;
  48. procedure TestSetBlobAsMemoParam;
  49. procedure TestSetBlobAsBlobParam;
  50. procedure TestSetBlobAsStringParam;
  51. procedure TestNonNullableParams;
  52. procedure TestDblQuoteEscComments;
  53. procedure TestpfInUpdateFlag; // bug 7565
  54. procedure TestScript;
  55. procedure TestInsertReturningQuery;
  56. procedure TestOpenStoredProc;
  57. procedure TestOpenSpecialStatements;
  58. procedure TestTemporaryTable;
  59. procedure TestRefresh;
  60. procedure TestParametersAndDates;
  61. procedure TestExceptOnsecClose;
  62. procedure TestErrorOnEmptyStatement;
  63. procedure TestBlob;
  64. procedure TestChangeBlob;
  65. procedure TestBlobGetText;
  66. procedure TestBlobSize;
  67. procedure TestLargeRecordSize;
  68. procedure TestInt;
  69. procedure TestNumeric;
  70. procedure TestFloat;
  71. procedure TestDate;
  72. procedure TestDateTime; // bug 6925
  73. procedure TestString;
  74. procedure TestUnlVarChar;
  75. procedure TestNullValues;
  76. procedure TestParamQuery;
  77. procedure TestStringParamQuery;
  78. procedure TestFixedStringParamQuery;
  79. procedure TestDateParamQuery;
  80. procedure TestSmallIntParamQuery;
  81. procedure TestIntParamQuery;
  82. procedure TestLargeIntParamQuery;
  83. procedure TestTimeParamQuery;
  84. procedure TestDateTimeParamQuery;
  85. procedure TestFmtBCDParamQuery;
  86. procedure TestFloatParamQuery;
  87. procedure TestBCDParamQuery;
  88. procedure TestBytesParamQuery;
  89. procedure TestVarBytesParamQuery;
  90. procedure TestBooleanParamQuery;
  91. procedure TestAggregates;
  92. procedure TestStringLargerThen8192;
  93. procedure TestQueryAfterReconnect; // bug 16438
  94. // SchemaType tests
  95. procedure TestTableNames;
  96. procedure TestFieldNames;
  97. procedure TestClearUpdateableStatus;
  98. procedure TestReadOnlyParseSQL; // bug 9254
  99. procedure TestGetTables;
  100. // Test SQL-field type recognition
  101. procedure TestSQLClob;
  102. procedure TestSQLLargeint;
  103. procedure TestSQLInterval;
  104. procedure TestSQLIdentity;
  105. procedure TestSQLReal;
  106. end;
  107. implementation
  108. uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
  109. Type HackedDataset = class(TDataset);
  110. const
  111. testFloatValuesCount = 21;
  112. testFloatValues : Array[0..testFloatValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
  113. testBCDValuesCount = 10;
  114. testBCDValues : Array[0..testBCDValuesCount-1] of currency = (-100,54.53,1.2345,123.5345,0,1,-1,0,1.42,1324.4324);
  115. testIntValuesCount = 17;
  116. testIntValues : Array[0..testIntValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
  117. testDateValuesCount = 18;
  118. testDateValues : Array[0..testDateValuesCount-1] of string = (
  119. '2000-01-01',
  120. '1999-12-31',
  121. '2004-02-29',
  122. '2004-03-01',
  123. '1991-02-28',
  124. '1991-03-01',
  125. '2040-10-16',
  126. '1977-09-29',
  127. '1899-12-29',
  128. '1899-12-30',
  129. '1899-12-31',
  130. '1900-01-01',
  131. '1800-03-30',
  132. '1754-06-04',
  133. '1650-05-10',
  134. '0904-04-12',
  135. '0199-07-09',
  136. '0001-01-01'
  137. );
  138. testBytesValuesCount = 5;
  139. testVarBytesValuesCount = 8;
  140. testBytesValues : Array[0..testVarBytesValuesCount-1] of shortstring = (
  141. #1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10,
  142. '', #0, #0#1#2#3#4#5#6#7#8#9
  143. );
  144. STestNotApplicable = 'This test does not apply to this sqldb-connection type';
  145. procedure TTestFieldTypes.TestpfInUpdateFlag;
  146. var ds : TCustomBufDataset;
  147. AFld1, AFld2, AFld3 : Tfield;
  148. begin
  149. ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
  150. with ds do
  151. begin
  152. AFld1 := TIntegerField.Create(ds);
  153. AFld1.FieldName := 'ID';
  154. AFld1.DataSet := ds;
  155. AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
  156. AFld2 := TStringField.Create(ds);
  157. AFld2.FieldName := 'NAME';
  158. AFld2.DataSet := ds;
  159. AFld3 := TIntegerField.Create(ds);
  160. AFld3.FieldName := 'CALCFLD';
  161. AFld3.DataSet := ds;
  162. Afld3.FieldKind := fkCalculated;
  163. AFld3.ProviderFlags := []; // do not include calculated fields into generated sql insert/update
  164. Open;
  165. Edit;
  166. FieldByName('ID').AsInteger := 254;
  167. Post;
  168. ApplyUpdates;
  169. Append;
  170. FieldByName('ID').AsInteger := 255;
  171. Post;
  172. ApplyUpdates;
  173. Close;
  174. AFld1.Free;
  175. AFld2.Free;
  176. AFld3.Free;
  177. end;
  178. end;
  179. procedure TTestFieldTypes.TestScript;
  180. var Ascript : TSQLScript;
  181. begin
  182. Ascript := tsqlscript.create(nil);
  183. try
  184. with Ascript do
  185. begin
  186. DataBase := TSQLDBConnector(DBConnector).Connection;
  187. transaction := TSQLDBConnector(DBConnector).Transaction;
  188. script.clear;
  189. script.append('create table a (id int);');
  190. script.append('create table b (id int);');
  191. ExecuteScript;
  192. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  193. TSQLDBConnector(DBConnector).CommitDDL;
  194. end;
  195. finally
  196. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
  197. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
  198. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  199. TSQLDBConnector(DBConnector).CommitDDL;
  200. end;
  201. end;
  202. procedure TTestFieldTypes.TestLargeRecordSize;
  203. begin
  204. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
  205. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  206. TSQLDBConnector(DBConnector).CommitDDL;
  207. with TSQLDBConnector(DBConnector).Query do
  208. begin
  209. sql.clear;
  210. sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVR￿INA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
  211. ExecSQL;
  212. sql.clear;
  213. sql.append('select * from FPDEV2');
  214. open;
  215. AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
  216. AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
  217. close;
  218. end;
  219. end;
  220. procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
  221. ASQLTypeDecl: string);
  222. begin
  223. with TSQLDBConnector(DBConnector) do
  224. begin
  225. Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
  226. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  227. CommitDDL;
  228. end;
  229. end;
  230. procedure TTestFieldTypes.TestFieldDeclaration(ADatatype: TFieldType;
  231. ADataSize: integer);
  232. begin
  233. with TSQLDBConnector(DBConnector).Query do
  234. begin
  235. SQL.Clear;
  236. SQL.Add('select * from FPDEV2');
  237. Open;
  238. AssertEquals(1,FieldCount);
  239. AssertTrue(CompareText('FT',fields[0].FieldName)=0);
  240. AssertEquals('DataSize', ADataSize, Fields[0].DataSize);
  241. AssertEquals('DataType', ord(ADatatype), ord(Fields[0].DataType));
  242. Close;
  243. end;
  244. end;
  245. procedure TTestFieldTypes.TestInt;
  246. var
  247. i : byte;
  248. begin
  249. CreateTableWithFieldType(ftInteger,'INT');
  250. TestFieldDeclaration(ftInteger,4);
  251. for i := 0 to testIntValuesCount-1 do
  252. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
  253. with TSQLDBConnector(DBConnector).Query do
  254. begin
  255. Open;
  256. for i := 0 to testIntValuesCount-1 do
  257. begin
  258. AssertEquals(testIntValues[i],fields[0].AsInteger);
  259. Next;
  260. end;
  261. close;
  262. end;
  263. end;
  264. procedure TTestFieldTypes.TestNumeric;
  265. const
  266. testValuesCount = 13;
  267. testValues4 : Array[0..testValuesCount-1] of currency = (-99.99,-12.34,-10.2,-10,-0.5,-0.01,0,0.01,0.5,10,10.2,12.34,99.99);
  268. testValues9 : Array[0..testValuesCount-1] of currency = (-123456.789,-10000,-1875.25,-10,-0.5,-0.001,0,0.001,0.5,10,1875.25,10000,123456.789);
  269. FieldTypes: array [0..7] of TFieldType = (ftBCD, ftBCD, ftBCD, ftFmtBCD, ftLargeInt, ftFmtBCD, ftFmtBCD, ftFmtBCD);
  270. FieldSizes: array [0..7] of integer = (4,2,3,5,0,3,5,0); //scale
  271. var
  272. i,d : integer;
  273. s,s4,s9 : string;
  274. t : TFieldType;
  275. begin
  276. with TSQLDBConnector(DBConnector) do begin
  277. if SQLConnType = INTERBASE then
  278. begin
  279. //Interbase internal storage of exact numeric data types based on precision:
  280. // 1-4 (smallint), 5-9 (integer), 10-18 (int64)
  281. s := ''; //Interbase supports precision up to 18 only
  282. FieldTypes[5] := ftBCD; //ATM TIBConnection incorrectly maps NUMERIC(18,3) to ftBCD
  283. end
  284. else
  285. s := ', N19_0 NUMERIC(19,0)';
  286. Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N4_2 NUMERIC(4,2), N9_3 NUMERIC(9,3), N9_5 NUMERIC(9,5), N18_0 NUMERIC(18,0), N18_3 NUMERIC(18,3), N18_5 NUMERIC(18,5)' + s + ')');
  287. CommitDDL;
  288. with Query do
  289. begin
  290. SQL.Text := 'select * from FPDEV2';
  291. Open;
  292. for i := 0 to FieldCount-1 do
  293. begin
  294. case Fields[i].DataType of
  295. ftBCD: d := sizeof(Currency);
  296. ftFmtBCD: d := sizeof(TBCD);
  297. ftLargeInt: d := sizeof(int64);
  298. else d := 0;
  299. end;
  300. t := FieldTypes[i];
  301. if t = ftLargeInt then t := ftFmtBCD; //acceptable alternative
  302. AssertEquals(Fields[i].DataSize, d);
  303. AssertTrue(Fields[i].DataType in [FieldTypes[i], t]);
  304. AssertEquals(Fields[i].Size, FieldSizes[i]);
  305. end;
  306. Close;
  307. end;
  308. for i := 0 to testValuesCount-1 do
  309. begin
  310. s4 := CurrToStrF(testValues4[i],ffFixed,2,DBConnector.FormatSettings);
  311. s9 := CurrToStrF(testValues9[i],ffFixed,3,DBConnector.FormatSettings);
  312. Connection.ExecuteDirect(format('insert into FPDEV2 (N4_2,N9_5,FT,N9_3,N18_3,N18_5) values (%s,%s,%s,%s,%s,%s)', [s4,s4,s9,s9,s9,s9]));
  313. end;
  314. with Query do
  315. begin
  316. Open;
  317. for i := 0 to testValuesCount-1 do
  318. begin
  319. AssertEquals(testValues4[i], Fields[1].AsCurrency);
  320. AssertEquals(testValues4[i], Fields[3].AsCurrency);
  321. AssertEquals(testValues9[i], Fields[0].AsCurrency);
  322. AssertEquals(testValues9[i], Fields[2].AsCurrency);
  323. AssertEquals(testValues9[i], Fields[5].AsCurrency);
  324. AssertEquals(testValues9[i], Fields[6].AsCurrency);
  325. Next;
  326. end;
  327. Close;
  328. end;
  329. end;
  330. end;
  331. procedure TTestFieldTypes.TestFloat;
  332. const
  333. testValuesCount = 21;
  334. testValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
  335. var
  336. i : byte;
  337. begin
  338. CreateTableWithFieldType(ftFloat,'FLOAT');
  339. TestFieldDeclaration(ftFloat,sizeof(double));
  340. for i := 0 to testValuesCount-1 do
  341. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + floattostr(testValues[i],DBConnector.FormatSettings) + ')');
  342. with TSQLDBConnector(DBConnector).Query do
  343. begin
  344. Open;
  345. for i := 0 to testValuesCount-1 do
  346. begin
  347. AssertEquals(testValues[i],fields[0].AsFloat);
  348. Next;
  349. end;
  350. close;
  351. end;
  352. end;
  353. procedure TTestFieldTypes.TestString;
  354. const
  355. testValuesCount = 19;
  356. testValues : Array[0..testValuesCount-1] of string = (
  357. '',
  358. 'a',
  359. 'ab',
  360. 'abc',
  361. 'abcd',
  362. 'abcde',
  363. 'abcdef',
  364. 'abcdefg',
  365. 'abcdefgh',
  366. 'abcdefghi',
  367. 'abcdefghij',
  368. 'lMnOpQrStU',
  369. '1234567890',
  370. '_!@#$%^&*(',
  371. ')-;:/?.<>',
  372. '~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
  373. ' WRaP ',
  374. 'wRaP ',
  375. ' wRAP'
  376. );
  377. var
  378. i : byte;
  379. begin
  380. CreateTableWithFieldType(ftString,'VARCHAR(10)');
  381. TestFieldDeclaration(ftString,11);
  382. for i := 0 to testValuesCount-1 do
  383. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  384. with TSQLDBConnector(DBConnector).Query do
  385. begin
  386. Open;
  387. for i := 0 to testValuesCount-1 do
  388. begin
  389. AssertEquals(testValues[i], Fields[0].AsString);
  390. Next;
  391. end;
  392. close;
  393. end;
  394. end;
  395. procedure TTestFieldTypes.TestUnlVarChar;
  396. const
  397. testValuesCount = 21;
  398. testValues : Array[0..testValuesCount-1] of string = (
  399. '',
  400. 'a',
  401. 'ab',
  402. 'abc',
  403. 'abcd',
  404. 'abcde',
  405. 'abcdef',
  406. 'abcdefg',
  407. 'abcdefgh',
  408. 'abcdefghi',
  409. 'abcdefghij',
  410. 'lMnOpQrStU',
  411. '1234567890',
  412. '_!@#$%^&*(',
  413. ')-;:/?.<>',
  414. '~`|{}- =',
  415. ' WRaP ',
  416. 'wRaP ',
  417. ' wRAP',
  418. '0123456789',
  419. 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
  420. + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
  421. );
  422. var
  423. i : byte;
  424. begin
  425. if SQLConnType<>postgresql then Ignore('This test does only apply to Postgres, since others don''t support varchars without length given');
  426. CreateTableWithFieldType(ftString,'VARCHAR');
  427. TestFieldDeclaration(ftString,dsMaxStringSize+1);
  428. for i := 0 to testValuesCount-1 do
  429. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  430. with TSQLDBConnector(DBConnector).Query do
  431. begin
  432. Open;
  433. for i := 0 to testValuesCount-1 do
  434. begin
  435. AssertEquals(testValues[i],fields[0].AsString);
  436. Next;
  437. end;
  438. close;
  439. end;
  440. end;
  441. procedure TTestFieldTypes.TestDate;
  442. var
  443. i : byte;
  444. begin
  445. CreateTableWithFieldType(ftDate,'DATE');
  446. TestFieldDeclaration(ftDate,8);
  447. for i := 0 to testDateValuesCount-1 do
  448. if SQLConnType=oracle then
  449. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testDateValues[i] + ''',''YYYY-MM-DD''))')
  450. else
  451. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testDateValues[i] + ''')');
  452. with TSQLDBConnector(DBConnector).Query do
  453. begin
  454. Open;
  455. for i := 0 to testDateValuesCount-1 do
  456. begin
  457. AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings));
  458. Next;
  459. end;
  460. close;
  461. end;
  462. end;
  463. procedure TTestFieldTypes.TestDateTime;
  464. const
  465. testValuesCount = 31;
  466. testValues : Array[0..testValuesCount-1] of string = (
  467. '2000-01-01',
  468. '1999-12-31',
  469. '2004-02-29',
  470. '2004-03-01',
  471. '1991-02-28',
  472. '1991-03-01',
  473. '1977-09-29',
  474. '2000-01-01 10:00:00',
  475. '2000-01-01 23:59:59',
  476. '1994-03-06 11:54:30',
  477. '2040-10-16', // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
  478. '2100-01-01 01:01:01',
  479. '1903-04-02 01:04:02',
  480. '1900-01-01',
  481. '1899-12-31',
  482. '1899-12-30',
  483. '1899-12-29',
  484. '1899-12-30 18:00:51',
  485. '1899-12-30 04:00:51',
  486. '1899-12-29 04:00:51',
  487. '1899-12-29 18:00:51',
  488. '1815-09-24 03:47:22',
  489. '1800-03-30',
  490. '1754-06-04',
  491. '1650-05-10', // MS SQL 2005 doesn't support datetimes before 1753
  492. '1400-02-03 12:21:53',
  493. '1333-02-03 21:44:21',
  494. '0904-04-12',
  495. '0354-11-20 21:25:15',
  496. '0199-07-09',
  497. '0001-01-01'
  498. );
  499. var
  500. i : byte;
  501. begin
  502. CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
  503. TestFieldDeclaration(ftDateTime,8);
  504. for i := 0 to testValuesCount-1 do
  505. if SQLConnType=oracle then
  506. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
  507. else
  508. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  509. with TSQLDBConnector(DBConnector).Query do
  510. begin
  511. Open;
  512. for i := 0 to testValuesCount-1 do
  513. begin
  514. if length(testValues[i]) < 12 then
  515. AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
  516. else
  517. AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss', fields[0].AsDateTime, DBConnector.FormatSettings));
  518. Next;
  519. end;
  520. close;
  521. end;
  522. end;
  523. procedure TTestFieldTypes.TestChangeBlob;
  524. var s : string;
  525. begin
  526. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
  527. TSQLDBConnector(DBConnector).CommitDDL;
  528. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
  529. with TSQLDBConnector(DBConnector).Query do
  530. begin
  531. sql.clear;
  532. sql.add('select * from FPDEV2');
  533. Open;
  534. fields[1].ProviderFlags := [pfInUpdate]; // blob niet in de where
  535. UpdateMode := upWhereAll;
  536. AssertEquals('Test deze blob',fields[1].AsString);
  537. edit;
  538. // Dat werkt niet lekker, omdat de stream vernield wordt...
  539. // fields[0].asstring := 'Deze blob is gewijzigd!';
  540. With Createblobstream(fields[1],bmwrite) do
  541. begin
  542. s := 'Deze blob is gewijzigd!';
  543. WriteBuffer(Pointer(s)^,Length(s));
  544. post;
  545. free;
  546. end;
  547. AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
  548. ApplyUpdates(0);
  549. TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
  550. close;
  551. open;
  552. AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
  553. close;
  554. end;
  555. end;
  556. procedure TTestFieldTypes.TestBlobGetText;
  557. begin
  558. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  559. TestFieldDeclaration(ftBlob,0);
  560. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  561. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (Null)');
  562. with TSQLDBConnector(DBConnector).Query do
  563. begin
  564. Open;
  565. AssertFalse(fields[0].IsNull);
  566. AssertEquals('(BLOB)',fields[0].DisplayText);
  567. AssertEquals('Test deze blob',fields[0].AsString);
  568. Next;
  569. AssertTrue(fields[0].IsNull);
  570. AssertEquals('(blob)',fields[0].Text);
  571. AssertEquals('',fields[0].AsString);
  572. close;
  573. end;
  574. end;
  575. procedure TTestFieldTypes.TestBlobSize;
  576. begin
  577. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  578. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  579. with TSQLDBConnector(DBConnector).Query do
  580. begin
  581. sql.text := 'select * from FPDEV2';
  582. Open;
  583. AssertEquals(14,TBlobField(fields[0]).BlobSize);
  584. close;
  585. end;
  586. end;
  587. procedure TTestFieldTypes.TestBlob;
  588. begin
  589. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  590. TestFieldDeclaration(ftBlob,0);
  591. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  592. with TSQLDBConnector(DBConnector).Query do
  593. begin
  594. Open;
  595. AssertEquals('Test deze blob',fields[0].AsString);
  596. close;
  597. end;
  598. end;
  599. procedure TTestFieldTypes.TestNullValues;
  600. begin
  601. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
  602. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  603. TSQLDBConnector(DBConnector).CommitDDL;
  604. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FIELD1) values (1)');
  605. with TSQLDBConnector(DBConnector).Query do
  606. begin
  607. sql.clear;
  608. sql.append('select * from FPDEV2');
  609. open;
  610. AssertEquals(1,FieldByName('FIELD1').AsInteger);
  611. AssertTrue('Null-values test failed',FieldByName('FIELD2').IsNull);
  612. close;
  613. end;
  614. end;
  615. procedure TTestFieldTypes.TestParamQuery;
  616. // Tests running insert queries using parameters
  617. const
  618. DecoyFieldData1='decoytest';
  619. DecoyFieldData2=':decoy ::test $decoy2 $$2';
  620. begin
  621. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT, FIELD3 INT, DECOY VARCHAR(30))');
  622. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  623. TSQLDBConnector(DBConnector).CommitDDL;
  624. with TSQLDBConnector(DBConnector).Query do
  625. begin
  626. sql.clear;
  627. sql.append('insert into FPDEV2 (field1) values (:field1)');
  628. Params.ParamByName('field1').AsInteger := 1;
  629. ExecSQL;
  630. sql.clear;
  631. sql.append('insert into FPDEV2 (field1,field2,decoy) values (:field1,:field2,'''+DecoyFieldData1+''')');
  632. Params.ParamByName('field1').AsInteger := 2;
  633. Params.ParamByName('field2').DataType := ftInteger;
  634. Params.ParamByName('field2').Value := Null;
  635. ExecSQL;
  636. sql.clear;
  637. sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field3)');
  638. Params.ParamByName('field1').AsInteger := 3;
  639. Params.ParamByName('field2').AsInteger := 2;
  640. Params.ParamByName('field3').AsInteger := 3;
  641. ExecSQL;
  642. sql.clear;
  643. sql.append('insert into FPDEV2 (field1,field2,field3,decoy) values (:field1,:field2,:field3,'''+DecoyFieldData2+''')');
  644. Params.ParamByName('field1').AsInteger := 4;
  645. Params.ParamByName('field2').AsInteger := 2;
  646. Params.ParamByName('field3').AsInteger := 3;
  647. ExecSQL;
  648. sql.clear;
  649. sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field1)');
  650. Params.ParamByName('field1').AsInteger := 5;
  651. Params.ParamByName('field2').AsInteger := 2;
  652. ExecSQL;
  653. sql.clear;
  654. sql.append('select * from FPDEV2 order by FIELD1');
  655. open;
  656. AssertEquals(1,FieldByName('FIELD1').asinteger);
  657. AssertTrue(FieldByName('FIELD2').IsNull);
  658. AssertTrue(FieldByName('FIELD3').IsNull);
  659. AssertTrue(FieldByName('DECOY').IsNull);
  660. next;
  661. AssertEquals(2,FieldByName('FIELD1').asinteger);
  662. AssertTrue(FieldByName('FIELD2').IsNull);
  663. AssertTrue(FieldByName('FIELD3').IsNull);
  664. AssertEquals(DecoyFieldData1,FieldByName('DECOY').AsString);
  665. next;
  666. AssertEquals(3,FieldByName('FIELD1').asinteger);
  667. AssertEquals(2,FieldByName('FIELD2').asinteger);
  668. AssertEquals(3,FieldByName('FIELD3').asinteger);
  669. AssertTrue(FieldByName('DECOY').IsNull);
  670. next;
  671. AssertEquals(4,FieldByName('FIELD1').asinteger);
  672. AssertEquals(2,FieldByName('FIELD2').asinteger);
  673. AssertEquals(3,FieldByName('FIELD3').asinteger);
  674. AssertEquals(DecoyFieldData2,FieldByName('DECOY').AsString);
  675. next;
  676. AssertEquals(5,FieldByName('FIELD1').asinteger);
  677. AssertEquals(2,FieldByName('FIELD2').asinteger);
  678. AssertEquals(5,FieldByName('FIELD3').asinteger);
  679. AssertTrue(FieldByName('DECOY').IsNull);
  680. close;
  681. end;
  682. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  683. end;
  684. procedure TTestFieldTypes.TestSmallIntParamQuery;
  685. begin
  686. TestXXParamQuery(ftSmallInt,FieldtypeDefinitions[ftSmallInt],testValuesCount);
  687. end;
  688. procedure TTestFieldTypes.TestIntParamQuery;
  689. begin
  690. TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
  691. end;
  692. procedure TTestFieldTypes.TestLargeIntParamQuery;
  693. begin
  694. TestXXParamQuery(ftLargeInt,FieldtypeDefinitions[ftLargeInt],testValuesCount);
  695. end;
  696. procedure TTestFieldTypes.TestFmtBCDParamQuery;
  697. begin
  698. TestXXParamQuery(ftFMTBcd,FieldtypeDefinitions[ftFMTBcd],testValuesCount);
  699. end;
  700. procedure TTestFieldTypes.TestDateParamQuery;
  701. begin
  702. TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
  703. end;
  704. procedure TTestFieldTypes.TestCrossStringDateParam;
  705. begin
  706. TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount,True);
  707. end;
  708. procedure TTestFieldTypes.TestTimeParamQuery;
  709. begin
  710. TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
  711. end;
  712. procedure TTestFieldTypes.TestDateTimeParamQuery;
  713. begin
  714. TestXXParamQuery(ftDateTime,FieldtypeDefinitions[ftDateTime],testValuesCount);
  715. end;
  716. procedure TTestFieldTypes.TestFloatParamQuery;
  717. begin
  718. TestXXParamQuery(ftFloat,FieldtypeDefinitions[ftFloat],testFloatValuesCount);
  719. end;
  720. procedure TTestFieldTypes.TestBCDParamQuery;
  721. begin
  722. TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
  723. end;
  724. procedure TTestFieldTypes.TestBytesParamQuery;
  725. begin
  726. TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, true);
  727. end;
  728. procedure TTestFieldTypes.TestVarBytesParamQuery;
  729. begin
  730. TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, not(SQLServerType in [ssMSSQL, ssSybase]));
  731. end;
  732. procedure TTestFieldTypes.TestBooleanParamQuery;
  733. begin
  734. TestXXParamQuery(ftBoolean, FieldtypeDefinitions[ftBoolean], testValuesCount);
  735. end;
  736. procedure TTestFieldTypes.TestStringParamQuery;
  737. begin
  738. TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
  739. end;
  740. procedure TTestFieldTypes.TestFixedStringParamQuery;
  741. begin
  742. TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
  743. end;
  744. procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuesCount : integer; Cross : boolean = false);
  745. var i : integer;
  746. begin
  747. if ASQLTypeDecl = '' then
  748. Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
  749. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
  750. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  751. TSQLDBConnector(DBConnector).CommitDDL;
  752. with TSQLDBConnector(DBConnector).Query do
  753. begin
  754. sql.clear;
  755. sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
  756. // There is no Param.AsFixedChar, so the datatype has to be set manually
  757. if ADatatype=ftFixedChar then
  758. Params.ParamByName('field1').DataType := ftFixedChar;
  759. for i := 0 to testValuesCount -1 do
  760. begin
  761. Params.ParamByName('id').AsInteger := i;
  762. case ADataType of
  763. ftSmallInt: Params.ParamByName('field1').AsSmallInt := testSmallIntValues[i];
  764. ftInteger: Params.ParamByName('field1').AsInteger := testIntValues[i];
  765. ftLargeInt: Params.ParamByName('field1').AsLargeInt := testLargeIntValues[i];
  766. ftBoolean: Params.ParamByName('field1').AsBoolean := testBooleanValues[i];
  767. ftFloat : Params.ParamByName('field1').AsFloat := testFloatValues[i];
  768. ftBCD : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
  769. ftFixedChar,
  770. ftString : Params.ParamByName('field1').AsString := testValues[ADataType,i];
  771. ftTime : Params.ParamByName('field1').AsTime := TimeStringToDateTime(testTimeValues[i]);
  772. ftDate : if cross then
  773. Params.ParamByName('field1').AsString:= testDateValues[i]
  774. else
  775. Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
  776. ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
  777. ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings);
  778. ftBytes : if cross then
  779. Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
  780. else
  781. Params.ParamByName('field1').AsBlob := testBytesValues[i];
  782. ftVarBytes:if cross then
  783. Params.ParamByName('field1').AsString := testBytesValues[i]
  784. else
  785. Params.ParamByName('field1').AsBlob := testBytesValues[i];
  786. else
  787. AssertTrue('no test for paramtype available',False);
  788. end;
  789. ExecSQL;
  790. end;
  791. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  792. sql.clear;
  793. sql.append('select * from FPDEV2 order by ID');
  794. open;
  795. for i := 0 to testValuesCount -1 do
  796. begin
  797. AssertEquals(i,FieldByName('ID').AsInteger);
  798. case ADataType of
  799. ftSmallInt: AssertEquals(testSmallIntValues[i],FieldByName('FIELD1').AsInteger);
  800. ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
  801. ftLargeInt: AssertEquals(testLargeIntValues[i],FieldByName('FIELD1').AsLargeInt);
  802. ftBoolean: AssertEquals(testBooleanValues[i],FieldByName('FIELD1').AsBoolean);
  803. ftFloat : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
  804. ftBCD : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
  805. ftFixedChar : AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
  806. ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
  807. ftTime : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
  808. ftDate : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
  809. ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
  810. ftFMTBcd : AssertEquals(testFmtBCDValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
  811. ftVarBytes,
  812. ftBytes : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
  813. else
  814. AssertTrue('no test for paramtype available',False);
  815. end;
  816. Next;
  817. end;
  818. close;
  819. end;
  820. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  821. end;
  822. procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
  823. const
  824. TestValue='Test deze BLob';
  825. var
  826. ASQL : TSQLQuery;
  827. begin
  828. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  829. TestFieldDeclaration(ftBlob,0);
  830. ASQL := DBConnector.GetNDataset(True,1) as tsqlquery;
  831. with ASql do
  832. begin
  833. sql.Text := 'insert into FPDEV2 (FT) values (:BlobParam)';
  834. case asWhat of
  835. 0: Params.ParamByName('blobParam').AsMemo := TestValue;
  836. 1: Params.ParamByName('blobParam').AsString := TestValue;
  837. 2: Params.ParamByName('blobParam').AsBlob := TestValue;
  838. end;
  839. ExecSQL;
  840. end;
  841. with TSQLDBConnector(DBConnector).Query do
  842. begin
  843. Open;
  844. if not eof then
  845. AssertEquals(TestValue, Fields[0].AsString);
  846. close;
  847. end;
  848. end;
  849. procedure TTestFieldTypes.TestSetBlobAsMemoParam;
  850. begin
  851. // Firebird/Interbase ODBC driver : if parameter of ValueType=SQL_C_CHAR is bind to BLOB column
  852. // driver interprets character data as hexadecimal string and performs conversion ('FF10'=#255#16)
  853. TestSetBlobAsParam(0);
  854. end;
  855. procedure TTestFieldTypes.TestSetBlobAsStringParam;
  856. begin
  857. TestSetBlobAsParam(1);
  858. end;
  859. procedure TTestFieldTypes.TestSetBlobAsBlobParam;
  860. begin
  861. TestSetBlobAsParam(2);
  862. end;
  863. procedure TTestFieldTypes.TestAggregates;
  864. begin
  865. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
  866. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  867. TSQLDBConnector(DBConnector).CommitDDL;
  868. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
  869. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
  870. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
  871. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
  872. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  873. with TSQLDBConnector(DBConnector).Query do
  874. begin
  875. sql.clear;
  876. sql.append('select count(*) from FPDEV2');
  877. open;
  878. AssertEquals(4,Fields[0].AsInteger);
  879. close;
  880. sql.clear;
  881. sql.append('select sum(FIELD1) from FPDEV2');
  882. open;
  883. AssertEquals(10,Fields[0].AsInteger);
  884. close;
  885. sql.clear;
  886. sql.append('select avg(FIELD2) from FPDEV2');
  887. open;
  888. AssertEquals(3,Fields[0].AsInteger);
  889. close;
  890. end;
  891. end;
  892. procedure TTestFieldTypes.TestQueryAfterReconnect;
  893. var DS: TDataset;
  894. begin
  895. ds := DBConnector.GetNDataset(true,5);
  896. with ds do
  897. begin
  898. open;
  899. close;
  900. TSQLDBConnector(DBConnector).Connection.Close;
  901. TSQLDBConnector(DBConnector).Connection.Open;
  902. open;
  903. close;
  904. end;
  905. end;
  906. procedure TTestFieldTypes.TestLocateNull;
  907. var DS: TCustomBufDataset;
  908. begin
  909. ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset;
  910. with ds do
  911. begin
  912. open;
  913. edit;
  914. fieldbyname('name').Clear;
  915. post;
  916. next;
  917. AssertFalse(Locate('name',VarArrayOf(['TestName1']),[]));
  918. AssertTrue(Locate('name',VarArrayOf([Null]),[]));
  919. AssertEquals(1,fieldbyname('ID').AsInteger);
  920. end;
  921. end;
  922. procedure TTestFieldTypes.TestLocateOnMoreRecords;
  923. var DS: TCustomBufDataset;
  924. begin
  925. with TSQLDBConnector(DBConnector) do
  926. begin
  927. ds := GetNDataset(true,30) as TCustomBufDataset;
  928. with query do
  929. begin
  930. SQL.Text:='update FPDEV set NAME = null where ID<11;';
  931. ExecSQL;
  932. SQL.Text:='update FPDEV set NAME = null where (ID>11) and (ID<23);';
  933. ExecSQL;
  934. end;
  935. with ds do
  936. begin
  937. Open;
  938. // Must be exactly 11 to trigger bug/test
  939. AssertTrue(Locate('name',VarArrayOf(['TestName11']),[]));
  940. AssertEquals(11,fieldbyname('ID').AsInteger);
  941. // Must be exactly 23 to trigger bug/test
  942. AssertTrue(Locate('name',VarArrayOf(['TestName23']),[]));
  943. AssertEquals(23,fieldbyname('ID').AsInteger);
  944. end;
  945. end;
  946. end;
  947. procedure TTestFieldTypes.TestRefresh;
  948. var ADataset: TDataset;
  949. i: integer;
  950. AFldID, AFldName: TField;
  951. begin
  952. ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5);
  953. Adataset.Open;
  954. AFldId:=Adataset.Fields[0];
  955. AFldName:=Adataset.Fields[1];
  956. for i := 1 to 5 do
  957. begin
  958. AssertEquals(i,AFldID.asinteger);
  959. AssertEquals('TestName'+inttostr(i),AFldName.asstring);
  960. ADataset.Next;
  961. end;
  962. ADataset.Next;
  963. AssertTrue(ADataset.EOF);
  964. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''test'' where ID=2');
  965. ADataset.Refresh;
  966. ADataset.First;
  967. for i := 1 to 5 do
  968. begin
  969. AssertEquals(i,AFldID.AsInteger);
  970. if i = 2 then
  971. AssertEquals('test',AFldName.AsString)
  972. else
  973. AssertEquals('TestName'+inttostr(i),AFldName.AsString);
  974. ADataset.Next;
  975. end;
  976. ADataset.Next;
  977. AssertTrue(ADataset.EOF);
  978. end;
  979. procedure TTestFieldTypes.TestEmptyUpdateQuery;
  980. begin
  981. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
  982. end;
  983. procedure TTestFieldTypes.TestNonNullableParams;
  984. var ASQLQuery : TSQLQuery;
  985. Passed: Boolean;
  986. begin
  987. // Check for an exception when a null value is stored into a non-nullable
  988. // field using a parameter
  989. // There was a bug in IBConnection so that in this case the last used value
  990. // for the parameter was used.
  991. // To make sure that any changes are cancelled in the case the test fails
  992. TSQLDBConnector(DBConnector).GetNDataset(true,5);
  993. ASQLQuery := TSQLDBConnector(DBConnector).Query;
  994. ASQLQuery.SQL.text := 'update fpdev set ID=:ID1 where id = :ID2';
  995. ASQLQuery.Params[0].Clear;
  996. ASQLQuery.Params[1].AsInteger := 1;
  997. AssertTrue(ASQLQuery.Params[0].IsNull);
  998. Passed:=False;
  999. try
  1000. @ASQLQuery.ExecSQL;
  1001. except
  1002. on E: Exception do
  1003. if E.ClassType.InheritsFrom(EDatabaseError) then
  1004. Passed := true;
  1005. end;
  1006. AssertTrue(Passed);
  1007. end;
  1008. procedure TTestFieldTypes.TestStringLargerThen8192;
  1009. // See also: TestInsertLargeStrFields
  1010. var
  1011. s : string;
  1012. i : integer;
  1013. begin
  1014. CreateTableWithFieldType(ftString,'VARCHAR(9000)');
  1015. TestFieldDeclaration(ftString,9001);
  1016. setlength(s,9000);
  1017. for i := 1 to 9000 do
  1018. s[i]:=chr((i mod 10)+ord('a'));
  1019. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + s + ''')');
  1020. with TSQLDBConnector(DBConnector).Query do
  1021. begin
  1022. Open;
  1023. AssertEquals(s,fields[0].AsString);
  1024. close;
  1025. end;
  1026. end;
  1027. procedure TTestFieldTypes.TestTableNames;
  1028. var TableList : TStringList;
  1029. i : integer;
  1030. begin
  1031. TableList := TStringList.Create;
  1032. try
  1033. TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
  1034. AssertTrue(TableList.Find('fpdev',i));
  1035. finally
  1036. TableList.Free;
  1037. end;
  1038. end;
  1039. procedure TTestFieldTypes.TestFieldNames;
  1040. var FieldList : TStringList;
  1041. i : integer;
  1042. begin
  1043. FieldList := TStringList.Create;
  1044. try
  1045. TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
  1046. AssertTrue(FieldList.Find('id',i));
  1047. finally
  1048. FieldList.Free;
  1049. end;
  1050. end;
  1051. procedure TTestFieldTypes.TestInsertReturningQuery;
  1052. begin
  1053. if not(SQLServerType in [ssFirebird, ssOracle, ssPostgreSQL]) then Ignore(STestNotApplicable);
  1054. with TSQLDBConnector(DBConnector) do
  1055. begin
  1056. // This only works with databases that supports 'insert into .. returning'
  1057. // for example: PostgreSQL, Oracle, Firebird version 2.0 and up
  1058. CreateTableWithFieldType(ftInteger,'int');
  1059. Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
  1060. Query.Open;
  1061. AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
  1062. AssertEquals(154,Query.fields[0].AsInteger);
  1063. Query.Close;
  1064. end;
  1065. end;
  1066. procedure TTestFieldTypes.TestOpenStoredProc;
  1067. begin
  1068. with TSQLDBConnector(DBConnector) do
  1069. begin
  1070. case SQLServerType of
  1071. ssMySQL:
  1072. begin
  1073. Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
  1074. Query.SQL.Text:='call FPDEV_PROC';
  1075. end;
  1076. ssFirebird, ssInterbase:
  1077. begin
  1078. Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
  1079. Query.SQL.Text:='execute procedure FPDEV_PROC';
  1080. end;
  1081. ssMSSQL, ssSybase:
  1082. begin
  1083. Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
  1084. Query.SQL.Text:='execute FPDEV_PROC';
  1085. end;
  1086. else
  1087. begin
  1088. Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
  1089. Exit;
  1090. end;
  1091. end;
  1092. Transaction.CommitRetaining;
  1093. try
  1094. Query.Open;
  1095. AssertEquals(1, Query.Fields[0].AsInteger);
  1096. Query.Next;
  1097. if not(SQLServerType in [ssFirebird, ssInterbase]) then
  1098. begin
  1099. AssertFalse('Eof after 1st row', Query.Eof);
  1100. AssertEquals(2, Query.Fields[0].AsInteger);
  1101. Query.Next;
  1102. end;
  1103. AssertTrue('No Eof after last row', Query.Eof);
  1104. Query.Close;
  1105. finally
  1106. Connection.ExecuteDirect('drop procedure FPDEV_PROC');
  1107. Transaction.CommitRetaining;
  1108. end;
  1109. end;
  1110. end;
  1111. procedure TTestFieldTypes.TestOpenSpecialStatements;
  1112. const CTE_SELECT = 'WITH a AS (SELECT * FROM FPDEV) SELECT * FROM a';
  1113. type TTestStatements = array of string;
  1114. var statements: TTestStatements;
  1115. s: string;
  1116. begin
  1117. // tests non-select statements (other than "SELECT ..."), which return result-set
  1118. // at least one row must be returned
  1119. with TSQLDBConnector(DBConnector) do
  1120. begin
  1121. case SQLServerType of
  1122. ssSQLite:
  1123. statements := TTestStatements.Create('pragma table_info(FPDEV)');
  1124. ssFirebird:
  1125. statements := TTestStatements.Create(
  1126. CTE_SELECT (*FB 2.1*),
  1127. 'EXECUTE BLOCK RETURNS (U VARCHAR(255)) AS BEGIN SELECT rdb$get_context(''SYSTEM'',''CURRENT_USER'') FROM rdb$database INTO U; SUSPEND; END' (*FB 2.0*)
  1128. );
  1129. ssPostgreSQL:
  1130. statements := TTestStatements.Create(CTE_SELECT, 'EXPLAIN '+CTE_SELECT);
  1131. ssMSSQL:
  1132. statements := TTestStatements.Create(CTE_SELECT (*MS SQL 2005*));
  1133. ssMySQL:
  1134. statements := TTestStatements.Create(
  1135. 'check table FPDEV', // bug 14519
  1136. 'show tables from '+Connection.DatabaseName // bug 16842
  1137. )
  1138. else
  1139. Ignore(STestNotApplicable);
  1140. end;
  1141. for s in statements do
  1142. begin
  1143. Query.SQL.Text := s;
  1144. Query.Open;
  1145. AssertTrue(Query.FieldCount>0);
  1146. AssertFalse('Eof after open', Query.Eof);
  1147. Query.Next;
  1148. Query.Close;
  1149. end;
  1150. end;
  1151. end;
  1152. procedure TTestFieldTypes.TestClearUpdateableStatus;
  1153. // Test if CanModify is correctly disabled in case of a select query without
  1154. // a from-statement.
  1155. begin
  1156. if not (SQLServerType in [ssMySQL]) then Ignore('This test does only apply to MySQL because the used SQL-statement is MySQL only.');
  1157. with TSQLDBConnector(DBConnector) do
  1158. begin
  1159. with (GetNDataset(false,5) as TSQLQuery) do
  1160. begin
  1161. Open;
  1162. AssertEquals(True,CanModify);
  1163. Close;
  1164. SQL.Text:='select last_insert_id();';
  1165. Open;
  1166. AssertEquals(False,CanModify);
  1167. close;
  1168. end;
  1169. end;
  1170. end;
  1171. procedure TTestFieldTypes.TestReadOnlyParseSQL;
  1172. begin
  1173. with TSQLDBConnector(DBConnector) do
  1174. begin
  1175. GetFieldDataset(True);
  1176. with query do
  1177. begin
  1178. AssertFalse(ReadOnly);
  1179. AssertTrue(ParseSQL);
  1180. // If ParseSQL is false, and no update-queries are given, the query
  1181. // shouldn't be updateable after open.
  1182. ParseSQL := False;
  1183. AssertFalse(ParseSQL);
  1184. AssertFalse(ReadOnly);
  1185. SQL.Text := 'select * from FPDEV;';
  1186. open;
  1187. AssertFalse(ParseSQL);
  1188. AssertFalse(ReadOnly);
  1189. AssertFalse(CanModify);
  1190. close;
  1191. // If ParseSQL is true, the query should be updateable after open.
  1192. ReadOnly := False;
  1193. ParseSQL := True;
  1194. AssertTrue(ParseSQL);
  1195. AssertFalse(ReadOnly);
  1196. SQL.Text := 'select * from FPDEV';
  1197. open;
  1198. AssertTrue(ParseSQL);
  1199. AssertFalse(ReadOnly);
  1200. AssertTrue(CanModify);
  1201. edit;
  1202. FieldByName('ID').AsInteger:=321;
  1203. post;
  1204. Applyupdates;
  1205. close;
  1206. // If ParseSQL is true, but the supplied query isn't updateable, then
  1207. // the query shouldn't be updateable after open.
  1208. ReadOnly := False;
  1209. SQL.Text:='select ID,NAME from FPDEV where ID<5';
  1210. sql.Add('union');
  1211. sql.Add('select ID,NAME from FPDEV where ID>5');
  1212. AssertTrue(ParseSQL);
  1213. AssertFalse(ReadOnly);
  1214. open;
  1215. AssertTrue(ParseSQL);
  1216. AssertFalse(ReadOnly);
  1217. AssertFalse(CanModify);
  1218. close;
  1219. // As above, but now with an update-query, so that the query should
  1220. // be updateable again.
  1221. ReadOnly := False;
  1222. AssertTrue(ParseSQL);
  1223. AssertFalse(ReadOnly);
  1224. UpdateSQL.Text:='update FPDEV set ID=:ID where ID=:OLD_ID';
  1225. open;
  1226. AssertTrue(ParseSQL);
  1227. AssertFalse(ReadOnly);
  1228. AssertTrue(CanModify);
  1229. edit;
  1230. post;
  1231. Applyupdates;
  1232. close;
  1233. // Also if ParseSQL is False, the query should be updateable if a update-
  1234. // query is given.
  1235. ReadOnly := False;
  1236. ParseSQL := False;
  1237. AssertFalse(ParseSQL);
  1238. AssertFalse(ReadOnly);
  1239. open;
  1240. AssertFalse(ParseSQL);
  1241. AssertFalse(ReadOnly);
  1242. AssertTrue(CanModify);
  1243. edit;
  1244. FieldByName('ID').AsInteger:=1;
  1245. post;
  1246. Applyupdates;
  1247. close;
  1248. // But if ReadOnly is true, then CanModify should always be false
  1249. ReadOnly := True;
  1250. ParseSQL := False;
  1251. AssertFalse(ParseSQL);
  1252. AssertTrue(ReadOnly);
  1253. open;
  1254. AssertFalse(ParseSQL);
  1255. AssertTrue(ReadOnly);
  1256. AssertFalse(CanModify);
  1257. close;
  1258. end;
  1259. end;
  1260. end;
  1261. procedure TTestFieldTypes.TestParseJoins;
  1262. begin
  1263. with TSQLDBConnector(DBConnector) do
  1264. begin
  1265. with query do
  1266. begin
  1267. SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
  1268. Open;
  1269. AssertFalse(CanModify);
  1270. Close;
  1271. SQL.Text:='select T1.NAME from FPDEV T1,FPDEV T2 where T1.ID=T2.ID';
  1272. Open;
  1273. AssertFalse(CanModify);
  1274. Close;
  1275. end;
  1276. end;
  1277. end;
  1278. procedure TTestFieldTypes.TestDoubleFieldNames;
  1279. begin
  1280. with TSQLDBConnector(DBConnector) do
  1281. begin
  1282. with query do
  1283. begin
  1284. SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
  1285. Open;
  1286. AssertTrue(assigned(FindField('ID')));
  1287. AssertTrue (assigned(FindField('ID_1')));
  1288. AssertTrue(assigned(FindField('NAME')));
  1289. AssertTrue(assigned(FindField('NAME_1')));
  1290. AssertEquals(1,fieldbyname('ID').AsInteger);
  1291. AssertEquals(1,fieldbyname('ID_1').AsInteger);
  1292. AssertEquals('TestName1',fieldbyname('NAME').AsString);
  1293. AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
  1294. close;
  1295. end;
  1296. end;
  1297. end;
  1298. procedure TTestFieldTypes.TestParseUnion;
  1299. begin
  1300. with TSQLDBConnector(DBConnector) do
  1301. begin
  1302. with query do
  1303. begin
  1304. SQL.Text:='select NAME from FPDEV where ID<5';
  1305. sql.Add('union');
  1306. sql.Add('select NAME from FPDEV where ID>5');
  1307. Open;
  1308. close;
  1309. end;
  1310. end;
  1311. end;
  1312. procedure TTestFieldTypes.TestInsertLargeStrFields;
  1313. // See also: TestStringLargerThen8192
  1314. const
  1315. FieldValue1='test1';
  1316. var
  1317. FieldValue2: string;
  1318. begin
  1319. FieldValue2:=StringOfChar('t', 16000);
  1320. with TSQLDBConnector(DBConnector) do
  1321. begin
  1322. Connection.ExecuteDirect('create table FPDEV2 ( ' +
  1323. ' ID INT NOT NULL , ' +
  1324. ' NAME VARCHAR(16000),' +
  1325. ' PRIMARY KEY (ID) ' +
  1326. ') ');
  1327. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1328. TSQLDBConnector(DBConnector).CommitDDL;
  1329. query.sql.Text:='select * from FPDEV2';
  1330. Query.Open;
  1331. Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize)
  1332. Query.InsertRecord([2,FieldValue2]); // string length > 8192 (dsMaxStringSize)
  1333. Query.ApplyUpdates;
  1334. Query.Close;
  1335. Query.Open;
  1336. AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString);
  1337. Query.Next;
  1338. AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString));
  1339. AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString);
  1340. Query.Close;
  1341. end;
  1342. end;
  1343. procedure TTestFieldTypes.TestNumericNames;
  1344. begin
  1345. with TSQLDBConnector(DBConnector) do
  1346. begin
  1347. Connection.ExecuteDirect('create table FPDEV2 (' +
  1348. ' '+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[1]+' INT NOT NULL,' +
  1349. ' '+connection.FieldNameQuoteChars[0]+'3TEST'+connection.FieldNameQuoteChars[1]+' VARCHAR(10),' +
  1350. ' PRIMARY KEY ('+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[0]+') ' +
  1351. ') ');
  1352. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1353. TSQLDBConnector(DBConnector).CommitDDL;
  1354. with query do
  1355. begin
  1356. SQL.Text:='select * from FPDEV2';
  1357. Open;
  1358. Edit;
  1359. fieldbyname('2ID').AsInteger:=1;
  1360. fieldbyname('3TEST').AsString:='3test';
  1361. Post;
  1362. ApplyUpdates(0);
  1363. close;
  1364. open;
  1365. AssertEquals('3test',FieldByName('3TEST').AsString);
  1366. Edit;
  1367. fieldbyname('3TEST').AsString:='test3';
  1368. Post;
  1369. ApplyUpdates(0);
  1370. open;
  1371. AssertEquals('test3',FieldByName('3TEST').AsString);
  1372. close;
  1373. end;
  1374. end;
  1375. end;
  1376. procedure TTestFieldTypes.TestApplyUpdFieldnames;
  1377. begin
  1378. with TSQLDBConnector(DBConnector) do
  1379. begin
  1380. AssertEquals(-1,query.RowsAffected);
  1381. Connection.ExecuteDirect('create table FPDEV2 (' +
  1382. ' ID INT NOT NULL, ' +
  1383. ' '+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+' VARCHAR(250), ' +
  1384. ' PRIMARY KEY (ID) ' +
  1385. ') ');
  1386. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1387. TSQLDBConnector(DBConnector).CommitDDL;
  1388. Connection.ExecuteDirect('insert into FPDEV2(ID,'+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+') values (1,''test1'')');
  1389. Query.SQL.Text := 'select * from FPDEV2';
  1390. Query.Open;
  1391. AssertEquals(1,Query.FieldByName('ID').AsInteger);
  1392. AssertEquals('test1',Query.FieldByName('NAME-TEST').AsString);
  1393. Query.Edit;
  1394. Query.FieldByName('NAME-TEST').AsString:='Edited';
  1395. Query.Post;
  1396. Query.ApplyUpdates;
  1397. Query.Close;
  1398. Query.Open;
  1399. AssertEquals(1,Query.FieldByName('ID').AsInteger);
  1400. AssertEquals('Edited',Query.FieldByName('NAME-TEST').AsString);
  1401. Query.Close;
  1402. end;
  1403. end;
  1404. procedure TTestFieldTypes.TestServerFilter;
  1405. begin
  1406. // Tests SQLParser and ServerFilter
  1407. with TSQLDBConnector(DBConnector).Query do
  1408. begin
  1409. ServerFilter:='ID=21';
  1410. ServerFiltered:=true;
  1411. // tests parsing SELECT without WHERE
  1412. SQL.Text:='select * from FPDEV';
  1413. Open;
  1414. CheckTrue(CanModify, SQL.Text);
  1415. CheckEquals(1, RecordCount);
  1416. Close;
  1417. SQL.Text:='select *'#13'from FPDEV'#13'order by 1';
  1418. Open;
  1419. CheckTrue(CanModify, SQL.Text);
  1420. CheckEquals(1, RecordCount);
  1421. Close;
  1422. // tests parsing SELECT with simple WHERE
  1423. SQL.Text:='select *'#9'from FPDEV'#9'where NAME<>''''';
  1424. Open;
  1425. CheckTrue(CanModify, SQL.Text);
  1426. CheckEquals(1, RecordCount);
  1427. Close;
  1428. // tests parsing SELECT with simple WHERE followed by ORDER BY
  1429. SQL.Text:='select *'#10'from FPDEV'#10'where NAME>'''' order by 1';
  1430. Open;
  1431. CheckTrue(CanModify, SQL.Text);
  1432. CheckEquals(1, RecordCount);
  1433. Close;
  1434. // tests parsing of WHERE ... LIMIT
  1435. case SQLServerType of
  1436. ssFirebird, ssInterbase:
  1437. SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
  1438. ssMSSQL, ssSybase:
  1439. SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
  1440. else
  1441. SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
  1442. end;
  1443. Open;
  1444. CheckTrue(CanModify, SQL.Text);
  1445. Close;
  1446. // tests parsing SELECT with table alias and embedded comments (MySQL requires space after -- )
  1447. SQL.Text:='/**/select * from/**/FPDEV as fp-- comment'#13'where(NAME>''TestName20'')/**/order by 1';
  1448. Open;
  1449. CheckTrue(CanModify, 'CanModify: '+SQL.Text);
  1450. CheckTrue(ServerIndexDefs.Count >= 1, 'ServerIndexDefs: '+SQL.Text); // is TableName extracted correctly? (MS SQL Server can automatically creates index)
  1451. Close;
  1452. // tests parsing SELECT with quoted identifiers (MySQL requires sql-mode=ANSI_QUOTES)
  1453. SQL.Text:='SELECT"ID"FROM"FPDEV"ORDER BY"ID"';
  1454. if SQLServerType in [ssPostgreSQL] then SQL.Text:=lowercase(SQL.Text); // The folding of unquoted names to lower case in PostgreSQL is incompatible with the SQL standard
  1455. Open;
  1456. CheckTrue(CanModify, SQL.Text);
  1457. Close;
  1458. end;
  1459. end;
  1460. procedure TTestFieldTypes.TestRowsAffected;
  1461. begin
  1462. with TSQLDBConnector(DBConnector) do
  1463. begin
  1464. AssertEquals(-1,query.RowsAffected);
  1465. Connection.ExecuteDirect('create table FPDEV2 (' +
  1466. ' ID INT NOT NULL, ' +
  1467. ' NAME VARCHAR(250),' +
  1468. ' PRIMARY KEY (ID) ' +
  1469. ') ');
  1470. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1471. TSQLDBConnector(DBConnector).CommitDDL;
  1472. Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
  1473. Query.ExecSQL;
  1474. AssertEquals(1,query.RowsAffected);
  1475. Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (2,''test2'')';
  1476. Query.ExecSQL;
  1477. AssertEquals(1,query.RowsAffected);
  1478. Query.SQL.Text := 'update FPDEV2 set NAME=''NewTest''';
  1479. Query.ExecSQL;
  1480. AssertEquals(2,query.RowsAffected);
  1481. Query.SQL.Text := 'select * from FPDEV2';
  1482. Query.Open;
  1483. AssertTrue(query.RowsAffected<>0); // It should return -1 or the number of selected rows.
  1484. query.Close;
  1485. AssertTrue(query.RowsAffected<>0); // It should return -1 or the same as the last time it was called.
  1486. if (SQLConnType = sqlite3) then // sqlite doesn't count the rowsaffected if there is no where-clause
  1487. Query.SQL.Text := 'delete from FPDEV2 where 1'
  1488. else
  1489. Query.SQL.Text := 'delete from FPDEV2';
  1490. Query.ExecSQL;
  1491. AssertEquals(2,query.RowsAffected);
  1492. Query.SQL.Text := 'delete from FPDEV2';
  1493. Query.ExecSQL;
  1494. AssertEquals(0,query.RowsAffected);
  1495. end;
  1496. end;
  1497. procedure TTestFieldTypes.TestStringsReplace;
  1498. begin
  1499. AssertEquals('dit is een string',StringsReplace('dit was een string',['was'],['is'],[]));
  1500. AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['was'],['is'],[]));
  1501. AssertEquals('dit is een string is een string',StringsReplace('dit was een string was een string',['was'],['is'],[rfReplaceAll]));
  1502. AssertEquals('dit is een char is een char',StringsReplace('dit was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1503. AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['string','was'],['char','is'],[]));
  1504. AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll]));
  1505. AssertEquals('dit Was een char is een char',StringsReplace('dit Was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1506. AssertEquals('dit wAs een char is een char',StringsReplace('dit wAs een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1507. AssertEquals('dit is een char is een char',StringsReplace('dit Was een sTring was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
  1508. AssertEquals('dit is een char is een char',StringsReplace('dit wAs een STRING was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
  1509. AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['straat','string'],['sa','si'],[rfReplaceAll]));
  1510. AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['string','straat'],['si','sa'],[rfReplaceAll]));
  1511. AssertEquals('dit was een sing was een saat',StringsReplace('dit was een string was een straat',['str','string'],['s','si'],[rfReplaceAll]));
  1512. AssertEquals('dit was een si was een saat',StringsReplace('dit was een string was een straat',['string','str'],['si','s'],[rfReplaceAll]));
  1513. AssertEquals('dit was een string was een string',StringsReplace('dit was een string was een string',[''],['is'],[rfReplaceAll]));
  1514. AssertEquals('dit een string een string',StringsReplace('dit was een string was een string',['was'],[''],[rfReplaceAll]));
  1515. end;
  1516. procedure TTestFieldTypes.TestCircularParams;
  1517. begin
  1518. with TSQLDBConnector(dbconnector) do
  1519. begin
  1520. Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int,vchar varchar(10))');
  1521. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1522. TSQLDBConnector(DBConnector).CommitDDL;
  1523. Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:vchar)';
  1524. query.params[0].asinteger := 1;
  1525. query.params[1].asinteger := 1;
  1526. query.params[2].asstring := '$1 :id2 $';
  1527. query.ExecSQL;
  1528. query.sql.text := 'select * from FPDEV2';
  1529. query.open;
  1530. AssertEquals(1,query.fields[0].asinteger);
  1531. AssertEquals(1,query.fields[1].asinteger);
  1532. AssertEquals('$1 :id2 $',query.fields[2].AsString);
  1533. query.close;
  1534. end;
  1535. end;
  1536. procedure TTestFieldTypes.Test11Params;
  1537. var i : integer;
  1538. begin
  1539. with TSQLDBConnector(dbconnector) do
  1540. begin
  1541. Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int, id3 int, id4 int,id5 int,id6 int,id7 int,id8 int, id9 int, id10 int, id11 int)');
  1542. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1543. TSQLDBConnector(DBConnector).CommitDDL;
  1544. Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:id3,:id4,:id5,:id6,:id7,:id8,:id9,:id10,:id11)';
  1545. for i := 0 to 10 do
  1546. query.params[i].asinteger := 1;
  1547. query.ExecSQL;
  1548. query.sql.text := 'select * from FPDEV2';
  1549. query.open;
  1550. for i := 0 to 10 do
  1551. AssertEquals(1,query.fields[i].asinteger);
  1552. query.close;
  1553. end;
  1554. end;
  1555. procedure TTestFieldTypes.TestBug9744;
  1556. var i : integer;
  1557. begin
  1558. // Tests rev.8703: "Fixed MySQL ftLargeInt support"; count() returns BIGINT values
  1559. with TSQLDBConnector(DBConnector) do
  1560. begin
  1561. try
  1562. Connection.ExecuteDirect('create table TTTOBJ ( ' +
  1563. ' ID INT NOT NULL, ' +
  1564. ' NAME VARCHAR(250), ' +
  1565. ' PRIMARY KEY (ID) ' +
  1566. ') ');
  1567. Connection.ExecuteDirect('create table TTTXY ( ' +
  1568. ' ID INT NOT NULL, ' +
  1569. ' NP INT NOT NULL, ' +
  1570. ' PRIMARY KEY (ID,NP)' +
  1571. ') ');
  1572. Transaction.CommitRetaining;
  1573. for i := 0 to 7 do
  1574. begin
  1575. connection.ExecuteDirect('insert into TTTOBJ(ID,NAME) values ('+inttostr(i)+',''A'+inttostr(i)+''')');
  1576. connection.ExecuteDirect('insert into TTTXY(ID,NP) values ('+inttostr(i)+',1)');
  1577. connection.ExecuteDirect('insert into TTTXY(ID,NP) values ('+inttostr(i)+',2)');
  1578. end;
  1579. Query.SQL.Text := 'select OBJ.ID, OBJ.NAME, count(XY.NP) as NPF from TTTOBJ OBJ, TTTXY XY where OBJ.ID=XY.ID group by OBJ.ID, OBJ.NAME';
  1580. query.Prepare;
  1581. query.open;
  1582. query.close;
  1583. finally
  1584. Connection.ExecuteDirect('drop table TTTXY');
  1585. Connection.ExecuteDirect('drop table TTTOBJ');
  1586. Transaction.CommitRetaining;
  1587. end
  1588. end;
  1589. end;
  1590. procedure TTestFieldTypes.TestGetFieldNames;
  1591. var FieldNames : TStringList;
  1592. begin
  1593. with TSQLDBConnector(DBConnector) do
  1594. begin
  1595. FieldNames := TStringList.Create;
  1596. try
  1597. if SQLConnType in MySQLConnTypes then
  1598. Connection.GetFieldNames('FPDEV',FieldNames)
  1599. else
  1600. Connection.GetFieldNames('fpDEv',FieldNames);
  1601. AssertEquals(2,FieldNames.Count);
  1602. AssertEquals('ID',UpperCase(FieldNames[0]));
  1603. AssertEquals('NAME',UpperCase(FieldNames[1]));
  1604. finally
  1605. FieldNames.Free;
  1606. end;
  1607. end;
  1608. end;
  1609. procedure TTestFieldTypes.TestGetTables;
  1610. var TableNames : TStringList;
  1611. begin
  1612. with TSQLDBConnector(DBConnector) do
  1613. begin
  1614. TableNames := TStringList.Create;
  1615. try
  1616. Connection.GetTableNames(TableNames);
  1617. AssertTrue(TableNames.Count>0);
  1618. AssertTrue(TableNames.IndexOf('FPDEV')>-1);
  1619. AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
  1620. finally
  1621. TableNames.Free;
  1622. end;
  1623. end;
  1624. end;
  1625. procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
  1626. var
  1627. i : byte;
  1628. s: string;
  1629. begin
  1630. CreateTableWithFieldType(ADatatype,ASQLTypeDecl);
  1631. TestFieldDeclaration(ADatatype,ADataSize);
  1632. for i := 0 to testValuesCount-1 do
  1633. begin
  1634. s := AGetSQLTextProc(i);
  1635. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + s + ')');
  1636. end;
  1637. with TSQLDBConnector(DBConnector).Query do
  1638. begin
  1639. Open;
  1640. for i := 0 to testValuesCount-1 do
  1641. begin
  1642. ACheckFieldValueProc(fields[0],i);
  1643. Next;
  1644. end;
  1645. close;
  1646. end;
  1647. end;
  1648. // Placed here, as long as bug 18702 is not solved
  1649. function TestSQLClob_GetSQLText(const a: integer) : string;
  1650. begin
  1651. result := QuotedStr(testStringValues[a]);
  1652. end;
  1653. procedure TTestFieldTypes.TestSQLClob;
  1654. procedure CheckFieldValue(AField:TField; a : integer);
  1655. begin
  1656. AssertEquals(testStringValues[a],AField.AsString);
  1657. end;
  1658. var datatype: string;
  1659. begin
  1660. if SQLConnType=sqlite3 then
  1661. datatype:='CLOB'
  1662. else
  1663. datatype:=FieldtypeDefinitions[ftMemo];
  1664. TestSQLFieldType(ftMemo, datatype, 0, @TestSQLClob_GetSQLText, @CheckFieldValue);
  1665. end;
  1666. // Placed here, as long as bug 18702 is not solved
  1667. function TestSQLLargeInt_GetSQLText(const a: integer) : string;
  1668. begin
  1669. result := IntToStr(testLargeIntValues[a]);
  1670. end;
  1671. procedure TTestFieldTypes.TestSQLLargeint;
  1672. procedure CheckFieldValue(AField:TField; a : integer);
  1673. begin
  1674. AssertEquals(testLargeIntValues[a],AField.AsLargeInt);
  1675. end;
  1676. var datatype: string;
  1677. begin
  1678. if SQLConnType=sqlite3 then
  1679. datatype:='LARGEINT'
  1680. else
  1681. datatype:='BIGINT';
  1682. TestSQLFieldType(ftLargeint, datatype, 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
  1683. end;
  1684. var testIntervalValuesCount: integer;
  1685. const testIntervalValues: array[0..5] of shortstring = ('00:00:00.000','00:00:01.000','23:59:59.000','99:59:59.000','838:59:59.000','1000:00:00.000');
  1686. // Placed here, as long as bug 18702 is not solved
  1687. function TestSQLInterval_GetSQLText(const a: integer) : string;
  1688. begin
  1689. if a < testIntervalValuesCount then
  1690. Result := QuotedStr(testIntervalValues[a])
  1691. else
  1692. Result := 'NULL'
  1693. end;
  1694. procedure TTestFieldTypes.TestSQLInterval;
  1695. procedure CheckFieldValue(AField: TField; a: integer);
  1696. begin
  1697. if a < testIntervalValuesCount then
  1698. AssertEquals(testIntervalValues[a], DateTimeToTimeString(AField.AsDateTime))
  1699. else
  1700. AssertTrue(AField.IsNull);
  1701. end;
  1702. var datatype: string;
  1703. begin
  1704. if SQLConnType = postgresql then
  1705. begin
  1706. datatype:='INTERVAL';
  1707. testIntervalValuesCount := 6;
  1708. end
  1709. else
  1710. begin
  1711. datatype:=FieldtypeDefinitions[ftTime];
  1712. if datatype = '' then
  1713. Ignore(STestNotApplicable);
  1714. if SQLServerType = ssSQLite then
  1715. testIntervalValuesCount := 6
  1716. else if SQLServerType = ssMySQL then
  1717. // MySQL ODBC driver does not correctly handles time values >= '100:00:00'
  1718. testIntervalValuesCount := 5
  1719. else
  1720. testIntervalValuesCount := 3;
  1721. end;
  1722. TestSQLFieldType(ftTime, datatype, sizeof(TDateTime), @TestSQLInterval_GetSQLText, @CheckFieldValue);
  1723. end;
  1724. procedure TTestFieldTypes.TestSQLIdentity;
  1725. var datatype, values: string;
  1726. fieldtype: TFieldType;
  1727. i: integer;
  1728. updatable: boolean;
  1729. begin
  1730. case SQLServerType of
  1731. ssMySQL:
  1732. begin
  1733. datatype:='INT AUTO_INCREMENT PRIMARY KEY';
  1734. values:='VALUES(DEFAULT)';
  1735. fieldtype:=ftAutoInc;
  1736. updatable:=true;
  1737. end;
  1738. ssSQLite:
  1739. begin
  1740. datatype:='INTEGER PRIMARY KEY';
  1741. values:='DEFAULT VALUES';
  1742. fieldtype:=ftInteger;
  1743. updatable:=true;
  1744. end;
  1745. ssPostgreSQL:
  1746. begin
  1747. datatype:='SERIAL';
  1748. values:='DEFAULT VALUES';
  1749. if SQLConnType = ODBC then
  1750. fieldtype:=ftAutoInc
  1751. else
  1752. fieldtype:=ftInteger;
  1753. updatable:=true;
  1754. end;
  1755. ssMSSQL, ssSybase:
  1756. begin
  1757. datatype:='INTEGER IDENTITY';
  1758. values:='DEFAULT VALUES';
  1759. fieldtype:=ftAutoInc;
  1760. updatable:=false;
  1761. end
  1762. else
  1763. Ignore(STestNotApplicable);
  1764. end;
  1765. CreateTableWithFieldType(fieldtype, datatype);
  1766. TestFieldDeclaration(fieldtype, sizeof(longint));
  1767. for i := 1 to 3 do
  1768. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 '+values);
  1769. with TSQLDBConnector(DBConnector).Query do
  1770. begin
  1771. Open;
  1772. AssertTrue(Locate('FT',1,[])); // bug 17624
  1773. for i := 1 to 3 do
  1774. begin
  1775. AssertEquals(i, Fields[0].AsInteger);
  1776. Next;
  1777. end;
  1778. // some databases (like MS SQL Server) do not allow updating identity columns
  1779. AssertEquals('ReadOnly', Fields[0].ReadOnly, not updatable);
  1780. // some databases (like PostgreSQL, MySQL) allow inserting explicit values and updating auto incrementing columns
  1781. if updatable then
  1782. begin
  1783. UpdateMode:=upWhereAll; // if there is no PK for FPDEV2 table
  1784. // updating:
  1785. Last;
  1786. while not Bof do
  1787. begin
  1788. Edit;
  1789. Fields[0].AsInteger:=Fields[0].AsInteger+2;
  1790. Post;
  1791. Prior;
  1792. end;
  1793. // inserting:
  1794. Append;
  1795. Fields[0].AsInteger:=6;
  1796. Post;
  1797. ApplyUpdates;
  1798. end;
  1799. Close;
  1800. end;
  1801. end;
  1802. function TestSQLReal_GetSQLText(const i: integer) : string;
  1803. begin
  1804. if i < 20 then // first 20 values fit into MySQL FLOAT data type
  1805. Result := FloatToStr(testFloatValues[i], DBConnector.FormatSettings)
  1806. else
  1807. Result := 'NULL';
  1808. end;
  1809. procedure TTestFieldTypes.TestSQLReal;
  1810. procedure CheckFieldValue(AField:TField; i: integer);
  1811. begin
  1812. if i < 20 then
  1813. AssertEquals(testFloatValues[i], AField.AsFloat)
  1814. else
  1815. AssertTrue(AField.IsNull);
  1816. end;
  1817. var datatype: string;
  1818. begin
  1819. case SQLServerType of
  1820. ssFirebird, ssInterbase,
  1821. ssMySQL:
  1822. datatype:='FLOAT';
  1823. else
  1824. datatype:='REAL';
  1825. end;
  1826. TestSQLFieldType(ftFloat, datatype, sizeof(double), @TestSQLReal_GetSQLText, @CheckFieldValue);
  1827. end;
  1828. procedure TTestFieldTypes.TestUpdateIndexDefs;
  1829. var ds : TSQLQuery;
  1830. begin
  1831. // Firebird/Interbase ODBC driver returns for :
  1832. // SQLPrimaryKeys (PK_NAME): RDB$RELATION_CONSTRAINTS(RDB$CONSTRAINT_NAME)
  1833. // SQLStatistics (INDEX_NAME): RDB$INDICES(RDB$INDEX_NAME)
  1834. // these two names can differ (when PRIMARY KEY is created without giving constraint name),
  1835. // therefore two indexes may be created instead of one (see TODBCConnection.UpdateIndexDefs)
  1836. ds := DBConnector.GetNDataset(1) as TSQLQuery;
  1837. ds.Prepare;
  1838. ds.ServerIndexDefs.Update;
  1839. AssertEquals(1,ds.ServerIndexDefs.count);
  1840. AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
  1841. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1842. ds.ServerIndexDefs.Update;
  1843. AssertEquals(1,ds.ServerIndexDefs.count);
  1844. AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
  1845. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1846. end;
  1847. procedure TTestFieldTypes.TestMultipleFieldPKIndexDefs;
  1848. var ds : TSQLQuery;
  1849. begin
  1850. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (' +
  1851. ' ID1 INT NOT NULL, ' +
  1852. ' ID2 INT NOT NULL, ' +
  1853. ' NAME VARCHAR(50), ' +
  1854. ' PRIMARY KEY (ID1, ID2)' +
  1855. ') ');
  1856. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1857. TSQLDBConnector(DBConnector).CommitDDL;
  1858. ds := TSQLDBConnector(DBConnector).Query;
  1859. ds.sql.Text:='select * from FPDEV2';
  1860. ds.Prepare;
  1861. ds.ServerIndexDefs.Update;
  1862. AssertEquals(1,ds.ServerIndexDefs.count);
  1863. AssertTrue(SameText('ID1;ID2',ds.ServerIndexDefs[0].Fields));
  1864. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1865. end;
  1866. procedure TTestFieldTypes.TestGetIndexDefs;
  1867. var ds : TSQLQuery;
  1868. inddefs : TIndexDefs;
  1869. begin
  1870. ds := DBConnector.GetNDataset(1) as TSQLQuery;
  1871. ds.Open;
  1872. AssertEquals('ServerIndexDefs.Count', 1, ds.ServerIndexDefs.Count);
  1873. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary]);
  1874. AssertEquals('ixPrimary', 1, inddefs.count);
  1875. AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
  1876. AssertTrue(inddefs[0].Options=[ixPrimary,ixUnique]);
  1877. inddefs.Free;
  1878. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary,ixUnique]);
  1879. AssertEquals('ixPrimary,ixUnique', 1, inddefs.count);
  1880. AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
  1881. AssertTrue(inddefs[0].Options=[ixPrimary,ixUnique]);
  1882. inddefs.Free;
  1883. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixDescending]);
  1884. AssertEquals('ixDescending', 0, inddefs.count);
  1885. inddefs.Free;
  1886. end;
  1887. procedure TTestFieldTypes.TestTemporaryTable;
  1888. begin
  1889. // Tests rev.6481: "Do not use a new connection for every statement that is executed";
  1890. if SQLServerType in [ssMSSQL, ssSybase] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t support temporary tables');
  1891. with TSQLDBConnector(DBConnector).Query do
  1892. begin
  1893. SQL.Clear;
  1894. if SQLServerType in [ssFirebird, ssInterbase] then
  1895. // Global temporary table: introduced in Firebird 2.1
  1896. // has persistent metadata; data is per transaction (default) or per connection
  1897. SQL.Add('CREATE GLOBAL TEMPORARY TABLE FPDEV_TEMP (id int)')
  1898. else
  1899. SQL.Add('CREATE TEMPORARY TABLE FPDEV_TEMP (id int)');
  1900. ExecSQL;
  1901. try
  1902. // Firebird/Interbase needs a commit after DDL:
  1903. TSQLDBConnector(DBConnector).CommitDDL;
  1904. SQL.Text := 'INSERT INTO FPDEV_TEMP(id) values (5)';
  1905. ExecSQL;
  1906. SQL.Text := 'SELECT * FROM FPDEV_TEMP';
  1907. Open;
  1908. AssertEquals(5, Fields[0].AsInteger);
  1909. Close;
  1910. finally
  1911. // For Firebird/Interbase, we need to explicitly delete the table as well (it's active within the transaction)
  1912. if SQLServerType in [ssFirebird, ssInterbase] then
  1913. begin
  1914. SQL.Text := 'DROP TABLE FPDEV_TEMP';
  1915. ExecSQL;
  1916. TSQLDBConnector(DBConnector).CommitDDL;
  1917. end;
  1918. end;
  1919. end;
  1920. end;
  1921. procedure TTestFieldTypes.TestDblQuoteEscComments;
  1922. begin
  1923. with TSQLDBConnector(DBConnector).Query do
  1924. begin
  1925. SQL.Clear;
  1926. SQL.Add('select * from FPDEV where name=''test '''' and :ThisIsNotAParameter ''');
  1927. open;
  1928. close;
  1929. end;
  1930. end;
  1931. procedure TTestFieldTypes.TestParametersAndDates;
  1932. // See bug 7205
  1933. var ADateStr : String;
  1934. begin
  1935. if not(SQLServerType in [ssPostgreSQL, ssOracle]) then
  1936. Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
  1937. with TSQLDBConnector(DBConnector).Query do
  1938. begin
  1939. SQL.Clear;
  1940. sql.add('select now()::date as current_date where 1=1');
  1941. open;
  1942. first;
  1943. ADateStr:=fields[0].asstring; // return the correct date
  1944. // writeln(fields[0].asstring);
  1945. close;
  1946. sql.clear;
  1947. sql.add('select now()::date as current_date where cast(1 as integer) = :PARAM1');
  1948. params.parambyname('PARAM1').asinteger:= 1;
  1949. open;
  1950. first;
  1951. AssertEquals(ADateStr,fields[0].asstring); // return invalid date
  1952. // writeln(fields[0].asstring);
  1953. close;
  1954. end
  1955. end;
  1956. procedure TTestFieldTypes.TestExceptOnsecClose;
  1957. var passed : boolean;
  1958. begin
  1959. with TSQLDBConnector(DBConnector).Query do
  1960. begin
  1961. SQL.Clear;
  1962. SQL.Add('select * from FPDEV');
  1963. Open;
  1964. close;
  1965. SQL.Clear;
  1966. SQL.Add('select blaise from FPDEV');
  1967. passed := false;
  1968. try
  1969. open;
  1970. except
  1971. on E: Exception do
  1972. passed := (E.ClassType.InheritsFrom(EDatabaseError))
  1973. end;
  1974. AssertTrue(passed);
  1975. Close;
  1976. end;
  1977. end;
  1978. procedure TTestFieldTypes.TestErrorOnEmptyStatement;
  1979. var PassException : boolean;
  1980. begin
  1981. PassException:=False;
  1982. with TSQLDBConnector(DBConnector).Query do
  1983. begin
  1984. sql.Text := '';
  1985. try
  1986. Open;
  1987. except
  1988. on E:EDatabaseError do
  1989. if Pos(SErrNoStatement,E.Message) > 0 then
  1990. PassException := True;
  1991. end;
  1992. AssertTrue(PassException);
  1993. end;
  1994. end;
  1995. procedure TTestFieldTypes.SetUp;
  1996. begin
  1997. InitialiseDBConnector;
  1998. end;
  1999. procedure TTestFieldTypes.TearDown;
  2000. begin
  2001. if assigned(DBConnector) then
  2002. TSQLDBConnector(DBConnector).Transaction.Rollback;
  2003. FreeDBConnector;
  2004. end;
  2005. procedure TTestFieldTypes.RunTest;
  2006. begin
  2007. // if (SQLConnType in TSQLConnType) then
  2008. inherited RunTest;
  2009. end;
  2010. initialization
  2011. if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
  2012. end.