testfieldtypes.pas 65 KB

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