testfieldtypes.pas 76 KB

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