testfieldtypes.pas 73 KB

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