testfieldtypes.pas 78 KB

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