testfieldtypes.pas 61 KB

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