testfieldtypes.pas 76 KB

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