testfieldtypes.pas 60 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951
  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 TestLimitQuery; // 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 TestSetBlobAsMemoParam;
  48. procedure TestSetBlobAsBlobParam;
  49. procedure TestSetBlobAsStringParam;
  50. procedure TestNonNullableParams;
  51. procedure TestGetIndexDefs;
  52. procedure TestDblQuoteEscComments;
  53. procedure TestpfInUpdateFlag; // bug 7565
  54. procedure TestInt;
  55. procedure TestScript;
  56. procedure TestInsertReturningQuery;
  57. procedure TestOpenStoredProc;
  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 TestNumeric;
  69. procedure TestFloat;
  70. procedure TestDateTime; // bug 6925
  71. procedure TestString;
  72. procedure TestUnlVarChar;
  73. procedure TestDate;
  74. procedure TestNullValues;
  75. procedure TestParamQuery;
  76. procedure TestStringParamQuery;
  77. procedure TestFixedStringParamQuery;
  78. procedure TestDateParamQuery;
  79. procedure TestIntParamQuery;
  80. procedure TestTimeParamQuery;
  81. procedure TestDateTimeParamQuery;
  82. procedure TestFmtBCDParamQuery;
  83. procedure TestFloatParamQuery;
  84. procedure TestBCDParamQuery;
  85. procedure TestBytesParamQuery;
  86. procedure TestAggregates;
  87. procedure TestStringLargerThen8192;
  88. procedure TestQueryAfterReconnect; // bug 16438
  89. // SchemaType tests
  90. procedure TestTableNames;
  91. procedure TestFieldNames;
  92. procedure TestClearUpdateableStatus;
  93. procedure TestReadOnlyParseSQL; // bug 9254
  94. procedure TestGetTables;
  95. // Test SQL-field type recognition
  96. procedure TestSQLClob;
  97. procedure TestSQLLargeint;
  98. end;
  99. implementation
  100. uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
  101. Type HackedDataset = class(TDataset);
  102. const
  103. testFloatValuesCount = 21;
  104. 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);
  105. testBCDValuesCount = 10;
  106. testBCDValues : Array[0..testBCDValuesCount-1] of currency = (-100,54.53,1.2345,123.5345,0,1,-1,0,1.42,1324.4324);
  107. testIntValuesCount = 17;
  108. 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);
  109. testDateValuesCount = 18;
  110. testDateValues : Array[0..testDateValuesCount-1] of string = (
  111. '2000-01-01',
  112. '1999-12-31',
  113. '2004-02-29',
  114. '2004-03-01',
  115. '1991-02-28',
  116. '1991-03-01',
  117. '2040-10-16',
  118. '1977-09-29',
  119. '1800-03-30',
  120. '1650-05-10',
  121. '1754-06-04',
  122. '0904-04-12',
  123. '0199-07-09',
  124. '0001-01-01',
  125. '1899-12-29',
  126. '1899-12-30',
  127. '1899-12-31',
  128. '1900-01-01'
  129. );
  130. testBytesValuesCount = 5;
  131. testBytesValues : Array[0..testBytesValuesCount-1] of shortstring = (#1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10);
  132. procedure TTestFieldTypes.TestpfInUpdateFlag;
  133. var ds : TCustomBufDataset;
  134. AFld1, AFld2, AFld3 : Tfield;
  135. begin
  136. ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
  137. with ds do
  138. begin
  139. AFld1 := TIntegerField.Create(ds);
  140. AFld1.FieldName := 'ID';
  141. AFld1.DataSet := ds;
  142. AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
  143. AFld2 := TStringField.Create(ds);
  144. AFld2.FieldName := 'NAME';
  145. AFld2.DataSet := ds;
  146. AFld3 := TIntegerField.Create(ds);
  147. AFld3.FieldName := 'CALCFLD';
  148. AFld3.DataSet := ds;
  149. Afld3.FieldKind := fkCalculated;
  150. AFld3.ProviderFlags := [];
  151. Open;
  152. Edit;
  153. FieldByName('ID').AsInteger := 254;
  154. Post;
  155. ApplyUpdates;
  156. Append;
  157. FieldByName('ID').AsInteger := 255;
  158. Post;
  159. ApplyUpdates;
  160. Close;
  161. AFld1.Free;
  162. AFld2.Free;
  163. AFld3.Free;
  164. end;
  165. end;
  166. procedure TTestFieldTypes.TestScript;
  167. var Ascript : TSQLScript;
  168. begin
  169. Ascript := tsqlscript.create(nil);
  170. try
  171. with Ascript do
  172. begin
  173. DataBase := TSQLDBConnector(DBConnector).Connection;
  174. transaction := TSQLDBConnector(DBConnector).Transaction;
  175. script.clear;
  176. script.append('create table a (id int);');
  177. script.append('create table b (id int);');
  178. ExecuteScript;
  179. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  180. if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  181. end;
  182. finally
  183. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
  184. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
  185. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  186. if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  187. end;
  188. end;
  189. procedure TTestFieldTypes.TestInt;
  190. var
  191. i : byte;
  192. begin
  193. CreateTableWithFieldType(ftInteger,'INT');
  194. TestFieldDeclaration(ftInteger,4);
  195. for i := 0 to testIntValuesCount-1 do
  196. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
  197. with TSQLDBConnector(DBConnector).Query do
  198. begin
  199. Open;
  200. for i := 0 to testIntValuesCount-1 do
  201. begin
  202. AssertEquals(testIntValues[i],fields[0].AsInteger);
  203. Next;
  204. end;
  205. close;
  206. end;
  207. end;
  208. procedure TTestFieldTypes.TestLargeRecordSize;
  209. begin
  210. 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))');
  211. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  212. if UpperCase(dbconnectorparams)='INTERBASE' then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  213. with TSQLDBConnector(DBConnector).Query do
  214. begin
  215. sql.clear;
  216. 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..............'')');
  217. ExecSQL;
  218. sql.clear;
  219. sql.append('select * from FPDEV2');
  220. open;
  221. AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
  222. AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
  223. close;
  224. end;
  225. end;
  226. procedure TTestFieldTypes.TestNumeric;
  227. const
  228. testValuesCount = 13;
  229. testValues : Array[0..testValuesCount-1] of currency = (-123456.789,-10200,-10000,-1875.25,-10,-0.5,0,0.5,10,1875.25,10000,10200,123456.789);
  230. Sizes: array [0..4] of integer = (4,0,3,5,0); //scale
  231. var
  232. i : byte;
  233. s : string;
  234. begin
  235. with TSQLDBConnector(DBConnector) do begin
  236. if SQLDbType = INTERBASE then
  237. s := '' //Interbase supports precision up to 18 only
  238. else
  239. s := ', N4 NUMERIC(19,0)';
  240. Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N1 NUMERIC(18,0), N2 NUMERIC(18,3), N3 NUMERIC(18,5)' + s + ')');
  241. Transaction.CommitRetaining;
  242. with Query do
  243. begin
  244. SQL.Text := 'select * from FPDEV2';
  245. Open;
  246. AssertEquals(sizeof(Currency), Fields[0].DataSize);
  247. AssertTrue(Fields[0].DataType=ftBCD);
  248. AssertEquals(Sizes[0], Fields[0].Size);
  249. AssertTrue(Fields[1].DataType in [ftFmtBCD, ftLargeInt]);
  250. AssertEquals(Sizes[1], Fields[1].Size);
  251. for i := 2 to FieldCount-1 do
  252. begin
  253. AssertEquals(sizeof(TBCD), Fields[i].DataSize);
  254. AssertTrue(Fields[i].DataType=ftFmtBCD);
  255. AssertEquals(Sizes[i], Fields[i].Size);
  256. end;
  257. Close;
  258. end;
  259. for i := 0 to testValuesCount-1 do
  260. begin
  261. s :=CurrToStrF(testValues[i],ffFixed,3,DBConnector.FormatSettings);
  262. Connection.ExecuteDirect(format('insert into FPDEV2 (FT,N2,N3) values (%s,%s,%s)', [s,s,s]));
  263. end;
  264. with Query do
  265. begin
  266. Open;
  267. for i := 0 to testValuesCount-1 do
  268. begin
  269. AssertEquals(testValues[i], Fields[0].AsCurrency);
  270. AssertEquals(testValues[i], Fields[2].AsCurrency);
  271. AssertEquals(testValues[i], Fields[3].AsCurrency);
  272. Next;
  273. end;
  274. Close;
  275. end;
  276. end;
  277. end;
  278. procedure TTestFieldTypes.TestString;
  279. const
  280. testValuesCount = 19;
  281. testValues : Array[0..testValuesCount-1] of string = (
  282. '',
  283. 'a',
  284. 'ab',
  285. 'abc',
  286. 'abcd',
  287. 'abcde',
  288. 'abcdef',
  289. 'abcdefg',
  290. 'abcdefgh',
  291. 'abcdefghi',
  292. 'abcdefghij',
  293. 'lMnOpQrStU',
  294. '1234567890',
  295. '_!@#$%^&*(',
  296. ')-;:/?.<>',
  297. '~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
  298. ' WRaP ',
  299. 'wRaP ',
  300. ' wRAP'
  301. );
  302. var
  303. i : byte;
  304. begin
  305. CreateTableWithFieldType(ftString,'VARCHAR(10)');
  306. TestFieldDeclaration(ftString,11);
  307. for i := 0 to testValuesCount-1 do
  308. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  309. with TSQLDBConnector(DBConnector).Query do
  310. begin
  311. Open;
  312. for i := 0 to testValuesCount-1 do
  313. begin
  314. if (SQLDbType in [mysql40,mysql41]) then
  315. AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL < 5.0.3 automatically trims strings
  316. else
  317. AssertEquals(testValues[i],fields[0].AsString);
  318. Next;
  319. end;
  320. close;
  321. end;
  322. end;
  323. procedure TTestFieldTypes.TestUnlVarChar;
  324. const
  325. testValuesCount = 21;
  326. testValues : Array[0..testValuesCount-1] of string = (
  327. '',
  328. 'a',
  329. 'ab',
  330. 'abc',
  331. 'abcd',
  332. 'abcde',
  333. 'abcdef',
  334. 'abcdefg',
  335. 'abcdefgh',
  336. 'abcdefghi',
  337. 'abcdefghij',
  338. 'lMnOpQrStU',
  339. '1234567890',
  340. '_!@#$%^&*(',
  341. ')-;:/?.<>',
  342. '~`|{}- =',
  343. ' WRaP ',
  344. 'wRaP ',
  345. ' wRAP',
  346. '0123456789',
  347. 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
  348. + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
  349. );
  350. var
  351. i : byte;
  352. begin
  353. if SQLDbType<>postgresql then Ignore('This test does only apply to Postgres, since others don''t support varchars without length given');
  354. CreateTableWithFieldType(ftString,'VARCHAR');
  355. TestFieldDeclaration(ftString,dsMaxStringSize+1);
  356. for i := 0 to testValuesCount-1 do
  357. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  358. with TSQLDBConnector(DBConnector).Query do
  359. begin
  360. Open;
  361. for i := 0 to testValuesCount-1 do
  362. begin
  363. AssertEquals(testValues[i],fields[0].AsString);
  364. Next;
  365. end;
  366. close;
  367. end;
  368. end;
  369. procedure TTestFieldTypes.TestDate;
  370. var
  371. i : byte;
  372. begin
  373. CreateTableWithFieldType(ftDate,'DATE');
  374. TestFieldDeclaration(ftDate,8);
  375. for i := 0 to testDateValuesCount-1 do
  376. if SQLDbType=oracle then
  377. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testDateValues[i] + ''',''YYYY-MM-DD''))')
  378. else
  379. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testDateValues[i] + ''')');
  380. // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
  381. with TSQLDBConnector(DBConnector).Query do
  382. begin
  383. Open;
  384. for i := 0 to testDateValuesCount-1 do
  385. begin
  386. AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings));
  387. Next;
  388. end;
  389. close;
  390. end;
  391. end;
  392. procedure TTestFieldTypes.TestChangeBlob;
  393. var s : string;
  394. begin
  395. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
  396. TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For interbase
  397. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
  398. with TSQLDBConnector(DBConnector).Query do
  399. begin
  400. sql.clear;
  401. sql.add('select * from FPDEV2');
  402. Open;
  403. fields[1].ProviderFlags := [pfInUpdate]; // blob niet in de where
  404. UpdateMode := upWhereAll;
  405. AssertEquals('Test deze blob',fields[1].AsString);
  406. edit;
  407. // Dat werkt niet lekker, omdat de stream vernield wordt...
  408. // fields[0].asstring := 'Deze blob is gewijzigd!';
  409. With Createblobstream(fields[1],bmwrite) do
  410. begin
  411. s := 'Deze blob is gewijzigd!';
  412. WriteBuffer(Pointer(s)^,Length(s));
  413. post;
  414. free;
  415. end;
  416. AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
  417. ApplyUpdates(0);
  418. TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
  419. close;
  420. open;
  421. AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
  422. close;
  423. end;
  424. end;
  425. procedure TTestFieldTypes.TestBlobGetText;
  426. begin
  427. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  428. TestFieldDeclaration(ftBlob,0);
  429. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  430. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (Null)');
  431. // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
  432. with TSQLDBConnector(DBConnector).Query do
  433. begin
  434. Open;
  435. AssertFalse(fields[0].IsNull);
  436. AssertEquals('(BLOB)',fields[0].DisplayText);
  437. AssertEquals('Test deze blob',fields[0].AsString);
  438. Next;
  439. AssertTrue(fields[0].IsNull);
  440. AssertEquals('(blob)',fields[0].Text);
  441. AssertEquals('',fields[0].AsString);
  442. close;
  443. end;
  444. end;
  445. procedure TTestFieldTypes.TestBlobSize;
  446. begin
  447. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  448. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  449. with TSQLDBConnector(DBConnector).Query do
  450. begin
  451. sql.text := 'select * from FPDEV2';
  452. Open;
  453. AssertEquals(14,TBlobField(fields[0]).BlobSize);
  454. close;
  455. end;
  456. end;
  457. procedure TTestFieldTypes.TestSetBlobAsStringParam;
  458. begin
  459. TestSetBlobAsParam(1);
  460. end;
  461. procedure TTestFieldTypes.TestBlob;
  462. begin
  463. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  464. TestFieldDeclaration(ftBlob,0);
  465. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
  466. // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
  467. with TSQLDBConnector(DBConnector).Query do
  468. begin
  469. Open;
  470. AssertEquals('Test deze blob',fields[0].AsString);
  471. close;
  472. end;
  473. end;
  474. procedure TTestFieldTypes.TestDateTime;
  475. const
  476. testValuesCount = 31;
  477. testValues : Array[0..testValuesCount-1] of string = (
  478. '2000-01-01',
  479. '1999-12-31',
  480. '2004-02-29',
  481. '2004-03-01',
  482. '1991-02-28',
  483. '1991-03-01',
  484. '1977-09-29',
  485. '2000-01-01 10:00:00',
  486. '2000-01-01 23:59:59',
  487. '1994-03-06 11:54:30',
  488. '2040-10-16', // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
  489. '1400-02-03 12:21:53',
  490. '0354-11-20 21:25:15',
  491. '1333-02-03 21:44:21',
  492. '1800-03-30',
  493. '1650-05-10',
  494. '1754-06-04',
  495. '0904-04-12',
  496. '0199-07-09',
  497. '0001-01-01',
  498. '1899-12-29',
  499. '1899-12-30',
  500. '1899-12-31',
  501. '1900-01-01',
  502. '1899-12-30 18:00:51',
  503. '1899-12-30 04:00:51',
  504. '1899-12-29 04:00:51',
  505. '1899-12-29 18:00:51',
  506. '1903-04-02 01:04:02',
  507. '1815-09-24 03:47:22',
  508. '2100-01-01 01:01:01'
  509. );
  510. var
  511. i, corrTestValueCount : byte;
  512. begin
  513. CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
  514. TestFieldDeclaration(ftDateTime,8);
  515. if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
  516. else corrTestValueCount := testValuesCount;
  517. for i := 0 to corrTestValueCount-1 do
  518. if SQLDbType=oracle then
  519. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
  520. else
  521. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
  522. with TSQLDBConnector(DBConnector).Query do
  523. begin
  524. Open;
  525. for i := 0 to corrTestValueCount-1 do
  526. begin
  527. if length(testValues[i]) < 12 then
  528. AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
  529. else
  530. AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss', fields[0].AsDateTime, DBConnector.FormatSettings));
  531. Next;
  532. end;
  533. close;
  534. end;
  535. end;
  536. procedure TTestFieldTypes.TestFloat;
  537. const
  538. testValuesCount = 21;
  539. 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);
  540. var
  541. i : byte;
  542. begin
  543. CreateTableWithFieldType(ftFloat,'FLOAT');
  544. TestFieldDeclaration(ftFloat,sizeof(double));
  545. for i := 0 to testValuesCount-1 do
  546. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + floattostr(testValues[i],DBConnector.FormatSettings) + ')');
  547. with TSQLDBConnector(DBConnector).Query do
  548. begin
  549. Open;
  550. for i := 0 to testValuesCount-1 do
  551. begin
  552. AssertEquals(testValues[i],fields[0].AsFloat);
  553. Next;
  554. end;
  555. close;
  556. end;
  557. end;
  558. procedure TTestFieldTypes.TestNullValues;
  559. begin
  560. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
  561. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  562. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  563. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FIELD1) values (1)');
  564. with TSQLDBConnector(DBConnector).Query do
  565. begin
  566. sql.clear;
  567. sql.append('select * from FPDEV2');
  568. open;
  569. AssertEquals(1,FieldByName('FIELD1').AsInteger);
  570. AssertTrue('Null-values test failed',FieldByName('FIELD2').IsNull);
  571. close;
  572. end;
  573. end;
  574. procedure TTestFieldTypes.TestParamQuery;
  575. begin
  576. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT, FIELD3 INT, DECOY VARCHAR(30))');
  577. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  578. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  579. with TSQLDBConnector(DBConnector).Query do
  580. begin
  581. sql.clear;
  582. sql.append('insert into FPDEV2 (field1) values (:field1)');
  583. Params.ParamByName('field1').AsInteger := 1;
  584. ExecSQL;
  585. sql.clear;
  586. sql.append('insert into FPDEV2 (field1,field2,decoy) values (:field1,:field2,''decoytest'')');
  587. Params.ParamByName('field1').AsInteger := 2;
  588. Params.ParamByName('field2').DataType := ftInteger;
  589. Params.ParamByName('field2').Value := Null;
  590. ExecSQL;
  591. sql.clear;
  592. sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field3)');
  593. Params.ParamByName('field1').AsInteger := 3;
  594. Params.ParamByName('field2').AsInteger := 2;
  595. Params.ParamByName('field3').AsInteger := 3;
  596. ExecSQL;
  597. sql.clear;
  598. sql.append('insert into FPDEV2 (field1,field2,field3,decoy) values (:field1,:field2,:field3,'':decoy ::test $decoy2 $$2'')');
  599. Params.ParamByName('field1').AsInteger := 4;
  600. Params.ParamByName('field2').AsInteger := 2;
  601. Params.ParamByName('field3').AsInteger := 3;
  602. ExecSQL;
  603. sql.clear;
  604. sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field1)');
  605. Params.ParamByName('field1').AsInteger := 5;
  606. Params.ParamByName('field2').AsInteger := 2;
  607. ExecSQL;
  608. sql.clear;
  609. sql.append('select * from FPDEV2 order by FIELD1');
  610. open;
  611. AssertEquals(1,FieldByName('FIELD1').asinteger);
  612. AssertTrue(FieldByName('FIELD2').IsNull);
  613. AssertTrue(FieldByName('FIELD3').IsNull);
  614. AssertTrue(FieldByName('DECOY').IsNull);
  615. next;
  616. AssertEquals(2,FieldByName('FIELD1').asinteger);
  617. AssertTrue(FieldByName('FIELD2').IsNull);
  618. AssertTrue(FieldByName('FIELD3').IsNull);
  619. AssertEquals('decoytest',FieldByName('DECOY').AsString);
  620. next;
  621. AssertEquals(3,FieldByName('FIELD1').asinteger);
  622. AssertEquals(2,FieldByName('FIELD2').asinteger);
  623. AssertEquals(3,FieldByName('FIELD3').asinteger);
  624. AssertTrue(FieldByName('DECOY').IsNull);
  625. next;
  626. AssertEquals(4,FieldByName('FIELD1').asinteger);
  627. AssertEquals(2,FieldByName('FIELD2').asinteger);
  628. AssertEquals(3,FieldByName('FIELD3').asinteger);
  629. AssertEquals(':decoy ::test $decoy2 $$2',FieldByName('DECOY').AsString);
  630. next;
  631. AssertEquals(5,FieldByName('FIELD1').asinteger);
  632. AssertEquals(2,FieldByName('FIELD2').asinteger);
  633. AssertEquals(5,FieldByName('FIELD3').asinteger);
  634. AssertTrue(FieldByName('DECOY').IsNull);
  635. close;
  636. end;
  637. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  638. end;
  639. procedure TTestFieldTypes.TestIntParamQuery;
  640. begin
  641. TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
  642. end;
  643. procedure TTestFieldTypes.TestFmtBCDParamQuery;
  644. begin
  645. TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
  646. end;
  647. procedure TTestFieldTypes.TestTimeParamQuery;
  648. begin
  649. TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
  650. end;
  651. procedure TTestFieldTypes.TestDateTimeParamQuery;
  652. begin
  653. TestXXParamQuery(ftDateTime,FieldtypeDefinitions[ftDateTime],testValuesCount);
  654. end;
  655. procedure TTestFieldTypes.TestFloatParamQuery;
  656. begin
  657. TestXXParamQuery(ftFloat,'FLOAT',testFloatValuesCount);
  658. end;
  659. procedure TTestFieldTypes.TestBCDParamQuery;
  660. begin
  661. TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
  662. end;
  663. procedure TTestFieldTypes.TestBytesParamQuery;
  664. begin
  665. TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, true);
  666. end;
  667. procedure TTestFieldTypes.TestStringParamQuery;
  668. begin
  669. TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
  670. end;
  671. procedure TTestFieldTypes.TestFixedStringParamQuery;
  672. begin
  673. TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
  674. end;
  675. procedure TTestFieldTypes.TestDateParamQuery;
  676. begin
  677. TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
  678. end;
  679. procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
  680. var i : integer;
  681. begin
  682. if ASQLTypeDecl = '' then
  683. Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
  684. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
  685. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  686. if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  687. with TSQLDBConnector(DBConnector).Query do
  688. begin
  689. PacketRecords := -1;
  690. sql.clear;
  691. sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
  692. // There is no Param.AsFixedChar, so the datatype has to be set manually
  693. if ADatatype=ftFixedChar then
  694. Params.ParamByName('field1').DataType := ftFixedChar;
  695. for i := 0 to testValuesCount -1 do
  696. begin
  697. Params.ParamByName('id').AsInteger := i;
  698. case ADataType of
  699. ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
  700. ftFloat : Params.ParamByName('field1').AsFloat := testFloatValues[i];
  701. ftBCD : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
  702. ftFixedChar,
  703. ftString : Params.ParamByName('field1').AsString := testValues[ADataType,i];
  704. ftTime : Params.ParamByName('field1').AsTime := TimeStringToDateTime(testTimeValues[i]);
  705. ftDate : if cross then
  706. Params.ParamByName('field1').AsString:= testDateValues[i]
  707. else
  708. Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
  709. ftDateTime:Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
  710. ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(testFmtBCDValues[i],DBConnector.FormatSettings);
  711. ftBytes : if cross then
  712. Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
  713. else
  714. Params.ParamByName('field1').AsBlob := testBytesValues[i];
  715. else
  716. AssertTrue('no test for paramtype available',False);
  717. end;
  718. ExecSQL;
  719. end;
  720. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  721. sql.clear;
  722. sql.append('select * from FPDEV2 order by ID');
  723. open;
  724. for i := 0 to testValuesCount -1 do
  725. begin
  726. AssertEquals(i,FieldByName('ID').AsInteger);
  727. case ADataType of
  728. ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
  729. ftFloat : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
  730. ftBCD : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
  731. ftFixedChar : AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
  732. ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
  733. ftTime : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
  734. ftDate : AssertEquals(testDateValues[i],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
  735. ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
  736. ftFMTBcd : AssertEquals(testFmtBCDValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
  737. ftBytes : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
  738. else
  739. AssertTrue('no test for paramtype available',False);
  740. end;
  741. Next;
  742. end;
  743. close;
  744. end;
  745. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  746. end;
  747. procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
  748. var
  749. ASQL : TSQLQuery;
  750. begin
  751. CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
  752. TestFieldDeclaration(ftBlob,0);
  753. ASQL := DBConnector.GetNDataset(True,1) as tsqlquery;
  754. with ASql do
  755. begin
  756. sql.Text := 'insert into FPDEV2 (FT) values (:BlobParam)';
  757. case asWhat of
  758. 0: Params.ParamByName('blobParam').AsMemo := 'Test deze BLob';
  759. 1: Params.ParamByName('blobParam').AsString := 'Test deze BLob';
  760. 2: Params.ParamByName('blobParam').AsBlob := 'Test deze BLob';
  761. end;
  762. ExecSQL;
  763. end;
  764. with TSQLDBConnector(DBConnector).Query do
  765. begin
  766. Open;
  767. if not eof then
  768. AssertEquals('Test deze BLob',fields[0].AsString);
  769. close;
  770. end;
  771. end;
  772. procedure TTestFieldTypes.TestAggregates;
  773. begin
  774. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
  775. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  776. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  777. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
  778. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
  779. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
  780. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
  781. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  782. with TSQLDBConnector(DBConnector).Query do
  783. begin
  784. sql.clear;
  785. sql.append('select count(*) from FPDEV2');
  786. open;
  787. AssertEquals(4,Fields[0].AsInteger);
  788. close;
  789. sql.clear;
  790. sql.append('select sum(FIELD1) from FPDEV2');
  791. open;
  792. AssertEquals(10,Fields[0].AsInteger);
  793. close;
  794. sql.clear;
  795. sql.append('select avg(FIELD2) from FPDEV2');
  796. open;
  797. AssertEquals(3,Fields[0].AsInteger);
  798. close;
  799. end;
  800. end;
  801. procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
  802. ASQLTypeDecl: string);
  803. begin
  804. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
  805. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  806. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  807. end;
  808. procedure TTestFieldTypes.TestFieldDeclaration(ADatatype: TFieldType;
  809. ADataSize: integer);
  810. begin
  811. with TSQLDBConnector(DBConnector).Query do
  812. begin
  813. SQL.Clear;
  814. SQL.Add('select * from FPDEV2');
  815. Open;
  816. AssertEquals(1,FieldCount);
  817. AssertTrue(CompareText('FT',fields[0].FieldName)=0);
  818. AssertEquals(ADataSize,fields[0].DataSize);
  819. AssertTrue(ADatatype=fields[0].DataType);
  820. Close;
  821. end;
  822. end;
  823. procedure TTestFieldTypes.SetUp;
  824. begin
  825. InitialiseDBConnector;
  826. end;
  827. procedure TTestFieldTypes.TearDown;
  828. begin
  829. if assigned(DBConnector) then
  830. TSQLDBConnector(DBConnector).Transaction.Rollback;
  831. FreeDBConnector;
  832. end;
  833. procedure TTestFieldTypes.RunTest;
  834. begin
  835. // if (SQLDbType in TSQLDBTypes) then
  836. inherited RunTest;
  837. end;
  838. procedure TTestFieldTypes.TestQueryAfterReconnect;
  839. var DS: TDataset;
  840. begin
  841. ds := DBConnector.GetNDataset(true,5);
  842. with ds do
  843. begin
  844. open;
  845. close;
  846. TSQLDBConnector(DBConnector).Connection.Close;
  847. TSQLDBConnector(DBConnector).Connection.Open;
  848. open;
  849. close;
  850. end;
  851. end;
  852. procedure TTestFieldTypes.TestLocateNull;
  853. var DS: TCustomBufDataset;
  854. begin
  855. ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset;
  856. with ds do
  857. begin
  858. open;
  859. edit;
  860. fieldbyname('name').Clear;
  861. post;
  862. next;
  863. AssertFalse(Locate('name',VarArrayOf(['TestName1']),[]));
  864. AssertTrue(Locate('name',VarArrayOf([Null]),[]));
  865. AssertEquals(1,fieldbyname('ID').AsInteger);
  866. end;
  867. end;
  868. procedure TTestFieldTypes.TestLocateOnMoreRecords;
  869. var DS: TCustomBufDataset;
  870. begin
  871. with TSQLDBConnector(DBConnector) do
  872. begin
  873. ds := GetNDataset(true,30) as TCustomBufDataset;
  874. with query do
  875. begin
  876. SQL.Text:='update FPDEV set NAME = null where ID<11;';
  877. ExecSQL;
  878. SQL.Text:='update FPDEV set NAME = null where (ID>11) and (ID<23);';
  879. ExecSQL;
  880. end;
  881. with ds do
  882. begin
  883. Open;
  884. // Must be exactly 11 to trigger bug/test
  885. AssertTrue(Locate('name',VarArrayOf(['TestName11']),[]));
  886. AssertEquals(11,fieldbyname('ID').AsInteger);
  887. // Must be exactly 23 to trigger bug/test
  888. AssertTrue(Locate('name',VarArrayOf(['TestName23']),[]));
  889. AssertEquals(23,fieldbyname('ID').AsInteger);
  890. end;
  891. end;
  892. end;
  893. procedure TTestFieldTypes.TestRefresh;
  894. var ADataset: TDataset;
  895. i: integer;
  896. AFldID, AFldName: TField;
  897. begin
  898. ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5);
  899. Adataset.Open;
  900. AFldId:=Adataset.Fields[0];
  901. AFldName:=Adataset.Fields[1];
  902. for i := 1 to 5 do
  903. begin
  904. AssertEquals(i,AFldID.asinteger);
  905. AssertEquals('TestName'+inttostr(i),AFldName.asstring);
  906. ADataset.Next;
  907. end;
  908. ADataset.Next;
  909. AssertTrue(ADataset.EOF);
  910. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''test'' where ID=2');
  911. ADataset.Refresh;
  912. ADataset.First;
  913. for i := 1 to 5 do
  914. begin
  915. AssertEquals(i,AFldID.AsInteger);
  916. if i = 2 then
  917. AssertEquals('test',AFldName.AsString)
  918. else
  919. AssertEquals('TestName'+inttostr(i),AFldName.AsString);
  920. ADataset.Next;
  921. end;
  922. ADataset.Next;
  923. AssertTrue(ADataset.EOF);
  924. end;
  925. procedure TTestFieldTypes.TestEmptyUpdateQuery;
  926. begin
  927. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
  928. end;
  929. procedure TTestFieldTypes.TestNonNullableParams;
  930. var ASQLQuery : TSQLQuery;
  931. Passed: Boolean;
  932. begin
  933. // Check for an exception when a null value is stored into a non-nullable
  934. // field using a parameter
  935. // There was a bug in IBConnection so that in this case the last used value
  936. // for the parameter was used.
  937. // To make sure that any changes are cancelled in the case the test fails
  938. TSQLDBConnector(DBConnector).GetNDataset(true,5);
  939. ASQLQuery := TSQLDBConnector(DBConnector).Query;
  940. ASQLQuery.SQL.text := 'update fpdev set ID=:ID1 where id = :ID2';
  941. ASQLQuery.Params[0].Clear;
  942. ASQLQuery.Params[1].AsInteger := 1;
  943. AssertTrue(ASQLQuery.Params[0].IsNull);
  944. Passed:=False;
  945. try
  946. @ASQLQuery.ExecSQL;
  947. except
  948. on E: Exception do
  949. if E.ClassType.InheritsFrom(EDatabaseError) then
  950. Passed := true;
  951. end;
  952. AssertTrue(Passed);
  953. end;
  954. procedure TTestFieldTypes.TestStringLargerThen8192;
  955. var
  956. s : string;
  957. i : integer;
  958. begin
  959. CreateTableWithFieldType(ftString,'VARCHAR(9000)');
  960. TestFieldDeclaration(ftString,9001);
  961. setlength(s,9000);
  962. for i := 1 to 9000 do
  963. s[i]:=chr((i mod 10)+ord('a'));
  964. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + s + ''')');
  965. with TSQLDBConnector(DBConnector).Query do
  966. begin
  967. Open;
  968. AssertEquals(s,fields[0].AsString);
  969. close;
  970. end;
  971. end;
  972. procedure TTestFieldTypes.TestTableNames;
  973. var TableList : TStringList;
  974. i : integer;
  975. begin
  976. TableList := TStringList.Create;
  977. try
  978. TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
  979. AssertTrue(TableList.Find('fpdev',i));
  980. finally
  981. TableList.Free;
  982. end;
  983. end;
  984. procedure TTestFieldTypes.TestFieldNames;
  985. var FieldList : TStringList;
  986. i : integer;
  987. begin
  988. FieldList := TStringList.Create;
  989. try
  990. TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
  991. AssertTrue(FieldList.Find('id',i));
  992. finally
  993. FieldList.Free;
  994. end;
  995. end;
  996. procedure TTestFieldTypes.TestInsertReturningQuery;
  997. begin
  998. if not(SQLDbType in [postgresql,interbase,oracle]) then Ignore('This test does not apply to this db-engine');
  999. with TSQLDBConnector(DBConnector) do
  1000. begin
  1001. // This only works with databases that supports 'insert into .. returning'
  1002. // for example: PostgreSQL, Oracle, Firebird version 2.0 and up
  1003. CreateTableWithFieldType(ftInteger,'int');
  1004. Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
  1005. Query.Open;
  1006. AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
  1007. AssertEquals(154,Query.fields[0].AsInteger);
  1008. Query.Close;
  1009. end;
  1010. end;
  1011. procedure TTestFieldTypes.TestOpenStoredProc;
  1012. begin
  1013. with TSQLDBConnector(DBConnector) do
  1014. begin
  1015. if SQLDbType in MySQLdbTypes then
  1016. begin
  1017. Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
  1018. Query.SQL.Text:='call FPDEV_PROC';
  1019. end
  1020. else if SQLDbType = interbase then
  1021. begin
  1022. Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
  1023. Query.SQL.Text:='execute procedure FPDEV_PROC';
  1024. end
  1025. else
  1026. begin
  1027. Ignore('This test does not apply to this sqldb-connection type, since it does not support selectable stored procedures.');
  1028. Exit;
  1029. end;
  1030. Transaction.CommitRetaining;
  1031. try
  1032. Query.Open;
  1033. AssertEquals(1, Query.Fields[0].AsInteger);
  1034. Query.Next;
  1035. if not(SQLDbType in [interbase]) then
  1036. begin
  1037. AssertFalse('Eof after 1st row', Query.Eof);
  1038. AssertEquals(2, Query.Fields[0].AsInteger);
  1039. Query.Next;
  1040. end;
  1041. AssertTrue('No Eof after last row', Query.Eof);
  1042. Query.Close;
  1043. finally
  1044. Connection.ExecuteDirect('drop procedure FPDEV_PROC');
  1045. Transaction.CommitRetaining;
  1046. end;
  1047. end;
  1048. end;
  1049. procedure TTestFieldTypes.TestClearUpdateableStatus;
  1050. // Test if CanModify is correctly disabled in case of a select query without
  1051. // a from-statement.
  1052. begin
  1053. if not (SQLDbType in MySQLdbTypes) then Ignore('This test does only apply to MySQL because the used SQL-statement is MySQL only.');
  1054. with TSQLDBConnector(DBConnector) do
  1055. begin
  1056. with (GetNDataset(false,5) as TSQLQuery) do
  1057. begin
  1058. Open;
  1059. AssertEquals(True,CanModify);
  1060. Close;
  1061. SQL.Text:='select last_insert_id();';
  1062. Open;
  1063. AssertEquals(False,CanModify);
  1064. close;
  1065. end;
  1066. end;
  1067. end;
  1068. procedure TTestFieldTypes.TestReadOnlyParseSQL;
  1069. begin
  1070. with TSQLDBConnector(DBConnector) do
  1071. begin
  1072. GetFieldDataset(True);
  1073. with query do
  1074. begin
  1075. AssertFalse(ReadOnly);
  1076. AssertTrue(ParseSQL);
  1077. // If ParseSQL is false, and no update-queries are given, the query
  1078. // shouldn't be updateable after open.
  1079. ParseSQL := False;
  1080. AssertFalse(ParseSQL);
  1081. AssertFalse(ReadOnly);
  1082. SQL.Text := 'select * from FPDEV;';
  1083. open;
  1084. AssertFalse(ParseSQL);
  1085. AssertFalse(ReadOnly);
  1086. AssertFalse(CanModify);
  1087. close;
  1088. // If ParseSQL is true, the query should be updateable after open.
  1089. ReadOnly := False;
  1090. ParseSQL := True;
  1091. AssertTrue(ParseSQL);
  1092. AssertFalse(ReadOnly);
  1093. SQL.Text := 'select * from FPDEV';
  1094. open;
  1095. AssertTrue(ParseSQL);
  1096. AssertFalse(ReadOnly);
  1097. AssertTrue(CanModify);
  1098. edit;
  1099. FieldByName('ID').AsInteger:=321;
  1100. post;
  1101. Applyupdates;
  1102. close;
  1103. // If ParseSQL is true, but the supplied query isn't updateable, then
  1104. // the query shouldn't be updateable after open.
  1105. ReadOnly := False;
  1106. SQL.Text:='select ID,NAME from FPDEV where ID<5';
  1107. sql.Add('union');
  1108. sql.Add('select ID,NAME from FPDEV where ID>5');
  1109. AssertTrue(ParseSQL);
  1110. AssertFalse(ReadOnly);
  1111. open;
  1112. AssertTrue(ParseSQL);
  1113. AssertFalse(ReadOnly);
  1114. AssertFalse(CanModify);
  1115. close;
  1116. // As above, but now with an update-query, so that the query should
  1117. // be updateable again.
  1118. ReadOnly := False;
  1119. AssertTrue(ParseSQL);
  1120. AssertFalse(ReadOnly);
  1121. UpdateSQL.Text:='update FPDEV set ID=:ID where ID=:OLD_ID';
  1122. open;
  1123. AssertTrue(ParseSQL);
  1124. AssertFalse(ReadOnly);
  1125. AssertTrue(CanModify);
  1126. edit;
  1127. post;
  1128. Applyupdates;
  1129. close;
  1130. // Also if ParseSQL is False, the query should be updateable if a update-
  1131. // query is given.
  1132. ReadOnly := False;
  1133. ParseSQL := False;
  1134. AssertFalse(ParseSQL);
  1135. AssertFalse(ReadOnly);
  1136. open;
  1137. AssertFalse(ParseSQL);
  1138. AssertFalse(ReadOnly);
  1139. AssertTrue(CanModify);
  1140. edit;
  1141. FieldByName('ID').AsInteger:=1;
  1142. post;
  1143. Applyupdates;
  1144. close;
  1145. // But if ReadOnly is true, then CanModify should always be false
  1146. ReadOnly := True;
  1147. ParseSQL := False;
  1148. AssertFalse(ParseSQL);
  1149. AssertTrue(ReadOnly);
  1150. open;
  1151. AssertFalse(ParseSQL);
  1152. AssertTrue(ReadOnly);
  1153. AssertFalse(CanModify);
  1154. close;
  1155. end;
  1156. end;
  1157. end;
  1158. procedure TTestFieldTypes.TestParseJoins;
  1159. begin
  1160. with TSQLDBConnector(DBConnector) do
  1161. begin
  1162. with query do
  1163. begin
  1164. SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
  1165. Open;
  1166. close;
  1167. end;
  1168. end;
  1169. end;
  1170. procedure TTestFieldTypes.TestDoubleFieldNames;
  1171. begin
  1172. with TSQLDBConnector(DBConnector) do
  1173. begin
  1174. with query do
  1175. begin
  1176. SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
  1177. Open;
  1178. AssertTrue(assigned(FindField('ID')));
  1179. AssertTrue (assigned(FindField('ID_1')));
  1180. AssertTrue(assigned(FindField('NAME')));
  1181. AssertTrue(assigned(FindField('NAME_1')));
  1182. AssertEquals(1,fieldbyname('ID').AsInteger);
  1183. AssertEquals(1,fieldbyname('ID_1').AsInteger);
  1184. AssertEquals('TestName1',fieldbyname('NAME').AsString);
  1185. AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
  1186. close;
  1187. end;
  1188. end;
  1189. end;
  1190. procedure TTestFieldTypes.TestParseUnion;
  1191. begin
  1192. with TSQLDBConnector(DBConnector) do
  1193. begin
  1194. with query do
  1195. begin
  1196. SQL.Text:='select NAME from FPDEV where ID<5';
  1197. sql.Add('union');
  1198. sql.Add('select NAME from FPDEV where ID>5');
  1199. Open;
  1200. close;
  1201. end;
  1202. end;
  1203. end;
  1204. procedure TTestFieldTypes.TestInsertLargeStrFields;
  1205. begin
  1206. with TSQLDBConnector(DBConnector) do
  1207. begin
  1208. Connection.ExecuteDirect('create table FPDEV2 ( ' +
  1209. ' ID INT NOT NULL , ' +
  1210. ' NAME VARCHAR(16000), ' +
  1211. ' PRIMARY KEY (ID) ' +
  1212. ') ');
  1213. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1214. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1215. query.sql.Text:='select * from FPDEV2';
  1216. Query.Open;
  1217. Query.InsertRecord([1,'test1']);
  1218. Query.ApplyUpdates;
  1219. Query.Close;
  1220. Query.Open;
  1221. AssertEquals(query.FieldByName('NAME').AsString,'test1');
  1222. query.Close;
  1223. end;
  1224. end;
  1225. procedure TTestFieldTypes.TestNumericNames;
  1226. begin
  1227. with TSQLDBConnector(DBConnector) do
  1228. begin
  1229. Connection.ExecuteDirect('create table FPDEV2 ( ' +
  1230. ' '+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[1]+' INT NOT NULL, ' +
  1231. ' '+connection.FieldNameQuoteChars[0]+'3TEST'+connection.FieldNameQuoteChars[1]+' VARCHAR(10), ' +
  1232. ' PRIMARY KEY ('+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[0]+') ' +
  1233. ') ');
  1234. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1235. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1236. with query do
  1237. begin
  1238. SQL.Text:='select * from FPDEV2';
  1239. Open;
  1240. Edit;
  1241. fieldbyname('2ID').AsInteger:=1;
  1242. fieldbyname('3TEST').AsString:='3test';
  1243. Post;
  1244. ApplyUpdates(0);
  1245. close;
  1246. open;
  1247. AssertEquals('3test',FieldByName('3TEST').AsString);
  1248. Edit;
  1249. fieldbyname('3TEST').AsString:='test3';
  1250. Post;
  1251. ApplyUpdates(0);
  1252. open;
  1253. AssertEquals('test3',FieldByName('3TEST').AsString);
  1254. close;
  1255. end;
  1256. end;
  1257. end;
  1258. procedure TTestFieldTypes.TestApplyUpdFieldnames;
  1259. begin
  1260. with TSQLDBConnector(DBConnector) do
  1261. begin
  1262. AssertEquals(-1,query.RowsAffected);
  1263. Connection.ExecuteDirect('create table FPDEV2 ( ' +
  1264. ' ID INT NOT NULL , ' +
  1265. ' '+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+' VARCHAR(250), ' +
  1266. ' PRIMARY KEY (ID) ' +
  1267. ') ');
  1268. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1269. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1270. Connection.ExecuteDirect('insert into FPDEV2(ID,'+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+') values (1,''test1'')');
  1271. Query.SQL.Text := 'select * from FPDEV2';
  1272. Query.Open;
  1273. AssertEquals(1,Query.FieldByName('ID').AsInteger);
  1274. AssertEquals('test1',Query.FieldByName('NAME-TEST').AsString);
  1275. Query.Edit;
  1276. Query.FieldByName('NAME-TEST').AsString:='Edited';
  1277. Query.Post;
  1278. Query.ApplyUpdates;
  1279. Query.Close;
  1280. Query.Open;
  1281. AssertEquals(1,Query.FieldByName('ID').AsInteger);
  1282. AssertEquals('Edited',Query.FieldByName('NAME-TEST').AsString);
  1283. Query.Close;
  1284. end;
  1285. end;
  1286. procedure TTestFieldTypes.TestLimitQuery;
  1287. begin
  1288. with TSQLDBConnector(DBConnector) do
  1289. begin
  1290. with query do
  1291. begin
  1292. if (sqlDBtype=interbase) then
  1293. SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
  1294. else
  1295. SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
  1296. Open;
  1297. close;
  1298. ServerFilter:='ID=21';
  1299. ServerFiltered:=true;
  1300. open;
  1301. close;
  1302. end;
  1303. end;
  1304. end;
  1305. procedure TTestFieldTypes.TestRowsAffected;
  1306. begin
  1307. with TSQLDBConnector(DBConnector) do
  1308. begin
  1309. AssertEquals(-1,query.RowsAffected);
  1310. Connection.ExecuteDirect('create table FPDEV2 ( ' +
  1311. ' ID INT NOT NULL , ' +
  1312. ' NAME VARCHAR(250), ' +
  1313. ' PRIMARY KEY (ID) ' +
  1314. ') ');
  1315. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1316. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1317. Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
  1318. Query.ExecSQL;
  1319. AssertEquals(1,query.RowsAffected);
  1320. Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (2,''test2'')';
  1321. Query.ExecSQL;
  1322. AssertEquals(1,query.RowsAffected);
  1323. Query.SQL.Text := 'update FPDEV2 set NAME=''NewTest''';
  1324. Query.ExecSQL;
  1325. AssertEquals(2,query.RowsAffected);
  1326. Query.SQL.Text := 'select * from FPDEV2';
  1327. Query.Open;
  1328. AssertTrue(query.RowsAffected<>0); // It should return -1 or the number of selected rows.
  1329. query.Close;
  1330. AssertTrue(query.RowsAffected<>0); // It should return -1 or the same as the last time it was called.
  1331. if (SQLDbType = sqlite3) then // sqlite doesn't count the rowsaffected if there is no where-clause
  1332. Query.SQL.Text := 'delete from FPDEV2 where 1'
  1333. else
  1334. Query.SQL.Text := 'delete from FPDEV2';
  1335. Query.ExecSQL;
  1336. AssertEquals(2,query.RowsAffected);
  1337. Query.SQL.Text := 'delete from FPDEV2';
  1338. Query.ExecSQL;
  1339. AssertEquals(0,query.RowsAffected);
  1340. end;
  1341. end;
  1342. procedure TTestFieldTypes.TestStringsReplace;
  1343. begin
  1344. AssertEquals('dit is een string',StringsReplace('dit was een string',['was'],['is'],[]));
  1345. AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['was'],['is'],[]));
  1346. AssertEquals('dit is een string is een string',StringsReplace('dit was een string was een string',['was'],['is'],[rfReplaceAll]));
  1347. AssertEquals('dit is een char is een char',StringsReplace('dit was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1348. AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['string','was'],['char','is'],[]));
  1349. AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll]));
  1350. AssertEquals('dit Was een char is een char',StringsReplace('dit Was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1351. AssertEquals('dit wAs een char is een char',StringsReplace('dit wAs een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
  1352. AssertEquals('dit is een char is een char',StringsReplace('dit Was een sTring was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
  1353. AssertEquals('dit is een char is een char',StringsReplace('dit wAs een STRING was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
  1354. AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['straat','string'],['sa','si'],[rfReplaceAll]));
  1355. AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['string','straat'],['si','sa'],[rfReplaceAll]));
  1356. AssertEquals('dit was een sing was een saat',StringsReplace('dit was een string was een straat',['str','string'],['s','si'],[rfReplaceAll]));
  1357. AssertEquals('dit was een si was een saat',StringsReplace('dit was een string was een straat',['string','str'],['si','s'],[rfReplaceAll]));
  1358. AssertEquals('dit was een string was een string',StringsReplace('dit was een string was een string',[''],['is'],[rfReplaceAll]));
  1359. AssertEquals('dit een string een string',StringsReplace('dit was een string was een string',['was'],[''],[rfReplaceAll]));
  1360. end;
  1361. procedure TTestFieldTypes.TestCircularParams;
  1362. begin
  1363. with TSQLDBConnector(dbconnector) do
  1364. begin
  1365. Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int,vchar varchar(10))');
  1366. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1367. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1368. Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:vchar)';
  1369. query.params[0].asinteger := 1;
  1370. query.params[1].asinteger := 1;
  1371. query.params[2].asstring := '$1 :id2 $';
  1372. query.ExecSQL;
  1373. query.sql.text := 'select * from FPDEV2';
  1374. query.open;
  1375. AssertEquals(1,query.fields[0].asinteger);
  1376. AssertEquals(1,query.fields[1].asinteger);
  1377. AssertEquals('$1 :id2 $',query.fields[2].AsString);
  1378. query.close;
  1379. end;
  1380. end;
  1381. procedure TTestFieldTypes.Test11Params;
  1382. var i : integer;
  1383. begin
  1384. with TSQLDBConnector(dbconnector) do
  1385. begin
  1386. 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)');
  1387. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1388. TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1389. Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:id3,:id4,:id5,:id6,:id7,:id8,:id9,:id10,:id11)';
  1390. for i := 0 to 10 do
  1391. query.params[i].asinteger := 1;
  1392. query.ExecSQL;
  1393. query.sql.text := 'select * from FPDEV2';
  1394. query.open;
  1395. for i := 0 to 10 do
  1396. AssertEquals(1,query.fields[i].asinteger);
  1397. query.close;
  1398. end;
  1399. end;
  1400. procedure TTestFieldTypes.TestBug9744;
  1401. var i : integer;
  1402. begin
  1403. if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
  1404. with TSQLDBConnector(DBConnector) do
  1405. begin
  1406. try
  1407. Connection.ExecuteDirect('create table TTTOBJ ( ' +
  1408. ' ID INT NOT NULL, ' +
  1409. ' NAME VARCHAR(250), ' +
  1410. ' PRIMARY KEY (ID) ' +
  1411. ') ');
  1412. Connection.ExecuteDirect('create table TTTXY ( ' +
  1413. ' ID INT NOT NULL, ' +
  1414. ' NP INT NOT NULL, ' +
  1415. ' X DOUBLE, ' +
  1416. ' Y DOUBLE, ' +
  1417. ' PRIMARY KEY (ID,NP) ' +
  1418. ') ');
  1419. for i := 0 to 7 do
  1420. begin
  1421. connection.ExecuteDirect('insert into TTTOBJ(ID,NAME) values ('+inttostr(i)+',''A'+inttostr(i)+''')');
  1422. connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',1,1,1)');
  1423. connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',2,2,2)');
  1424. end;
  1425. Query.SQL.Text := 'select OBJ.ID, OBJ.NAME, count(XY.NP) as NPF from TTTOBJ as OBJ, TTTXY as XY where (OBJ.ID=XY.ID) group by OBJ.ID';
  1426. query.Prepare;
  1427. query.open;
  1428. query.close;
  1429. finally
  1430. Connection.ExecuteDirect('drop table TTTXY');
  1431. Connection.ExecuteDirect('drop table TTTOBJ');
  1432. end
  1433. end;
  1434. end;
  1435. procedure TTestFieldTypes.TestCrossStringDateParam;
  1436. begin
  1437. TestXXParamQuery(ftDate,'DATE',testDateValuesCount,True);
  1438. end;
  1439. procedure TTestFieldTypes.TestGetFieldNames;
  1440. var FieldNames : TStringList;
  1441. begin
  1442. with TSQLDBConnector(DBConnector) do
  1443. begin
  1444. FieldNames := TStringList.Create;
  1445. try
  1446. if SQLDbType in MySQLdbTypes then
  1447. Connection.GetFieldNames('FPDEV',FieldNames)
  1448. else
  1449. Connection.GetFieldNames('fpDEv',FieldNames);
  1450. AssertEquals(2,FieldNames.Count);
  1451. AssertEquals('ID',UpperCase(FieldNames[0]));
  1452. AssertEquals('NAME',UpperCase(FieldNames[1]));
  1453. finally
  1454. FieldNames.Free;
  1455. end;
  1456. end;
  1457. end;
  1458. procedure TTestFieldTypes.TestGetTables;
  1459. var TableNames : TStringList;
  1460. begin
  1461. with TSQLDBConnector(DBConnector) do
  1462. begin
  1463. TableNames := TStringList.Create;
  1464. try
  1465. Connection.GetTableNames(TableNames);
  1466. AssertTrue(TableNames.Count>0);
  1467. AssertTrue(TableNames.IndexOf('FPDEV')>-1);
  1468. AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
  1469. finally
  1470. TableNames.Free;
  1471. end;
  1472. end;
  1473. end;
  1474. procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
  1475. var
  1476. i : byte;
  1477. s: string;
  1478. begin
  1479. CreateTableWithFieldType(ADatatype,ASQLTypeDecl);
  1480. TestFieldDeclaration(ADatatype,ADataSize);
  1481. for i := 0 to testValuesCount-1 do
  1482. begin
  1483. s := AGetSQLTextProc(i);
  1484. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + s + ')');
  1485. end;
  1486. with TSQLDBConnector(DBConnector).Query do
  1487. begin
  1488. Open;
  1489. for i := 0 to testValuesCount-1 do
  1490. begin
  1491. ACheckFieldValueProc(fields[0],i);
  1492. Next;
  1493. end;
  1494. close;
  1495. end;
  1496. end;
  1497. // Placed here, as long as bug 18702 is not solved
  1498. function TestSQLClob_GetSQLText(const a: integer) : string;
  1499. begin
  1500. result := QuotedStr(testStringValues[a]);
  1501. end;
  1502. procedure TTestFieldTypes.TestSQLClob;
  1503. procedure CheckFieldValue(AField:TField; a : integer);
  1504. begin
  1505. AssertEquals(testStringValues[a],AField.AsString);
  1506. end;
  1507. var datatype: string;
  1508. begin
  1509. if sqlDBType=sqlite3 then
  1510. datatype:='CLOB'
  1511. else
  1512. datatype:=FieldtypeDefinitions[ftMemo];
  1513. TestSQLFieldType(ftMemo, datatype, 0, @TestSQLClob_GetSQLText, @CheckFieldValue);
  1514. end;
  1515. // Placed here, as long as bug 18702 is not solved
  1516. function TestSQLLargeInt_GetSQLText(const a: integer) : string;
  1517. begin
  1518. result := IntToStr(testLargeIntValues[a]);
  1519. end;
  1520. procedure TTestFieldTypes.TestSQLLargeint;
  1521. procedure CheckFieldValue(AField:TField; a : integer);
  1522. begin
  1523. AssertEquals(testLargeIntValues[a],AField.AsLargeInt);
  1524. end;
  1525. var datatype: string;
  1526. begin
  1527. if sqlDBType=sqlite3 then
  1528. datatype:='LARGEINT'
  1529. else
  1530. datatype:='BIGINT';
  1531. TestSQLFieldType(ftLargeint, datatype, 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
  1532. end;
  1533. procedure TTestFieldTypes.TestUpdateIndexDefs;
  1534. var ds : TSQLQuery;
  1535. begin
  1536. ds := DBConnector.GetNDataset(1) as TSQLQuery;
  1537. ds.Prepare;
  1538. ds.ServerIndexDefs.Update;
  1539. AssertEquals(1,ds.ServerIndexDefs.count);
  1540. AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
  1541. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1542. ds.ServerIndexDefs.Update;
  1543. AssertEquals(1,ds.ServerIndexDefs.count);
  1544. AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
  1545. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1546. end;
  1547. procedure TTestFieldTypes.TestMultipleFieldPKIndexDefs;
  1548. var ds : TSQLQuery;
  1549. begin
  1550. TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (' +
  1551. ' ID1 INT NOT NULL, ' +
  1552. ' ID2 INT NOT NULL, ' +
  1553. ' NAME VARCHAR(50), ' +
  1554. ' PRIMARY KEY (ID1, ID2) ' +
  1555. ') ');
  1556. // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
  1557. if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
  1558. ds := TSQLDBConnector(DBConnector).Query;
  1559. ds.sql.Text:='select * from FPDEV2';
  1560. ds.Prepare;
  1561. ds.ServerIndexDefs.Update;
  1562. AssertEquals(1,ds.ServerIndexDefs.count);
  1563. AssertTrue(SameText('ID1;ID2',ds.ServerIndexDefs[0].Fields));
  1564. Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
  1565. end;
  1566. procedure TTestFieldTypes.TestSetBlobAsMemoParam;
  1567. begin
  1568. TestSetBlobAsParam(0);
  1569. end;
  1570. procedure TTestFieldTypes.TestSetBlobAsBlobParam;
  1571. begin
  1572. TestSetBlobAsParam(2);
  1573. end;
  1574. procedure TTestFieldTypes.TestTemporaryTable;
  1575. begin
  1576. if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
  1577. with TSQLDBConnector(DBConnector).Query do
  1578. begin
  1579. SQL.Clear;
  1580. SQL.Add('CREATE TEMPORARY TABLE TEMP1 (id int)');
  1581. ExecSQL;
  1582. SQL.Text := 'INSERT INTO TEMP1(id) values (5)';
  1583. ExecSQL;
  1584. SQL.Text := 'SELECT * FROM TEMP1';
  1585. Open;
  1586. AssertEquals(5,fields[0].AsInteger);
  1587. Close;
  1588. end;
  1589. end;
  1590. procedure TTestFieldTypes.TestGetIndexDefs;
  1591. var ds : TSQLQuery;
  1592. inddefs : TIndexDefs;
  1593. begin
  1594. ds := DBConnector.GetNDataset(1) as TSQLQuery;
  1595. ds.Open;
  1596. AssertEquals(1,ds.ServerIndexDefs.count);
  1597. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary]);
  1598. AssertEquals(1,inddefs.count);
  1599. AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
  1600. Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
  1601. inddefs.Free;
  1602. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary,ixUnique]);
  1603. AssertEquals(1,inddefs.count);
  1604. AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
  1605. Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
  1606. inddefs.Free;
  1607. inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixDescending]);
  1608. AssertEquals(0,inddefs.count);
  1609. inddefs.Free;
  1610. end;
  1611. procedure TTestFieldTypes.TestDblQuoteEscComments;
  1612. begin
  1613. with TSQLDBConnector(DBConnector).Query do
  1614. begin
  1615. SQL.Clear;
  1616. SQL.Add('select * from FPDEV where name=''test '''' and :ThisIsNotAParameter ''');
  1617. open;
  1618. close;
  1619. end;
  1620. end;
  1621. procedure TTestFieldTypes.TestParametersAndDates;
  1622. // See bug 7205
  1623. var ADateStr : String;
  1624. begin
  1625. if not(SQLDbType in [postgresql,odbc,oracle]) then
  1626. Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
  1627. with TSQLDBConnector(DBConnector).Query do
  1628. begin
  1629. SQL.Clear;
  1630. sql.add('select now()::date as current_date where 1=1');
  1631. open;
  1632. first;
  1633. ADateStr:=fields[0].asstring; // return the correct date
  1634. // writeln(fields[0].asstring);
  1635. close;
  1636. sql.clear;
  1637. sql.add('select now()::date as current_date where cast(1 as integer) = :PARAM1');
  1638. params.parambyname('PARAM1').asinteger:= 1;
  1639. open;
  1640. first;
  1641. AssertEquals(ADateStr,fields[0].asstring); // return invalid date
  1642. // writeln(fields[0].asstring);
  1643. close;
  1644. end
  1645. end;
  1646. procedure TTestFieldTypes.TestExceptOnsecClose;
  1647. var passed : boolean;
  1648. begin
  1649. with TSQLDBConnector(DBConnector).Query do
  1650. begin
  1651. SQL.Clear;
  1652. SQL.Add('select * from FPDEV');
  1653. Open;
  1654. close;
  1655. SQL.Clear;
  1656. SQL.Add('select blaise from FPDEV');
  1657. passed := false;
  1658. try
  1659. open;
  1660. except
  1661. on E: Exception do
  1662. passed := (E.ClassType.InheritsFrom(EDatabaseError))
  1663. end;
  1664. AssertTrue(passed);
  1665. Close;
  1666. end;
  1667. end;
  1668. procedure TTestFieldTypes.TestErrorOnEmptyStatement;
  1669. var PassException : boolean;
  1670. begin
  1671. PassException:=False;
  1672. with TSQLDBConnector(DBConnector).Query do
  1673. begin
  1674. sql.Text := '';
  1675. try
  1676. Open;
  1677. except
  1678. on E:EDatabaseError do
  1679. if Pos(SErrNoStatement,E.Message) > 0 then
  1680. PassException := True;
  1681. end;
  1682. AssertTrue(PassException);
  1683. end;
  1684. end;
  1685. initialization
  1686. if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
  1687. end.