testdbbasics.pas 75 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004
  1. unit TestDBBasics;
  2. {$IFDEF FPC}
  3. {$mode Delphi}{$H+}
  4. {$ENDIF}
  5. interface
  6. uses
  7. {$IFDEF FPC}
  8. fpcunit, testregistry,
  9. {$ELSE FPC}
  10. TestFramework,
  11. {$ENDIF FPC}
  12. Classes, SysUtils, db, ToolsUnit;
  13. type
  14. { TTestDBBasics }
  15. TTestDBBasics = class(TDBBasicsTestCase)
  16. private
  17. procedure TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
  18. procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet);
  19. published
  20. // fields
  21. procedure TestSetFieldValues;
  22. procedure TestGetFieldValues;
  23. procedure TestSupportIntegerFields;
  24. procedure TestSupportSmallIntFields;
  25. procedure TestSupportWordFields;
  26. procedure TestSupportStringFields;
  27. procedure TestSupportBooleanFields;
  28. procedure TestSupportFloatFields;
  29. procedure TestSupportLargeIntFields;
  30. procedure TestSupportDateFields;
  31. procedure TestSupportTimeFields;
  32. procedure TestSupportCurrencyFields;
  33. procedure TestSupportBCDFields;
  34. procedure TestSupportFmtBCDFields;
  35. procedure TestSupportFixedStringFields;
  36. procedure TestSupportBlobFields;
  37. procedure TestSupportMemoFields;
  38. procedure TestCalculatedField;
  39. procedure TestCanModifySpecialFields;
  40. // dataset
  41. procedure TestDoubleClose;
  42. procedure TestFieldDefsUpdate;
  43. procedure TestAssignFieldftString;
  44. procedure TestAssignFieldftFixedChar;
  45. procedure TestSelectQueryBasics;
  46. procedure TestPostOnlyInEditState;
  47. procedure TestMove; // bug 5048
  48. procedure TestActiveBufferWhenClosed;
  49. procedure TestEOFBOFClosedDataset;
  50. procedure TestRecordcountAfterReopen; // partly bug 8228
  51. procedure TestExceptionLocateClosed; // bug 13938
  52. procedure TestDetectionNonMatchingDataset;
  53. // events
  54. procedure TestLayoutChangedEvents;
  55. procedure TestDataEventsResync;
  56. procedure TestdeFieldListChange;
  57. end;
  58. { TTestBufDatasetDBBasics }
  59. {$ifdef fpc}
  60. TTestBufDatasetDBBasics = class(TDBBasicsTestCase)
  61. private
  62. procedure FTestXMLDatasetDefinition(ADataset : TDataset);
  63. procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
  64. published
  65. procedure TestFileNameProperty;
  66. procedure TestClientDatasetAsMemDataset;
  67. procedure TestSaveAsXML;
  68. procedure TestIsEmpty;
  69. procedure TestReadOnly;
  70. // cached updates
  71. procedure TestBufDatasetCancelUpd; //bug 6938
  72. procedure TestBufDatasetCancelUpd1;
  73. procedure TestMultipleDeleteUpdateBuffer;
  74. procedure TestDoubleDelete;
  75. procedure TestMergeChangeLog;
  76. // index tests
  77. procedure TestAddIndexInteger;
  78. procedure TestAddIndexSmallInt;
  79. procedure TestAddIndexBoolean;
  80. procedure TestAddIndexFloat;
  81. procedure TestAddIndexLargeInt;
  82. procedure TestAddIndexDateTime;
  83. procedure TestAddIndexCurrency;
  84. procedure TestAddIndexBCD;
  85. procedure TestAddIndexFmtBCD;
  86. procedure TestAddIndex;
  87. procedure TestAddDescIndex;
  88. procedure TestAddCaseInsIndex;
  89. procedure TestInactSwitchIndex;
  90. procedure TestAddIndexActiveDS;
  91. procedure TestAddIndexEditDS;
  92. procedure TestIndexFieldNames;
  93. procedure TestIndexFieldNamesActive;
  94. procedure TestIndexFieldNamesClosed; // bug 16695
  95. procedure TestIndexCurRecord;
  96. procedure TestAddDblIndex;
  97. procedure TestIndexEditRecord;
  98. procedure TestIndexAppendRecord;
  99. end;
  100. {$endif fpc}
  101. TTestUniDirectionalDBBasics = class(TTestDBBasics)
  102. end;
  103. { TTestCursorDBBasics }
  104. TTestCursorDBBasics = class(TDBBasicsTestCase)
  105. private
  106. procedure TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean); // Filters out all records with even ID
  107. procedure FTestDelete1(TestCancelUpdate : boolean);
  108. procedure FTestDelete2(TestCancelUpdate : boolean);
  109. published
  110. procedure TestCancelUpdDelete1;
  111. procedure TestCancelUpdDelete2;
  112. procedure TestAppendInsertRecord;
  113. procedure TestBookmarks;
  114. procedure TestBookmarkValid;
  115. procedure TestDelete1;
  116. procedure TestDelete2;
  117. procedure TestLocate;
  118. procedure TestLocateCaseIns;
  119. procedure TestLocateCaseInsInts;
  120. procedure TestLookup;
  121. procedure TestOnFilter;
  122. procedure TestIntFilter; //Integer range filter
  123. procedure TestNegativeIntFilter; //Negative integer filter; bug 25168
  124. procedure TestStringFilter; //String filter expressions
  125. procedure TestNullAtOpen;
  126. procedure TestAppendOnEmptyDataset;
  127. procedure TestInsertOnEmptyDataset;
  128. procedure TestFirst;
  129. procedure TestEofAfterFirst; // bug 7211
  130. procedure TestLastAppendCancel; // bug 5058
  131. procedure TestRecNo; // bug 5061
  132. procedure TestSetRecNo; // bug 6919
  133. procedure TestBug7007;
  134. procedure TestBug6893;
  135. procedure TestRequired;
  136. procedure TestModified;
  137. // fields
  138. procedure TestFieldOldValueObsolete;
  139. procedure TestFieldOldValue;
  140. procedure TestChangeBlobFieldBeforePost; //bug 15376
  141. end;
  142. { TDBBasicsUniDirectionalTestSetup }
  143. {$ifdef fpc}
  144. TDBBasicsUniDirectionalTestSetup = class(TDBBasicsTestSetup)
  145. protected
  146. procedure OneTimeSetup; override;
  147. procedure OneTimeTearDown; override;
  148. end;
  149. {$endif fpc}
  150. implementation
  151. uses
  152. {$ifdef fpc}
  153. bufdataset,
  154. sqldb,
  155. {$endif fpc}
  156. variants,
  157. strutils,
  158. FmtBCD;
  159. type THackDataLink=class(TDataLink);
  160. { TTestCursorDBBasics }
  161. procedure TTestCursorDBBasics.TestAppendOnEmptyDataset;
  162. begin
  163. with DBConnector.GetNDataset(0) do
  164. begin
  165. open;
  166. CheckTrue(CanModify);
  167. CheckTrue(eof);
  168. CheckTrue(bof);
  169. append;
  170. FieldByName('id').AsInteger:=0;
  171. CheckFalse(Bof);
  172. CheckTrue(Eof);
  173. post;
  174. CheckFalse(eof);
  175. CheckFalse(bof);
  176. end;
  177. end;
  178. procedure TTestCursorDBBasics.TestInsertOnEmptyDataset;
  179. begin
  180. with DBConnector.GetNDataset(0) do
  181. begin
  182. open;
  183. CheckTrue(CanModify);
  184. CheckTrue(eof);
  185. CheckTrue(bof);
  186. CheckTrue(IsEmpty);
  187. insert;
  188. FieldByName('id').AsInteger:=0;
  189. CheckTrue(Bof);
  190. CheckTrue(Eof);
  191. CheckFalse(IsEmpty);
  192. post;
  193. CheckFalse(IsEmpty);
  194. CheckFalse(eof);
  195. CheckFalse(bof);
  196. end;
  197. end;
  198. procedure TTestDBBasics.TestSelectQueryBasics;
  199. var b : TFieldType;
  200. begin
  201. with DBConnector.GetNDataset(1) do
  202. begin
  203. Open;
  204. if IsUniDirectional then
  205. CheckEquals(-1,RecNo)
  206. else
  207. CheckEquals(1,RecNo);
  208. CheckEquals(1,RecordCount);
  209. CheckEquals(2,FieldCount);
  210. CheckTrue(CompareText('ID',fields[0].FieldName)=0);
  211. CheckTrue(CompareText('ID',fields[0].DisplayName)=0);
  212. CheckTrue(ftInteger=fields[0].DataType, 'The datatype of the field ''ID'' is incorrect, it should be ftInteger');
  213. CheckTrue(CompareText('NAME',fields[1].FieldName)=0);
  214. CheckTrue(CompareText('NAME',fields[1].DisplayName)=0);
  215. CheckTrue(ftString=fields[1].DataType);
  216. CheckEquals(1,fields[0].Value);
  217. CheckEquals('TestName1',fields[1].Value);
  218. Close;
  219. end;
  220. end;
  221. procedure TTestDBBasics.TestPostOnlyInEditState;
  222. begin
  223. with DBConnector.GetNDataset(1) do
  224. begin
  225. open;
  226. CheckException(Post,EDatabaseError,'Post was called in a non-edit state');
  227. end;
  228. end;
  229. procedure TTestDBBasics.TestMove;
  230. var i,count : integer;
  231. aDatasource : TDataSource;
  232. aDatalink : TDataLink;
  233. ABufferCount : Integer;
  234. begin
  235. aDatasource := TDataSource.Create(nil);
  236. aDatalink := TTestDataLink.Create;
  237. try
  238. aDatalink.DataSource := aDatasource;
  239. ABufferCount := 11;
  240. aDatalink.BufferCount := ABufferCount;
  241. DataEvents := '';
  242. for count := 0 to 32 do
  243. begin
  244. aDatasource.DataSet := DBConnector.GetNDataset(count);
  245. with aDatasource.Dataset do
  246. begin
  247. i := 1;
  248. Open;
  249. CheckEquals('deUpdateState:0;',DataEvents);
  250. DataEvents := '';
  251. while not EOF do
  252. begin
  253. CheckEquals(i,fields[0].AsInteger);
  254. CheckEquals('TestName'+inttostr(i),fields[1].AsString);
  255. inc(i);
  256. Next;
  257. if (i > ABufferCount) and not EOF then
  258. CheckEquals('deCheckBrowseMode:0;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
  259. else
  260. CheckEquals('deCheckBrowseMode:0;deDataSetScroll:0;DataSetScrolled:0;DataSetChanged;',DataEvents);
  261. DataEvents := '';
  262. end;
  263. CheckEquals(count,i-1);
  264. close;
  265. CheckEquals('deUpdateState:0;',DataEvents);
  266. DataEvents := '';
  267. end;
  268. end;
  269. finally
  270. aDatalink.Free;
  271. aDatasource.Free;
  272. end;
  273. end;
  274. procedure TTestDBBasics.TestActiveBufferWhenClosed;
  275. begin
  276. with DBConnector.GetNDataset(0) do
  277. begin
  278. {$ifdef fpc}
  279. AssertNull(ActiveBuffer);
  280. {$endif fpc}
  281. open;
  282. CheckFalse(ActiveBuffer = nil,'Activebuffer of an empty dataset shouldn''t be nil');
  283. end;
  284. end;
  285. procedure TTestDBBasics.TestEOFBOFClosedDataset;
  286. begin
  287. with DBConnector.GetNDataset(1) do
  288. begin
  289. CheckTrue(EOF);
  290. CheckTrue(BOF);
  291. open;
  292. CheckTrue(BOF, 'No BOF when opened non-empty dataset');
  293. CheckFalse(EOF, 'EOF after opened non-empty dataset');
  294. close;
  295. CheckTrue(EOF);
  296. CheckTrue(BOF);
  297. end;
  298. end;
  299. procedure TTestDBBasics.TestLayoutChangedEvents;
  300. var aDatasource : TDataSource;
  301. aDatalink : TDataLink;
  302. ds : tdataset;
  303. begin
  304. aDatasource := TDataSource.Create(nil);
  305. aDatalink := TTestDataLink.Create;
  306. try
  307. aDatalink.DataSource := aDatasource;
  308. ds := DBConnector.GetNDataset(6);
  309. aDatasource.DataSet:=ds;
  310. with ds do
  311. begin
  312. open;
  313. DataEvents := '';
  314. DisableControls;
  315. Active:=False;
  316. Active:=True;
  317. EnableControls;
  318. CheckEquals('deLayoutChange:0;DataSetChanged;',DataEvents);
  319. close;
  320. end;
  321. finally
  322. aDatasource.Free;
  323. aDatalink.Free;
  324. end;
  325. end;
  326. procedure TTestDBBasics.TestDataEventsResync;
  327. var i,count : integer;
  328. aDatasource : TDataSource;
  329. aDatalink : TDataLink;
  330. ds : tdataset;
  331. begin
  332. aDatasource := TDataSource.Create(nil);
  333. aDatalink := TTestDataLink.Create;
  334. try
  335. aDatalink.DataSource := aDatasource;
  336. ds := DBConnector.GetNDataset(6);
  337. ds.BeforeScroll := DBConnector.DataEvent;
  338. with ds do
  339. begin
  340. aDatasource.DataSet := ds;
  341. Open;
  342. DataEvents := '';
  343. Resync([rmExact]);
  344. if IsUniDirectional then
  345. CheckEquals('',DataEvents)
  346. else
  347. CheckEquals('deDataSetChange:0;DataSetChanged;',DataEvents);
  348. DataEvents := '';
  349. Next;
  350. if IsUniDirectional then
  351. CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents)
  352. else
  353. CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents);
  354. DataEvents := '';
  355. Close;
  356. end;
  357. finally
  358. aDatasource.Free;
  359. aDatalink.Free;
  360. end;
  361. end;
  362. procedure TTestDBBasics.TestdeFieldListChange;
  363. var i,count : integer;
  364. aDatasource : TDataSource;
  365. aDatalink : TDataLink;
  366. ds : TDataset;
  367. begin
  368. aDatasource := TDataSource.Create(nil);
  369. aDatalink := TTestDataLink.Create;
  370. aDatalink.DataSource := aDatasource;
  371. ds := DBConnector.GetNDataset(1);
  372. with ds do
  373. begin
  374. aDatasource.DataSet := ds;
  375. DataEvents := '';
  376. Open;
  377. Fields.Add(TField.Create(ds));
  378. CheckEquals('deUpdateState:0;deFieldListChange:0;',DataEvents);
  379. DataEvents := '';
  380. Fields.Clear;
  381. CheckEquals('deFieldListChange:0;',DataEvents)
  382. end;
  383. aDatasource.Free;
  384. aDatalink.Free;
  385. end;
  386. procedure TTestDBBasics.TestRecordcountAfterReopen;
  387. var
  388. datalink1: tdatalink;
  389. datasource1: tdatasource;
  390. query1: TDataSet;
  391. begin
  392. query1:= DBConnector.GetNDataset(11);
  393. datalink1:= TDataLink.create;
  394. datasource1:= tdatasource.create(nil);
  395. try
  396. datalink1.datasource:= datasource1;
  397. datasource1.dataset:= query1;
  398. query1.active := true;
  399. query1.active := False;
  400. CheckEquals(0, THackDataLink(datalink1).RecordCount);
  401. query1.active := true;
  402. CheckTrue(THackDataLink(datalink1).RecordCount>0);
  403. query1.active := false;
  404. finally
  405. datalink1.free;
  406. datasource1.free;
  407. end;
  408. end;
  409. procedure TTestCursorDBBasics.TestLastAppendCancel;
  410. var count : integer;
  411. begin
  412. for count := 0 to 32 do with DBConnector.GetNDataset(count) do
  413. begin
  414. open;
  415. Last;
  416. Append;
  417. Cancel;
  418. CheckEquals(count,fields[0].asinteger);
  419. CheckEquals(count,RecordCount);
  420. Close;
  421. end;
  422. end;
  423. procedure TTestCursorDBBasics.TestRecNo;
  424. var i : longint;
  425. passed : boolean;
  426. begin
  427. with DBConnector.GetNDataset(0) do
  428. begin
  429. // Accessing RecNo on a closed dataset should raise an EDatabaseError or should
  430. // return 0
  431. passed := false;
  432. try
  433. i := recno;
  434. except on E: Exception do
  435. begin
  436. passed := E.classname = EDatabaseError.className
  437. end;
  438. end;
  439. if not passed then
  440. CheckEquals(0,RecNo,'Failed to get the RecNo from a closed dataset');
  441. // Accessing Recordcount on a closed dataset should raise an EDatabaseError or should
  442. // return 0
  443. passed := false;
  444. try
  445. i := recordcount;
  446. except on E: Exception do
  447. begin
  448. passed := E.classname = EDatabaseError.className
  449. end;
  450. end;
  451. if not passed then
  452. CheckEquals(0,RecNo,'Failed to get the Recordcount from a closed dataset');
  453. Open;
  454. CheckEquals(0,RecordCount);
  455. CheckEquals(0,RecNo);
  456. first;
  457. CheckEquals(0,RecordCount);
  458. CheckEquals(0,RecNo);
  459. last;
  460. CheckEquals(0,RecordCount);
  461. CheckEquals(0,RecNo);
  462. append;
  463. CheckEquals(0,RecNo);
  464. CheckEquals(0,RecordCount);
  465. first;
  466. CheckEquals(0,RecNo);
  467. CheckEquals(0,RecordCount);
  468. append;
  469. FieldByName('id').AsInteger := 1;
  470. CheckEquals(0,RecNo);
  471. CheckEquals(0,RecordCount);
  472. first;
  473. CheckEquals(1,RecNo);
  474. CheckEquals(1,RecordCount);
  475. last;
  476. CheckEquals(1,RecNo);
  477. CheckEquals(1,RecordCount);
  478. append;
  479. FieldByName('id').AsInteger := 1;
  480. CheckEquals(0,RecNo,'RecNo after 3rd Append');
  481. CheckEquals(1,RecordCount);
  482. Close;
  483. end;
  484. end;
  485. procedure TTestCursorDBBasics.TestSetRecNo;
  486. begin
  487. with DBConnector.GetNDataset(15) do
  488. begin
  489. Open;
  490. RecNo := 1;
  491. CheckEquals(1,fields[0].AsInteger);
  492. CheckEquals(1,RecNo);
  493. RecNo := 2;
  494. CheckEquals(2,fields[0].AsInteger);
  495. CheckEquals(2,RecNo);
  496. RecNo := 8;
  497. CheckEquals(8,fields[0].AsInteger);
  498. CheckEquals(8,RecNo);
  499. RecNo := 15;
  500. CheckEquals(15,fields[0].AsInteger);
  501. CheckEquals(15,RecNo);
  502. RecNo := 3;
  503. CheckEquals(3,fields[0].AsInteger);
  504. CheckEquals(3,RecNo);
  505. RecNo := 14;
  506. CheckEquals(14,fields[0].AsInteger);
  507. CheckEquals(14,RecNo);
  508. RecNo := 15;
  509. CheckEquals(15,fields[0].AsInteger);
  510. CheckEquals(15,RecNo);
  511. // test for exceptions...
  512. { RecNo := 16;
  513. CheckEquals(15,fields[0].AsInteger);
  514. CheckEquals(15,RecNo);}
  515. Close;
  516. end;
  517. end;
  518. procedure TTestCursorDBBasics.TestRequired;
  519. begin
  520. with DBConnector.GetNDataset(2) do
  521. begin
  522. Open;
  523. FieldByName('ID').Required := True;
  524. Append;
  525. CheckException(Post, EDatabaseError);
  526. FieldByName('ID').AsInteger := 1000;
  527. Post;
  528. Close;
  529. end;
  530. end;
  531. procedure TTestDBBasics.TestExceptionLocateClosed;
  532. var passed: boolean;
  533. begin
  534. with DBConnector.GetNDataset(15) do
  535. begin
  536. passed := false;
  537. try
  538. locate('name','TestName1',[]);
  539. except on E: Exception do
  540. begin
  541. passed := E.classname = EDatabaseError.className
  542. end;
  543. end;
  544. CheckTrue(passed);
  545. end;
  546. end;
  547. procedure TTestCursorDBBasics.TestModified;
  548. begin
  549. // Tests TDataSet.Modified property
  550. with DBConnector.GetNDataset(true,1) as TDataset do
  551. begin
  552. Open;
  553. CheckFalse(Modified);
  554. Edit;
  555. CheckFalse(Modified, 'After Edit');
  556. Fields[1].AsString := Fields[1].AsString;
  557. CheckTrue(Modified, 'After change');
  558. Post;
  559. CheckFalse(Modified, 'After Post');
  560. Append;
  561. CheckFalse(Modified, 'After Append');
  562. Fields[0].AsInteger := 100;
  563. CheckTrue(Modified, 'After change');
  564. Cancel;
  565. CheckFalse(Modified, 'After Cancel');
  566. Close;
  567. end;
  568. end;
  569. procedure TTestDBBasics.TestDetectionNonMatchingDataset;
  570. var
  571. F: TField;
  572. ds: tdataset;
  573. begin
  574. // TDataset.Bindfields should detect problems when the underlying data does
  575. // not reflect the fields of the dataset. This test is to check if this is
  576. // really done.
  577. ds := DBConnector.GetNDataset(true,6);
  578. with ds do
  579. begin
  580. open;
  581. close;
  582. F := TStringField.Create(ds);
  583. F.FieldName:='DOES_NOT_EXIST';
  584. F.DataSet:=ds;
  585. F.Size:=50;
  586. CheckException(open,EDatabaseError);
  587. end;
  588. end;
  589. procedure TTestCursorDBBasics.TestAppendInsertRecord;
  590. begin
  591. with DBConnector.GetNDataset(true,6) do
  592. begin
  593. open;
  594. // InsertRecord should insert a record, set the values, post the record and
  595. // make the new record active.
  596. InsertRecord([152,'TestInsRec']);
  597. CheckEquals(152,fields[0].AsInteger);
  598. CheckEquals('TestInsRec',fields[1].AsString);
  599. CheckTrue(state=dsBrowse);
  600. // AppendRecord should append a record, further the same as InsertRecord
  601. AppendRecord([151,'TestInsRec']);
  602. CheckEquals(151,fields[0].AsInteger);
  603. CheckEquals('TestInsRec',fields[1].AsString);
  604. CheckTrue(state=dsBrowse);
  605. next;
  606. CheckTrue(EOF);
  607. end;
  608. end;
  609. procedure TTestCursorDBBasics.TestBookmarks;
  610. var BM1,BM2,BM3,BM4,BM5 : TBookmark;
  611. begin
  612. with DBConnector.GetNDataset(true,14) do
  613. begin
  614. {$ifdef fpc}
  615. AssertNull(GetBookmark);
  616. {$endif fpc}
  617. open;
  618. BM1:=GetBookmark; // id=1, BOF
  619. next;next;
  620. BM2:=GetBookmark; // id=3
  621. next;next;next;
  622. BM3:=GetBookmark; // id=6
  623. next;next;next;next;next;next;next;next;
  624. BM4:=GetBookmark; // id=14
  625. next;
  626. BM5:=GetBookmark; // id=14, EOF
  627. GotoBookmark(BM2);
  628. CheckEquals(3,FieldByName('id').AsInteger);
  629. GotoBookmark(BM1);
  630. CheckEquals(1,FieldByName('id').AsInteger);
  631. GotoBookmark(BM3);
  632. CheckEquals(6,FieldByName('id').AsInteger);
  633. GotoBookmark(BM4);
  634. CheckEquals(14,FieldByName('id').AsInteger);
  635. GotoBookmark(BM3);
  636. CheckEquals(6,FieldByName('id').AsInteger);
  637. GotoBookmark(BM5);
  638. CheckEquals(14,FieldByName('id').AsInteger);
  639. GotoBookmark(BM1);
  640. CheckEquals(1,FieldByName('id').AsInteger);
  641. next;
  642. delete;
  643. GotoBookmark(BM2);
  644. CheckEquals(3,FieldByName('id').AsInteger,'After #2 deleted');
  645. delete;delete;
  646. GotoBookmark(BM3);
  647. CheckEquals(6,FieldByName('id').AsInteger);
  648. GotoBookmark(BM1);
  649. CheckEquals(1,FieldByName('id').AsInteger);
  650. insert;
  651. fieldbyname('id').AsInteger:=20;
  652. insert;
  653. fieldbyname('id').AsInteger:=21;
  654. insert;
  655. fieldbyname('id').AsInteger:=22;
  656. insert;
  657. fieldbyname('id').AsInteger:=23;
  658. post;
  659. GotoBookmark(BM3);
  660. CheckEquals(6,FieldByName('id').AsInteger);
  661. GotoBookmark(BM1);
  662. CheckEquals(1,FieldByName('id').AsInteger);
  663. GotoBookmark(BM5);
  664. CheckEquals(14,FieldByName('id').AsInteger);
  665. end;
  666. end;
  667. procedure TTestCursorDBBasics.TestBookmarkValid;
  668. var BM1,BM2,BM3,BM4,BM5 : TBookmark;
  669. begin
  670. with DBConnector.GetNDataset(true,14) do
  671. begin
  672. BM1 := Nil;
  673. CheckFalse(BookmarkValid(BM1));
  674. open;
  675. BM1:=GetBookmark; // id=1, BOF
  676. CheckTrue(BookmarkValid(BM1));
  677. next;next;
  678. BM2:=GetBookmark; // id=3
  679. CheckTrue(BookmarkValid(BM2));
  680. next;next;next;
  681. BM3:=GetBookmark; // id=6
  682. CheckTrue(BookmarkValid(BM3));
  683. next;next;next;next;next;next;next;next;
  684. BM4:=GetBookmark; // id=14
  685. CheckTrue(BookmarkValid(BM4));
  686. next;
  687. BM5:=GetBookmark; // id=14, EOF
  688. CheckTrue(BookmarkValid(BM5));
  689. CheckTrue(BookmarkValid(BM4));
  690. CheckTrue(BookmarkValid(BM3));
  691. CheckTrue(BookmarkValid(BM2));
  692. CheckTrue(BookmarkValid(BM1));
  693. GotoBookmark(BM2);
  694. CheckTrue(BookmarkValid(BM5));
  695. CheckTrue(BookmarkValid(BM4));
  696. CheckTrue(BookmarkValid(BM3));
  697. CheckTrue(BookmarkValid(BM2));
  698. CheckTrue(BookmarkValid(BM1));
  699. end;
  700. end;
  701. procedure TTestCursorDBBasics.TestLocate;
  702. begin
  703. with DBConnector.GetNDataset(true,13) do
  704. begin
  705. open;
  706. CheckTrue(Locate('id',3,[]));
  707. CheckTrue(Locate('id',vararrayof([5]),[]));
  708. CheckEquals(5,FieldByName('id').AsInteger);
  709. CheckFalse(Locate('id',vararrayof([15]),[]));
  710. CheckTrue(Locate('id',vararrayof([13]),[]));
  711. CheckEquals(13,FieldByName('id').AsInteger);
  712. close;
  713. open;
  714. CheckTrue(Locate('id',vararrayof([12]),[]));
  715. CheckEquals(12,FieldByName('id').AsInteger);
  716. CheckTrue(Locate('id;name',vararrayof([4,'TestName4']),[]));
  717. CheckEquals(4,FieldByName('id').AsInteger);
  718. CheckFalse(Locate('id;name',vararrayof([4,'TestName5']),[]));
  719. end;
  720. end;
  721. procedure TTestCursorDBBasics.TestLocateCaseIns;
  722. // Tests case insensitive locate, also partial key locate, both against string fields.
  723. // Together with TestLocateCaseInsInts, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use
  724. begin
  725. with DBConnector.GetNDataset(true,13) do
  726. begin
  727. open;
  728. CheckFalse(Locate('name',vararrayof(['TEstName5']),[]));
  729. CheckTrue(Locate('name',vararrayof(['TEstName5']),[loCaseInsensitive]));
  730. CheckEquals(5,FieldByName('id').AsInteger);
  731. CheckFalse(Locate('name',vararrayof(['TestN']),[]));
  732. CheckTrue(Locate('name',vararrayof(['TestN']),[loPartialKey]));
  733. CheckFalse(Locate('name',vararrayof(['TestNA']),[loPartialKey]));
  734. CheckTrue(Locate('name',vararrayof(['TestNA']),[loPartialKey, loCaseInsensitive]));
  735. close;
  736. end;
  737. end;
  738. procedure TTestCursorDBBasics.TestLocateCaseInsInts;
  739. // Tests case insensitive locate, also partial key locate, both against integer fields.
  740. // Together with TestLocateCaseIns, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use
  741. begin
  742. with DBConnector.GetNDataset(true,13) do
  743. begin
  744. open;
  745. // To really test bug 23509: we should first have a record that matches greater than for non-string locate:
  746. first;
  747. insert;
  748. fieldbyname('id').AsInteger:=55;
  749. fieldbyname('name').AsString:='TestName55';
  750. post;
  751. first;
  752. CheckTrue(Locate('id',vararrayof([5]),[]));
  753. CheckEquals(5,FieldByName('id').AsInteger);
  754. first;
  755. CheckTrue(Locate('id',vararrayof([5]),[loCaseInsensitive]));
  756. CheckEquals(5,FieldByName('id').AsInteger);
  757. first;
  758. // Check specifying partial key doesn't influence search results
  759. CheckTrue(Locate('id',vararrayof([5]),[loPartialKey]));
  760. CheckEquals(5,FieldByName('id').AsInteger);
  761. first;
  762. CheckTrue(Locate('id',vararrayof([5]),[loPartialKey, loCaseInsensitive]));
  763. CheckEquals(5,FieldByName('id').AsInteger);
  764. close;
  765. end;
  766. end;
  767. procedure TTestCursorDBBasics.TestLookup;
  768. var v: variant;
  769. begin
  770. // Lookup doesn't move the record pointer of the dataset
  771. // and no scroll events should be generated (only OnCalcFields when matched record is found)
  772. with DBConnector.GetNDataset(13) do
  773. begin
  774. Open;
  775. Next;
  776. CheckEquals('TestName5', Lookup('id',5,'name'));
  777. CheckTrue(Lookup('id',15,'name')=Null);
  778. v:=Lookup('id',7,'id;name');
  779. CheckEquals(7, v[0]);
  780. CheckEquals('TestName7', v[1]);
  781. // Lookup shouldn't change current record
  782. CheckEquals(2, FieldByName('id').AsInteger);
  783. Close;
  784. end;
  785. end;
  786. procedure TTestCursorDBBasics.TestFieldOldValueObsolete;
  787. var v : variant;
  788. ds: TDataset;
  789. begin
  790. // this test was created as reaction to AV bug found in TCustomBufDataset.GetFieldData
  791. // when retrieving OldValue (State=dsOldValue) of newly inserted or appended record.
  792. // In this case was CurrBuff set to nil (and not checked),
  793. // because OldValuesBuffer for just inserted record is nil. See rev.17704
  794. // (So purpose of this test isn't test InsertRecord on empty dataset or so)
  795. // Later was this test replaced by more complex TestOldValue (superset of old test),
  796. // but next to it was restored back also original test.
  797. // So now we have two tests which test same thing, where this 'old' one is subset of 'new' one
  798. // Ideal solution would be remove this 'old' test as it does not test anything what is not tested elsewhere ...
  799. ds := DBConnector.GetNDataset(0) as TDataset;
  800. ds.Open;
  801. ds.InsertRecord([0,'name']);
  802. v := VarToStr(ds.Fields[1].OldValue);
  803. end;
  804. procedure TTestCursorDBBasics.TestFieldOldValue;
  805. var ds: TDataSet;
  806. OldValue: string;
  807. Fmemo: TField;
  808. begin
  809. ds := DBConnector.GetFieldDataset;
  810. with ds do
  811. begin;
  812. Open;
  813. First;
  814. Next;
  815. OldValue := Fields[0].AsString;
  816. CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Original value'); // unmodified original value
  817. CheckTrue(UpdateStatus=usUnmodified, 'Unmodified');
  818. Edit;
  819. Fields[0].AsInteger := -1;
  820. CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Editing'); // dsEdit, there is no update-buffer yet
  821. Post;
  822. CheckEquals(OldValue, VarToStr(Fields[0].OldValue), 'Edited'); // there is already update-buffer
  823. CheckTrue(UpdateStatus=usModified, 'Modified');
  824. Append;
  825. Fields[0].AsInteger := -2;
  826. CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserting'); // dsInsert, there is no update-buffer yet
  827. Post;
  828. CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserted'); // there is already update-buffer
  829. CheckTrue(UpdateStatus=usInserted, 'Inserted');
  830. // Blobs are stored in a special way
  831. // Use TMemoField because it implements AsVariant as AsString
  832. First;
  833. Next;
  834. Fmemo := FieldByName('F'+FieldTypeNames[ftMemo]);
  835. OldValue := Fmemo.AsString;
  836. CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue');
  837. Edit;
  838. Fmemo.AsString := 'Changed Memo value';
  839. CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue before Post');
  840. Post;
  841. CheckEquals(OldValue, Fmemo.OldValue, 'Memo.OldValue after Post');
  842. end;
  843. if ds is TCustomBufDataset then
  844. with ds as TCustomBufDataset do
  845. begin
  846. MergeChangeLog;
  847. CheckEquals('Changed Memo value', Fmemo.OldValue, 'Memo.OldValue after MergeChangeLog');
  848. end;
  849. end;
  850. procedure TTestCursorDBBasics.TestChangeBlobFieldBeforePost;
  851. // Edit memo fields should read back new contents even before post
  852. // Bug 15376
  853. // See also TTestFieldTypes.TestChangeBlob
  854. var
  855. Fmemo: TField;
  856. begin
  857. with DBConnector.GetFieldDataset do
  858. begin
  859. Open;
  860. Append;
  861. FieldByName('ID').AsInteger := -1; // Required - not null
  862. Fmemo := FieldByName('FMEMO');
  863. CheckTrue(Fmemo.IsNull, 'IsNull after Append');
  864. Fmemo.AsString:='MEMO1';
  865. CheckFalse(Fmemo.IsNull, 'IsNull after change');
  866. CheckEquals('MEMO1', Fmemo.AsString);
  867. Fmemo.Clear;
  868. CheckTrue(Fmemo.IsNull, 'IsNull after Clear');
  869. Fmemo.AsString:='MEMO2';
  870. CheckEquals('MEMO2', Fmemo.AsString);
  871. Fmemo.AsString:='';
  872. CheckTrue(Fmemo.IsNull, 'IsNull');
  873. Fmemo.AsString:='MEMO3';
  874. CheckEquals('MEMO3', Fmemo.AsString);
  875. Post;
  876. CheckEquals('MEMO3', Fmemo.AsString);
  877. Close;
  878. end;
  879. end;
  880. procedure TTestDBBasics.TestSetFieldValues;
  881. var PassException : boolean;
  882. begin
  883. with DBConnector.GetNDataset(true,11) do
  884. begin
  885. open;
  886. // First and Next methods are supported by UniDirectional datasets
  887. first;
  888. if IsUniDirectional then
  889. CheckException(Edit, EDatabaseError)
  890. else
  891. begin
  892. edit;
  893. FieldValues['id']:=5;
  894. post;
  895. CheckEquals('TestName1',FieldByName('name').AsString);
  896. CheckEquals(5,FieldByName('id').AsInteger);
  897. edit;
  898. FieldValues['name']:='FieldValuesTestName';
  899. post;
  900. CheckEquals('FieldValuesTestName',FieldByName('name').AsString);
  901. CheckEquals(5,FieldByName('id').AsInteger);
  902. edit;
  903. FieldValues['id;name']:= VarArrayOf([243,'ValuesTestName']);
  904. post;
  905. CheckEquals('ValuesTestName',FieldByName('name').AsString);
  906. CheckEquals(243,FieldByName('id').AsInteger);
  907. PassException:=false;
  908. try
  909. edit;
  910. FieldValues['id;name;fake']:= VarArrayOf([243,'ValuesTestName',4]);
  911. except
  912. on E: EDatabaseError do PassException := True;
  913. end;
  914. post;
  915. CheckTrue(PassException);
  916. end;
  917. end;
  918. end;
  919. procedure TTestDBBasics.TestGetFieldValues;
  920. var AVar : Variant;
  921. PassException : boolean;
  922. begin
  923. with DBConnector.GetNDataset(true,14) do
  924. begin
  925. open;
  926. AVar:=FieldValues['id'];
  927. CheckEquals(AVar,1);
  928. AVar:=FieldValues['name'];
  929. CheckEquals(AVar,'TestName1');
  930. AVar:=FieldValues['id;name'];
  931. CheckEquals(AVar[0],1);
  932. CheckEquals(AVar[1],'TestName1');
  933. AVar:=FieldValues['name;id;'];
  934. CheckEquals(AVar[1],1);
  935. CheckEquals(AVar[0],'TestName1');
  936. PassException:=false;
  937. try
  938. AVar:=FieldValues['name;id;fake'];
  939. except
  940. on E: EDatabaseError do PassException := True;
  941. end;
  942. CheckTrue(PassException);
  943. end;
  944. end;
  945. procedure TTestCursorDBBasics.TestDelete1;
  946. begin
  947. FTestDelete1(false);
  948. end;
  949. procedure TTestCursorDBBasics.TestDelete2;
  950. begin
  951. FTestDelete2(false);
  952. end;
  953. procedure TTestCursorDBBasics.TestCancelUpdDelete1;
  954. begin
  955. FTestDelete1(true);
  956. end;
  957. procedure TTestCursorDBBasics.TestCancelUpdDelete2;
  958. begin
  959. FTestDelete2(true);
  960. end;
  961. procedure TTestCursorDBBasics.FTestDelete1(TestCancelUpdate : boolean);
  962. // Test the deletion of records, including the first and the last one
  963. var i : integer;
  964. ds : TDataset;
  965. begin
  966. ds := DBConnector.GetNDataset(true,17);
  967. with ds do
  968. begin
  969. Open;
  970. for i := 0 to 16 do if i mod 4=0 then
  971. delete
  972. else
  973. next;
  974. First;
  975. for i := 0 to 16 do
  976. begin
  977. if i mod 4<>0 then
  978. begin
  979. CheckEquals(i+1,FieldByName('ID').AsInteger);
  980. CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
  981. next;
  982. end;
  983. end;
  984. end;
  985. {$ifdef fpc}
  986. if TestCancelUpdate then
  987. begin
  988. if not (ds is TCustomBufDataset) then
  989. Ignore('This test only applies to TCustomBufDataset and descendents.');
  990. with TCustomBufDataset(ds) do
  991. begin
  992. CancelUpdates;
  993. First;
  994. for i := 0 to 16 do
  995. begin
  996. CheckEquals(i+1,FieldByName('ID').AsInteger);
  997. CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
  998. next;
  999. end;
  1000. close;
  1001. end;
  1002. end;
  1003. {$endif}
  1004. end;
  1005. procedure TTestCursorDBBasics.FTestDelete2(TestCancelUpdate : boolean);
  1006. // Test the deletion of edited and appended records
  1007. var i : integer;
  1008. ds : TDataset;
  1009. begin
  1010. ds := DBConnector.GetNDataset(true,17);
  1011. with ds do
  1012. begin
  1013. Open;
  1014. for i := 0 to 16 do
  1015. begin
  1016. if i mod 4=0 then
  1017. begin
  1018. edit;
  1019. fieldbyname('name').AsString:='this record will be gone soon';
  1020. post;
  1021. end;
  1022. next;
  1023. end;
  1024. for i := 17 to 20 do
  1025. begin
  1026. append;
  1027. fieldbyname('id').AsInteger:=i+1;
  1028. fieldbyname('name').AsString:='TestName'+inttostr(i+1);
  1029. post;
  1030. end;
  1031. first;
  1032. for i := 0 to 20 do if i mod 4=0 then
  1033. delete
  1034. else
  1035. next;
  1036. First;
  1037. i := 0;
  1038. for i := 0 to 20 do
  1039. begin
  1040. if i mod 4<>0 then
  1041. begin
  1042. CheckEquals(i+1,FieldByName('ID').AsInteger);
  1043. CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
  1044. next;
  1045. end;
  1046. end;
  1047. end;
  1048. {$ifdef fpc}
  1049. if TestCancelUpdate then
  1050. begin
  1051. if not (ds is TCustomBufDataset) then
  1052. Ignore('This test only applies to TCustomBufDataset and descendents.');
  1053. with TCustomBufDataset(ds) do
  1054. begin
  1055. CancelUpdates;
  1056. First;
  1057. for i := 0 to 16 do
  1058. begin
  1059. CheckEquals(i+1,FieldByName('ID').AsInteger);
  1060. CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString);
  1061. next;
  1062. end;
  1063. close;
  1064. end;
  1065. end;
  1066. {$endif fpc}
  1067. end;
  1068. procedure TTestCursorDBBasics.TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean);
  1069. var
  1070. a : TDataSetState;
  1071. begin
  1072. Accept := odd(Dataset.FieldByName('ID').AsInteger);
  1073. end;
  1074. procedure TTestCursorDBBasics.TestOnFilter;
  1075. // Tests OnFilterRecord filtering
  1076. var
  1077. Counter : byte;
  1078. begin
  1079. with DBConnector.GetNDataset(15) do
  1080. begin
  1081. OnFilterRecord := TestOnFilterProc;
  1082. Filtered := True;
  1083. Open;
  1084. for Counter := 1 to 8 do
  1085. begin
  1086. CheckTrue(odd(FieldByName('ID').asinteger));
  1087. next;
  1088. end;
  1089. CheckTrue(EOF);
  1090. end;
  1091. end;
  1092. procedure TTestCursorDBBasics.TestIntFilter;
  1093. // Tests an integer range filter expression
  1094. var
  1095. Counter : byte;
  1096. begin
  1097. with DBConnector.GetNDataset(15) do
  1098. begin
  1099. Filtered := True;
  1100. Filter := '(id>4) and (id<9)';
  1101. Open;
  1102. for Counter := 5 to 8 do
  1103. begin
  1104. CheckEquals(Counter, FieldByName('ID').AsInteger);
  1105. Next;
  1106. end;
  1107. CheckTrue(EOF);
  1108. Filter := '-id-ID=-4';
  1109. CheckEquals(2, FieldByName('ID').AsInteger, 'Unary minus');
  1110. Next;
  1111. CheckTrue(EOF, 'Unary minus');
  1112. Close;
  1113. end;
  1114. end;
  1115. procedure TTestCursorDBBasics.TestNegativeIntFilter;
  1116. // Tests a negative integer range filter expression
  1117. var
  1118. Counter : integer;
  1119. begin
  1120. with DBConnector.GetNDataset(15) do
  1121. begin
  1122. // Change ID values to -1..-15 instead of positive
  1123. Open;
  1124. while not(EOF) do
  1125. begin
  1126. Edit;
  1127. FieldByName('ID').AsInteger:=
  1128. -1*(FieldByname('ID').AsInteger);
  1129. Post;
  1130. Next;
  1131. end;
  1132. // Regular filter with negative integer values
  1133. Filtered := True;
  1134. Filter := '(id>-9) and (id<-4)';
  1135. First;
  1136. for Counter := -5 downto -8 do
  1137. begin
  1138. CheckEquals(Counter,FieldByName('ID').AsInteger);
  1139. Next;
  1140. end;
  1141. CheckTrue(EOF);
  1142. // Filter with negative integer values and subtraction calculations
  1143. Filtered := True;
  1144. Filter := '(id>(-8-1)) and (id<(-3-1))';
  1145. First;
  1146. for Counter := -5 downto -8 do
  1147. begin
  1148. CheckEquals(Counter,FieldByName('ID').AsInteger);
  1149. Next;
  1150. end;
  1151. CheckTrue(EOF);
  1152. Close;
  1153. end;
  1154. end;
  1155. procedure TTestCursorDBBasics.TestStringFilter;
  1156. // Tests string expression filters
  1157. var
  1158. Counter : byte;
  1159. begin
  1160. with DBConnector.GetNDataset(15) do
  1161. begin
  1162. Open;
  1163. // Check equality
  1164. Filter := '(name=''TestName3'')';
  1165. Filtered := True;
  1166. CheckFalse(EOF, 'Simple equality');
  1167. CheckEquals(3,FieldByName('ID').asinteger,'Simple equality');
  1168. CheckEquals('TestName3',FieldByName('NAME').asstring,'Simple equality');
  1169. next;
  1170. CheckTrue(EOF,'Simple equality');
  1171. // Check partial compare
  1172. Filter := '(name=''*Name5'')';
  1173. CheckFalse(EOF, 'Partial compare');
  1174. CheckEquals(5,FieldByName('ID').asinteger,'Partial compare');
  1175. CheckEquals('TestName5',FieldByName('NAME').asstring,'Partial compare');
  1176. next;
  1177. CheckTrue(EOF,'Partial compare');
  1178. // Check case-sensitivity
  1179. Filter := '(name=''*name3'')';
  1180. first;
  1181. CheckTrue(EOF,'Case-sensitive search');
  1182. FilterOptions:=[foCaseInsensitive];
  1183. Filter := '(name=''testname3'')';
  1184. first;
  1185. CheckFalse(EOF,'Case-insensitive search');
  1186. CheckEquals(3,FieldByName('ID').asinteger,'Case-insensitive search');
  1187. CheckEquals('TestName3',FieldByName('NAME').asstring,'Case-insensitive search');
  1188. next;
  1189. CheckTrue(EOF);
  1190. // Check case-insensitive partial compare
  1191. Filter := '(name=''*name3'')';
  1192. first;
  1193. CheckFalse(EOF, 'Case-insensitive partial compare');
  1194. CheckEquals(3,FieldByName('ID').asinteger, 'Case-insensitive partial compare');
  1195. CheckEquals('TestName3',FieldByName('NAME').asstring, 'Case-insensitive partial compare');
  1196. next;
  1197. CheckTrue(EOF);
  1198. // Multiple records with partial compare
  1199. Filter := '(name=''*name*'')';
  1200. first;
  1201. CheckFalse(EOF,'Partial compare multiple records');
  1202. CheckEquals(1,FieldByName('ID').asinteger,'Partial compare multiple records');
  1203. CheckEquals('TestName1',FieldByName('NAME').asstring,'Partial compare multiple records');
  1204. next;
  1205. CheckFalse(EOF,'Partial compare multiple records');
  1206. CheckEquals(2,FieldByName('ID').asinteger,'Partial compare multiple records');
  1207. CheckEquals('TestName2',FieldByName('NAME').asstring,'Partial compare multiple records');
  1208. // Invalid data with partial compare
  1209. Filter := '(name=''*neme*'')';
  1210. first;
  1211. CheckTrue(EOF,'Invalid data, partial compare');
  1212. // Multiple string filters
  1213. Filter := '(name=''*a*'') and (name=''*m*'')';
  1214. first;
  1215. CheckFalse(EOF,'Multiple string filters');
  1216. CheckEquals(1,FieldByName('ID').asinteger,'Multiple string filters');
  1217. CheckEquals('TestName1',FieldByName('NAME').asstring,'Multiple string filters');
  1218. next;
  1219. CheckFalse(EOF,'Multiple string filters');
  1220. CheckEquals(2,FieldByName('ID').asinteger,'Multiple string filters');
  1221. CheckEquals('TestName2',FieldByName('NAME').asstring,'Multiple string filters');
  1222. // Modify so we can use some tricky data
  1223. Filter := ''; //show all records again and allow edits
  1224. First;
  1225. Edit;
  1226. // Record 1=O'Malley
  1227. FieldByName('NAME').AsString := 'O''Malley';
  1228. Post;
  1229. Next;
  1230. Edit;
  1231. // Record 2="Magic" Mushroom
  1232. FieldByName('NAME').AsString := '"Magic" Mushroom';
  1233. Post;
  1234. Next;
  1235. Edit;
  1236. // Record 3=O'Malley's "Magic" Mushroom
  1237. FieldByName('NAME').AsString := 'O''Malley''s "Magic" Mushroom';
  1238. Post;
  1239. // Test searching on " which can be a delimiter
  1240. Filter := '(name=''*"Magic"*'')'; //should give record 2 and 3
  1241. first;
  1242. CheckFalse(EOF);
  1243. CheckEquals(2,FieldByName('ID').asinteger,'Search for strings with ", partial compare');
  1244. CheckEquals('"Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with ", partial compare');
  1245. next;
  1246. CheckFalse(EOF);
  1247. CheckEquals(3,FieldByName('ID').asinteger,'Search for strings with ", partial compare');
  1248. CheckEquals('O''Malley''s "Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with ", partial compare');
  1249. // Search for strings with ' escaped, partial compare delimited by '
  1250. Filter := '(name=''O''''Malley*'')'; //should give record 1 and 3
  1251. first;
  1252. CheckFalse(EOF);
  1253. CheckEquals(1,FieldByName('ID').asinteger,'Search for strings with '' escaped, partial compare delimited by ''');
  1254. CheckEquals('O''Malley',FieldByName('NAME').asstring,'Search for strings with '' escaped, partial compare delimited by ''');
  1255. next;
  1256. CheckFalse(EOF);
  1257. CheckEquals(3,FieldByName('ID').asinteger,'Search for strings with '' escaped, partial compare delimited by ''');
  1258. CheckEquals('O''Malley''s "Magic" Mushroom',FieldByName('NAME').asstring,'Search for strings with '' escaped, partial compare delimited by ''');
  1259. Close;
  1260. end;
  1261. end;
  1262. {$ifdef fpc}
  1263. procedure TTestBufDatasetDBBasics.TestIsEmpty;
  1264. begin
  1265. with DBConnector.GetNDataset(True,1) as TCustomBufDataset do
  1266. begin
  1267. open;
  1268. delete;
  1269. Resync([]);
  1270. ApplyUpdates;
  1271. CheckTrue(IsEmpty);
  1272. end;
  1273. end;
  1274. procedure TTestBufDatasetDBBasics.TestSaveAsXML;
  1275. var ds : TDataset;
  1276. LoadDs: TCustomBufDataset;
  1277. begin
  1278. ds := DBConnector.GetNDataset(true,5);
  1279. ds.open;
  1280. TCustomBufDataset(ds).SaveToFile('test.xml');
  1281. ds.close;
  1282. LoadDs := TCustomBufDataset.Create(nil);
  1283. try
  1284. LoadDs.LoadFromFile('test.xml');
  1285. FTestXMLDatasetDefinition(LoadDS);
  1286. finally
  1287. LoadDS.free;
  1288. end;
  1289. end;
  1290. procedure TTestBufDatasetDBBasics.TestFileNameProperty;
  1291. var ds1,ds2: TDataset;
  1292. LoadDs: TCustomBufDataset;
  1293. begin
  1294. ds2 := nil;
  1295. ds1 := DBConnector.GetNDataset(true,5);
  1296. try
  1297. ds1.open;
  1298. TCustomBufDataset(ds1).FileName:='test.xml';
  1299. ds1.close;
  1300. ds2 := DBConnector.GetNDataset(True,7);
  1301. TCustomBufDataset(ds2).FileName:='test.xml';
  1302. ds2.Open;
  1303. FTestXMLDatasetDefinition(Ds2);
  1304. finally
  1305. TCustomBufDataset(ds1).FileName:='';
  1306. if assigned(ds2) then
  1307. TCustomBufDataset(ds2).FileName:='';
  1308. end;
  1309. end;
  1310. procedure TTestBufDatasetDBBasics.TestClientDatasetAsMemDataset;
  1311. var ds : TCustomBufDataset;
  1312. i : integer;
  1313. begin
  1314. ds := TCustomBufDataset.Create(nil);
  1315. try
  1316. DS.FieldDefs.Add('ID',ftInteger);
  1317. DS.FieldDefs.Add('NAME',ftString,50);
  1318. DS.CreateDataset;
  1319. DS.Open;
  1320. for i := 1 to 10 do
  1321. begin
  1322. ds.Append;
  1323. ds.FieldByName('ID').AsInteger := i;
  1324. ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
  1325. DS.Post;
  1326. end;
  1327. ds.first;
  1328. for i := 1 to 10 do
  1329. begin
  1330. CheckEquals(i,ds.fieldbyname('ID').asinteger);
  1331. CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString);
  1332. ds.next;
  1333. end;
  1334. CheckTrue(ds.EOF);
  1335. DS.Close;
  1336. finally
  1337. ds.Free;
  1338. end;
  1339. end;
  1340. procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd;
  1341. var i : byte;
  1342. begin
  1343. with DBConnector.GetNDataset(5) as TCustomBufDataset do
  1344. begin
  1345. open;
  1346. next;
  1347. next;
  1348. edit;
  1349. FieldByName('name').AsString := 'changed';
  1350. post;
  1351. next;
  1352. delete;
  1353. CancelUpdates;
  1354. First;
  1355. for i := 1 to 5 do
  1356. begin
  1357. CheckEquals(i,fields[0].AsInteger);
  1358. CheckEquals('TestName'+inttostr(i),fields[1].AsString);
  1359. Next;
  1360. end;
  1361. end;
  1362. end;
  1363. procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd1;
  1364. var i : byte;
  1365. begin
  1366. with DBConnector.GetNDataset(5) as TCustomBufDataset do
  1367. begin
  1368. open;
  1369. next;
  1370. next;
  1371. delete;
  1372. insert;
  1373. FieldByName('id').AsInteger := 100;
  1374. post;
  1375. CancelUpdates;
  1376. last;
  1377. for i := 5 downto 1 do
  1378. begin
  1379. CheckEquals(i,fields[0].AsInteger);
  1380. CheckEquals('TestName'+inttostr(i),fields[1].AsString);
  1381. Prior;
  1382. end;
  1383. end;
  1384. end;
  1385. procedure TTestBufDatasetDBBasics.TestMultipleDeleteUpdateBuffer;
  1386. var ds : TDataset;
  1387. begin
  1388. ds := DBConnector.GetNDataset(true,5);
  1389. ds.open;
  1390. with TCustomBufDataset(ds) do
  1391. begin
  1392. CheckEquals(0,ChangeCount);
  1393. edit;
  1394. fieldbyname('id').asinteger := 500;
  1395. fieldbyname('name').AsString := 'JoJo';
  1396. post;
  1397. CheckEquals(1,ChangeCount);
  1398. next; next;
  1399. Delete;
  1400. CheckEquals(2,ChangeCount);
  1401. Delete;
  1402. CheckEquals(3,ChangeCount);
  1403. CancelUpdates;
  1404. end;
  1405. ds.close;
  1406. end;
  1407. procedure TTestBufDatasetDBBasics.TestDoubleDelete;
  1408. var ds : TCustomBufDataset;
  1409. begin
  1410. ds := TCustomBufDataset(DBConnector.GetNDataset(true,5));
  1411. with ds do
  1412. begin
  1413. open;
  1414. next; next;
  1415. Delete;
  1416. Delete;
  1417. first;
  1418. CheckEquals(1,fieldbyname('id').AsInteger);
  1419. next;
  1420. CheckEquals(2,fieldbyname('id').AsInteger);
  1421. next;
  1422. CheckEquals(5,fieldbyname('id').AsInteger);
  1423. CancelUpdates;
  1424. first;
  1425. CheckEquals(1,fieldbyname('id').AsInteger);
  1426. next;
  1427. CheckEquals(2,fieldbyname('id').AsInteger);
  1428. next;
  1429. CheckEquals(3,fieldbyname('id').AsInteger);
  1430. next;
  1431. CheckEquals(4,fieldbyname('id').AsInteger);
  1432. next;
  1433. CheckEquals(5,fieldbyname('id').AsInteger);
  1434. end;
  1435. end;
  1436. procedure TTestBufDatasetDBBasics.TestReadOnly;
  1437. var
  1438. ds: TCustomBufDataset;
  1439. begin
  1440. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1441. with ds do
  1442. begin
  1443. ReadOnly:=true;
  1444. CheckFalse(CanModify);
  1445. end;
  1446. end;
  1447. procedure TTestBufDatasetDBBasics.TestMergeChangeLog;
  1448. var
  1449. ds: TCustomBufDataset;
  1450. i: integer;
  1451. s, FN: string;
  1452. begin
  1453. ds := DBConnector.GetNDataset(5) as TCustomBufDataset;
  1454. with ds do
  1455. begin
  1456. open;
  1457. Edit;
  1458. i := fields[0].AsInteger;
  1459. s := fields[1].AsString;
  1460. fields[0].AsInteger:=64;
  1461. fields[1].AsString:='Changed1';
  1462. Post;
  1463. checkequals(fields[0].OldValue,i);
  1464. checkequals(fields[1].OldValue,s);
  1465. CheckEquals(ChangeCount,1);
  1466. Next;
  1467. Edit;
  1468. i := fields[0].AsInteger;
  1469. s := fields[1].AsString;
  1470. fields[0].AsInteger:=23;
  1471. fields[1].AsString:='Changed2';
  1472. Post;
  1473. checkequals(fields[0].OldValue,i);
  1474. checkequals(fields[1].OldValue,s);
  1475. CheckEquals(ChangeCount,2);
  1476. MergeChangeLog;
  1477. CheckEquals(ChangeCount,0);
  1478. checkequals(fields[0].OldValue,23);
  1479. checkequals(fields[1].OldValue,'Changed2');
  1480. end;
  1481. // Test handling of [Update]BlobBuffers in TBufDataset
  1482. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1483. with ds do
  1484. begin
  1485. // Testing scenario: read some records, so blob data are added into FBlobBuffers,
  1486. // then update blob field, so element is added to FUpdateBlobBuffers, then read again some records
  1487. // so next elements are added to FBlobBuffers, then again update blob field
  1488. // DefaultBufferCount is 10
  1489. PacketRecords:=1;
  1490. Open;
  1491. FN := 'F'+FieldTypeNames[ftBlob];
  1492. First; Edit; FieldByName(FN).AsString:='b01'; Post;
  1493. RecNo:=11; Edit; FieldByName(FN).AsString:='b11'; Post;
  1494. Next ; Edit; FieldByName(FN).AsString:='b12'; Post;
  1495. Last;
  1496. MergeChangeLog;
  1497. First; CheckEquals('b01', FieldByName(FN).AsString);
  1498. RecNo:=11; CheckEquals('b11', FieldByName(FN).AsString);
  1499. Next; CheckEquals('b12', FieldByName(FN).AsString);
  1500. end;
  1501. end;
  1502. procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset);
  1503. var i : integer;
  1504. begin
  1505. CheckEquals(2,ADataset.FieldDefs.Count);
  1506. CheckEquals(2,ADataset.Fields.Count);
  1507. CheckTrue(SameText('ID',ADataset.Fields[0].FieldName));
  1508. CheckTrue(SameText('NAME',ADataset.Fields[1].FieldName));
  1509. CheckEquals(ord(ftString), ord(ADataset.Fields[1].DataType), 'Incorrect FieldType');
  1510. i := 1;
  1511. while not ADataset.EOF do
  1512. begin
  1513. CheckEquals('TestName'+inttostr(i),ADataset.FieldByName('name').AsString);
  1514. ADataset.Next;
  1515. inc(i);
  1516. end;
  1517. end;
  1518. procedure TTestBufDatasetDBBasics.TestAddIndexFieldType(AFieldType: TFieldType; ActiveDS : boolean);
  1519. var ds : TCustomBufDataset;
  1520. FList : TStringList;
  1521. LastValue : Variant;
  1522. StrValue : String;
  1523. begin
  1524. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1525. with ds do
  1526. begin
  1527. if not ActiveDS then
  1528. begin
  1529. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1530. IndexName:='testindex';
  1531. end
  1532. else
  1533. MaxIndexesCount := 3;
  1534. try
  1535. open;
  1536. except
  1537. if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
  1538. Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset')
  1539. else
  1540. raise;
  1541. end;
  1542. if ActiveDS then
  1543. begin
  1544. if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
  1545. Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
  1546. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1547. IndexName:='testindex';
  1548. First;
  1549. end;
  1550. LastValue:=null;
  1551. while not eof do
  1552. begin
  1553. if AFieldType=ftString then
  1554. CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))<=0)
  1555. else
  1556. CheckTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
  1557. LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
  1558. Next;
  1559. end;
  1560. while not bof do
  1561. begin
  1562. if AFieldType=ftString then
  1563. CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))>=0)
  1564. else
  1565. CheckTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
  1566. LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
  1567. Prior;
  1568. end;
  1569. end;
  1570. end;
  1571. procedure TTestBufDatasetDBBasics.TestAddIndexSmallInt;
  1572. begin
  1573. TestAddIndexFieldType(ftSmallint,False);
  1574. end;
  1575. procedure TTestBufDatasetDBBasics.TestAddIndexBoolean;
  1576. begin
  1577. TestAddIndexFieldType(ftBoolean,False);
  1578. end;
  1579. procedure TTestBufDatasetDBBasics.TestAddIndexFloat;
  1580. begin
  1581. TestAddIndexFieldType(ftFloat,False);
  1582. end;
  1583. procedure TTestBufDatasetDBBasics.TestAddIndexInteger;
  1584. begin
  1585. TestAddIndexFieldType(ftInteger,False);
  1586. end;
  1587. procedure TTestBufDatasetDBBasics.TestAddIndexLargeInt;
  1588. begin
  1589. TestAddIndexFieldType(ftLargeint,False);
  1590. end;
  1591. procedure TTestBufDatasetDBBasics.TestAddIndexDateTime;
  1592. begin
  1593. TestAddIndexFieldType(ftDateTime,False);
  1594. end;
  1595. procedure TTestBufDatasetDBBasics.TestAddIndexCurrency;
  1596. begin
  1597. TestAddIndexFieldType(ftCurrency,False);
  1598. end;
  1599. procedure TTestBufDatasetDBBasics.TestAddIndexBCD;
  1600. begin
  1601. TestAddIndexFieldType(ftBCD,False);
  1602. end;
  1603. procedure TTestBufDatasetDBBasics.TestAddIndexFmtBCD;
  1604. begin
  1605. TestAddIndexFieldType(ftFmtBCD,False);
  1606. end;
  1607. procedure TTestBufDatasetDBBasics.TestAddIndex;
  1608. var ds : TCustomBufDataset;
  1609. AFieldType : TFieldType;
  1610. FList : TStringList;
  1611. i : integer;
  1612. begin
  1613. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1614. with ds do
  1615. begin
  1616. AFieldType:=ftString;
  1617. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1618. FList := TStringList.Create;
  1619. try
  1620. FList.Sorted:=true;
  1621. FList.CaseSensitive:=True;
  1622. FList.Duplicates:=dupAccept;
  1623. open;
  1624. while not eof do
  1625. begin
  1626. flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1627. Next;
  1628. end;
  1629. IndexName:='testindex';
  1630. first;
  1631. i:=0;
  1632. while not eof do
  1633. begin
  1634. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1635. inc(i);
  1636. Next;
  1637. end;
  1638. while not bof do
  1639. begin
  1640. dec(i);
  1641. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1642. Prior;
  1643. end;
  1644. finally
  1645. flist.free;
  1646. end;
  1647. end;
  1648. end;
  1649. procedure TTestBufDatasetDBBasics.TestAddDescIndex;
  1650. var ds : TCustomBufDataset;
  1651. AFieldType : TFieldType;
  1652. FList : TStringList;
  1653. i : integer;
  1654. begin
  1655. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1656. with ds do
  1657. begin
  1658. AFieldType:=ftString;
  1659. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]);
  1660. FList := TStringList.Create;
  1661. try
  1662. FList.Sorted:=true;
  1663. FList.CaseSensitive:=True;
  1664. FList.Duplicates:=dupAccept;
  1665. open;
  1666. while not eof do
  1667. begin
  1668. flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1669. Next;
  1670. end;
  1671. IndexName:='testindex';
  1672. first;
  1673. i:=FList.Count-1;
  1674. while not eof do
  1675. begin
  1676. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1677. dec(i);
  1678. Next;
  1679. end;
  1680. while not bof do
  1681. begin
  1682. inc(i);
  1683. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1684. Prior;
  1685. end;
  1686. finally
  1687. flist.free;
  1688. end;
  1689. end;
  1690. end;
  1691. procedure TTestBufDatasetDBBasics.TestAddCaseInsIndex;
  1692. var ds : TCustomBufDataset;
  1693. AFieldType : TFieldType;
  1694. FList : TStringList;
  1695. i : integer;
  1696. begin
  1697. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1698. with ds do
  1699. begin
  1700. AFieldType:=ftString;
  1701. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]);
  1702. FList := TStringList.Create;
  1703. try
  1704. FList.Sorted:=true;
  1705. FList.Duplicates:=dupAccept;
  1706. open;
  1707. while not eof do
  1708. begin
  1709. flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1710. Next;
  1711. end;
  1712. IndexName:='testindex';
  1713. first;
  1714. i:=0;
  1715. while not eof do
  1716. begin
  1717. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1718. inc(i);
  1719. Next;
  1720. end;
  1721. while not bof do
  1722. begin
  1723. dec(i);
  1724. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1725. Prior;
  1726. end;
  1727. finally
  1728. FList.Free;
  1729. end;
  1730. end;
  1731. end;
  1732. procedure TTestBufDatasetDBBasics.TestInactSwitchIndex;
  1733. // Test if the default-index is properly build when the active index is not
  1734. // the default-index while opening then dataset
  1735. var ds : TCustomBufDataset;
  1736. AFieldType : TFieldType;
  1737. i : integer;
  1738. begin
  1739. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1740. with ds do
  1741. begin
  1742. AFieldType:=ftString;
  1743. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1744. IndexName:='testindex';
  1745. open;
  1746. IndexName:=''; // This should set the default index (default_order)
  1747. first;
  1748. i := 0;
  1749. while not eof do
  1750. begin
  1751. CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1752. inc(i);
  1753. Next;
  1754. end;
  1755. end;
  1756. end;
  1757. procedure TTestBufDatasetDBBasics.TestAddIndexActiveDS;
  1758. var ds : TCustomBufDataset;
  1759. I : integer;
  1760. begin
  1761. TestAddIndexFieldType(ftString,true);
  1762. end;
  1763. procedure TTestBufDatasetDBBasics.TestAddIndexEditDS;
  1764. var ds : TCustomBufDataset;
  1765. I : integer;
  1766. LastValue : String;
  1767. begin
  1768. ds := DBConnector.GetNDataset(True,5) as TCustomBufDataset;
  1769. with ds do
  1770. begin
  1771. MaxIndexesCount:=3;
  1772. open;
  1773. edit;
  1774. FieldByName('name').asstring := 'Zz';
  1775. post;
  1776. next;
  1777. next;
  1778. edit;
  1779. FieldByName('name').asstring := 'aA';
  1780. post;
  1781. AddIndex('test','name',[]);
  1782. first;
  1783. ds.IndexName:='test';
  1784. first;
  1785. LastValue:='';
  1786. while not eof do
  1787. begin
  1788. CheckTrue(AnsiCompareStr(LastValue,FieldByName('name').AsString)<=0);
  1789. LastValue:=FieldByName('name').AsString;
  1790. Next;
  1791. end;
  1792. end;
  1793. end;
  1794. procedure TTestBufDatasetDBBasics.TestIndexFieldNamesActive;
  1795. var ds : TCustomBufDataset;
  1796. AFieldType : TFieldType;
  1797. FList : TStringList;
  1798. i : integer;
  1799. begin
  1800. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1801. with ds do
  1802. begin
  1803. AFieldType:=ftString;
  1804. FList := TStringList.Create;
  1805. try
  1806. FList.Sorted:=true;
  1807. FList.CaseSensitive:=True;
  1808. FList.Duplicates:=dupAccept;
  1809. open;
  1810. while not eof do
  1811. begin
  1812. flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1813. Next;
  1814. end;
  1815. IndexFieldNames:='F'+FieldTypeNames[AfieldType];
  1816. first;
  1817. i:=0;
  1818. while not eof do
  1819. begin
  1820. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1821. inc(i);
  1822. Next;
  1823. end;
  1824. while not bof do
  1825. begin
  1826. dec(i);
  1827. CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1828. Prior;
  1829. end;
  1830. CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames);
  1831. IndexFieldNames:='ID';
  1832. first;
  1833. i:=0;
  1834. while not eof do
  1835. begin
  1836. CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1837. inc(i);
  1838. Next;
  1839. end;
  1840. CheckEquals('ID',IndexFieldNames);
  1841. IndexFieldNames:='';
  1842. first;
  1843. i:=0;
  1844. while not eof do
  1845. begin
  1846. CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1847. inc(i);
  1848. Next;
  1849. end;
  1850. CheckEquals('',IndexFieldNames);
  1851. finally
  1852. flist.free;
  1853. end;
  1854. end;
  1855. end;
  1856. procedure TTestBufDatasetDBBasics.TestIndexCurRecord;
  1857. // Test if the currentrecord stays the same after an index change
  1858. var ds : TCustomBufDataset;
  1859. AFieldType : TFieldType;
  1860. i : integer;
  1861. OldID : Integer;
  1862. OldStringValue : string;
  1863. begin
  1864. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1865. with ds do
  1866. begin
  1867. AFieldType:=ftString;
  1868. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1869. open;
  1870. for i := 0 to (testValuesCount div 3) do
  1871. Next;
  1872. OldID:=FieldByName('id').AsInteger;
  1873. OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
  1874. IndexName:='testindex';
  1875. CheckEquals(OldID,FieldByName('id').AsInteger);
  1876. CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1877. next;
  1878. CheckTrue(OldStringValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1879. prior;
  1880. prior;
  1881. CheckTrue(OldStringValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1882. OldID:=FieldByName('id').AsInteger;
  1883. OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
  1884. IndexName:='';
  1885. CheckEquals(OldID,FieldByName('id').AsInteger);
  1886. CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
  1887. next;
  1888. CheckEquals(OldID+1,FieldByName('ID').AsInteger);
  1889. prior;
  1890. prior;
  1891. CheckEquals(OldID-1,FieldByName('ID').AsInteger);
  1892. end;
  1893. end;
  1894. procedure TTestBufDatasetDBBasics.TestAddDblIndex;
  1895. var ds : TCustomBufDataset;
  1896. LastInteger : Integer;
  1897. LastString : string;
  1898. begin
  1899. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1900. with ds do
  1901. begin
  1902. AddIndex('testindex','F'+FieldTypeNames[ftString]+';F'+FieldTypeNames[ftInteger],[]);
  1903. open;
  1904. IndexName:='testindex';
  1905. first;
  1906. LastString:='';
  1907. while not eof do
  1908. begin
  1909. CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[ftString]).AsString,LastString)>=0);
  1910. LastString:= FieldByName('F'+FieldTypeNames[ftString]).AsString;
  1911. LastInteger:=-MaxInt;
  1912. while (FieldByName('F'+FieldTypeNames[ftString]).AsString=LastString) and not eof do
  1913. begin
  1914. CheckTrue(FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger>=LastInteger);
  1915. LastInteger:=FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger;
  1916. next;
  1917. end;
  1918. end;
  1919. while not bof do
  1920. begin
  1921. CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[ftString]).AsString,LastString)<=0);
  1922. LastString:= FieldByName('F'+FieldTypeNames[ftString]).AsString;
  1923. LastInteger:=+MaxInt;
  1924. while (FieldByName('F'+FieldTypeNames[ftString]).AsString=LastString) and not bof do
  1925. begin
  1926. CheckTrue(FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger<=LastInteger);
  1927. LastInteger:=FieldByName('F'+FieldTypeNames[ftInteger]).AsInteger;
  1928. prior;
  1929. end;
  1930. end;
  1931. end;
  1932. end;
  1933. procedure TTestBufDatasetDBBasics.TestIndexEditRecord;
  1934. // Tests index sorting for string field type by
  1935. // editing an existing record in the middle
  1936. // with a value at the end of the alphabet
  1937. var ds : TCustomBufDataset;
  1938. AFieldType : TFieldType;
  1939. i : integer;
  1940. OldID : Integer;
  1941. OldStringValue : string;
  1942. begin
  1943. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  1944. with ds do
  1945. begin
  1946. AFieldType:=ftString;
  1947. AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]);
  1948. IndexName:='testindex';
  1949. open; //Record 0
  1950. OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
  1951. next; //Now on record 1
  1952. CheckTrue(OldStringValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsString,'Record 0 must be smaller than record 1 with asc sorted index');
  1953. OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
  1954. next; //Now on record 2
  1955. CheckTrue(AnsiCompareStr(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0,'Record 1 must be smaller than record 2 with asc sorted index');
  1956. prior; //Now on record 1
  1957. edit;
  1958. FieldByName('F'+FieldTypeNames[AfieldType]).AsString := 'ZZZ'; //should be sorted last
  1959. post;
  1960. prior; // Now on record 0
  1961. // Check ZZZ is sorted on/after record 0
  1962. CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)>=0, 'Prior>');
  1963. next;
  1964. next; // Now on record 2
  1965. // Check ZZZ is sorted on/before record 2
  1966. CheckTrue(AnsiCompareStr('ZZZ',FieldByName('F'+FieldTypeNames[AfieldType]).AsString)<=0, 'Next<');
  1967. close;
  1968. end;
  1969. end;
  1970. procedure TTestBufDatasetDBBasics.TestIndexAppendRecord;
  1971. var i: integer;
  1972. LastValue: string;
  1973. begin
  1974. // start with empty dataset
  1975. with DBConnector.GetNDataset(true,0) as TCustomBufDataset do
  1976. begin
  1977. MaxIndexesCount:=4;
  1978. // add index to closed dataset with no data
  1979. AddIndex('testindex','NAME',[]);
  1980. IndexName:='testindex';
  1981. Open;
  1982. // empty dataset and other than default index (default_order) active
  1983. CheckTrue(BOF, 'No BOF when opening empty dataset');
  1984. CheckTrue(EOF, 'No EOF when opening empty dataset');
  1985. // append data at end
  1986. for i:=20 downto 0 do
  1987. AppendRecord([i, inttostr(i)]);
  1988. // insert data at begining
  1989. IndexName:='';
  1990. First;
  1991. for i:=21 to 22 do
  1992. InsertRecord([i, inttostr(i)]);
  1993. // swith to index and check if records are ordered
  1994. IndexName := 'testindex';
  1995. LastValue := '';
  1996. First;
  1997. for i:=22 downto 0 do
  1998. begin
  1999. CheckEquals(23-i, RecNo, 'testindex.RecNo:');
  2000. CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>=CurrValue');
  2001. LastValue := Fields[1].AsString;
  2002. Next;
  2003. end;
  2004. CheckTrue(EOF, 'testindex.No EOF after last record');
  2005. // switch back to default index (unordered)
  2006. IndexName:='';
  2007. First;
  2008. for i:=22 downto 0 do
  2009. begin
  2010. CheckEquals(23-i, RecNo, 'index[0].RecNo:');
  2011. CheckEquals(i, Fields[0].AsInteger, 'index[0].Fields[0].Value:');
  2012. Next;
  2013. end;
  2014. CheckTrue(EOF, 'index[0].No EOF after last record');
  2015. // add index to opened dataset with data
  2016. AddIndex('testindex2','ID',[]);
  2017. IndexName:='testindex2';
  2018. First;
  2019. for i:=0 to 22 do
  2020. begin
  2021. CheckEquals(1+i, RecNo, 'index2.RecNo:');
  2022. CheckEquals(i, Fields[0].AsInteger, 'index2.Fields[0].Value:');
  2023. Next;
  2024. end;
  2025. CheckTrue(EOF, 'index2.No EOF after last record');
  2026. Close;
  2027. end;
  2028. end;
  2029. procedure TTestBufDatasetDBBasics.TestIndexFieldNames;
  2030. var ds : TCustomBufDataset;
  2031. AFieldType : TFieldType;
  2032. PrevValue : String;
  2033. begin
  2034. ds := DBConnector.GetFieldDataset as TCustomBufDataset;
  2035. with ds do
  2036. begin
  2037. AFieldType:=ftString;
  2038. IndexFieldNames:='F'+FieldTypeNames[AfieldType];
  2039. open;
  2040. PrevValue:='';
  2041. while not eof do
  2042. begin
  2043. CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString,PrevValue)>=0);
  2044. PrevValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString;
  2045. Next;
  2046. end;
  2047. CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames);
  2048. end;
  2049. end;
  2050. procedure TTestBufDatasetDBBasics.TestIndexFieldNamesClosed;
  2051. var s : string;
  2052. bufds: TCustomBufDataset;
  2053. begin
  2054. bufds := DBConnector.GetNDataset(5) as TCustomBufDataset;
  2055. s := bufds.IndexFieldNames;
  2056. s := bufds.IndexName;
  2057. bufds.CompareBookmarks(nil,nil);
  2058. end;
  2059. {$endif fpc}
  2060. procedure TTestCursorDBBasics.TestFirst;
  2061. var i : integer;
  2062. begin
  2063. with DBConnector.GetNDataset(true,14) do
  2064. begin
  2065. open;
  2066. CheckEquals(1,FieldByName('ID').AsInteger);
  2067. First;
  2068. CheckEquals(1,FieldByName('ID').AsInteger);
  2069. next;
  2070. CheckEquals(2,FieldByName('ID').AsInteger);
  2071. First;
  2072. CheckEquals(1,FieldByName('ID').AsInteger);
  2073. for i := 0 to 12 do
  2074. next;
  2075. CheckEquals(14,FieldByName('ID').AsInteger);
  2076. First;
  2077. CheckEquals(1,FieldByName('ID').AsInteger);
  2078. close;
  2079. end;
  2080. end;
  2081. procedure TTestCursorDBBasics.TestEofAfterFirst;
  2082. begin
  2083. with DBConnector.GetNDataset(0) do
  2084. begin
  2085. open;
  2086. CheckTrue(eof);
  2087. CheckTrue(BOF);
  2088. first;
  2089. CheckTrue(eof);
  2090. CheckTrue(BOF);
  2091. end;
  2092. end;
  2093. procedure TTestDBBasics.TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField);
  2094. var i : byte;
  2095. begin
  2096. ADS := DBConnector.GetFieldDataset;
  2097. ADS.Open;
  2098. AFld := ADS.FindField('F'+FieldTypeNames[AfieldType]);
  2099. {$ifdef fpc}
  2100. if not assigned (AFld) then
  2101. Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
  2102. {$endif fpc}
  2103. CheckEquals(ord(AFieldType), ord(AFld.DataType), 'DataType');
  2104. CheckEquals(ADatasize, AFld.DataSize, 'DataSize');
  2105. end;
  2106. procedure TTestDBBasics.TestSupportIntegerFields;
  2107. var i : byte;
  2108. ds : TDataset;
  2109. Fld : TField;
  2110. DbfTableLevel: integer;
  2111. begin
  2112. if (uppercase(dbconnectorname)='DBF') then
  2113. begin
  2114. DbfTableLevel:=strtointdef(dbconnectorparams,4);
  2115. if not(DBFTableLevel in [7,30]) then
  2116. Ignore('TDBF: only Visual Foxpro and DBase7 support full integer range.');
  2117. end;
  2118. TestfieldDefinition(ftInteger,4,ds,Fld);
  2119. for i := 0 to testValuesCount-1 do
  2120. begin
  2121. CheckEquals(testIntValues[i],Fld.AsInteger);
  2122. ds.Next;
  2123. end;
  2124. ds.close;
  2125. end;
  2126. procedure TTestDBBasics.TestSupportSmallIntFields;
  2127. var i : byte;
  2128. ds : TDataset;
  2129. Fld : TField;
  2130. begin
  2131. if (uppercase(dbconnectorname)='DBF') then
  2132. Ignore('TDBF: Smallint support only from -999 to 9999');
  2133. TestfieldDefinition(ftSmallint,2,ds,Fld);
  2134. for i := 0 to testValuesCount-1 do
  2135. begin
  2136. CheckEquals(testSmallIntValues[i],Fld.AsInteger);
  2137. ds.Next;
  2138. end;
  2139. ds.close;
  2140. end;
  2141. procedure TTestDBBasics.TestSupportWordFields;
  2142. var i : byte;
  2143. ds : TDataset;
  2144. Fld : TField;
  2145. begin
  2146. TestfieldDefinition(ftWord,2,ds,Fld);
  2147. for i := 0 to testValuesCount-1 do
  2148. begin
  2149. CheckEquals(testWordValues[i],Fld.AsInteger);
  2150. ds.Next;
  2151. end;
  2152. ds.close;
  2153. end;
  2154. procedure TTestDBBasics.TestSupportStringFields;
  2155. var i : byte;
  2156. ds : TDataset;
  2157. Fld : TField;
  2158. begin
  2159. TestfieldDefinition(ftString,11,ds,Fld);
  2160. for i := 0 to testValuesCount-1 do
  2161. begin
  2162. if (uppercase(dbconnectorname)<>'DBF') then
  2163. CheckEquals(testStringValues[i],Fld.AsString)
  2164. else {DBF right-trims spaces in string fields }
  2165. CheckEquals(TrimRight(testStringValues[i]),Fld.AsString);
  2166. ds.Next;
  2167. end;
  2168. ds.close;
  2169. end;
  2170. procedure TTestDBBasics.TestSupportBooleanFields;
  2171. var i : byte;
  2172. ds : TDataset;
  2173. Fld : TField;
  2174. begin
  2175. TestfieldDefinition(ftBoolean,2,ds,Fld);
  2176. for i := 0 to testValuesCount-1 do
  2177. begin
  2178. CheckEquals(testBooleanValues[i],Fld.AsBoolean);
  2179. ds.Next;
  2180. end;
  2181. ds.close;
  2182. end;
  2183. procedure TTestDBBasics.TestSupportFloatFields;
  2184. var i : byte;
  2185. ds : TDataset;
  2186. Fld : TField;
  2187. begin
  2188. TestfieldDefinition(ftFloat,8,ds,Fld);
  2189. for i := 0 to testValuesCount-1 do
  2190. begin
  2191. CheckEquals(testFloatValues[i],Fld.AsFloat);
  2192. ds.Next;
  2193. end;
  2194. ds.close;
  2195. end;
  2196. procedure TTestDBBasics.TestSupportLargeIntFields;
  2197. var i : byte;
  2198. ds : TDataset;
  2199. Fld : TField;
  2200. begin
  2201. TestfieldDefinition(ftLargeint,8,ds,Fld);
  2202. for i := 0 to testValuesCount-1 do
  2203. begin
  2204. CheckEquals(testLargeIntValues[i],Fld.AsLargeInt);
  2205. ds.Next;
  2206. end;
  2207. ds.close;
  2208. end;
  2209. procedure TTestDBBasics.TestSupportDateFields;
  2210. var i : byte;
  2211. ds : TDataset;
  2212. Fld : TField;
  2213. begin
  2214. TestfieldDefinition(ftDate,8,ds,Fld);
  2215. for i := 0 to testValuesCount-1 do
  2216. begin
  2217. CheckEquals(testDateValues[i], FormatDateTime('yyyy/mm/dd', Fld.AsDateTime, DBConnector.FormatSettings));
  2218. ds.Next;
  2219. end;
  2220. ds.close;
  2221. end;
  2222. procedure TTestDBBasics.TestSupportTimeFields;
  2223. var i : byte;
  2224. ds : TDataset;
  2225. Fld : TField;
  2226. begin
  2227. TestfieldDefinition(ftTime,8,ds,Fld);
  2228. for i := 0 to testValuesCount-1 do
  2229. begin
  2230. CheckEquals(testTimeValues[i],DateTimeToTimeString(fld.AsDateTime));
  2231. ds.Next;
  2232. end;
  2233. ds.close;
  2234. end;
  2235. procedure TTestDBBasics.TestSupportCurrencyFields;
  2236. var i : byte;
  2237. ds : TDataset;
  2238. Fld : TField;
  2239. begin
  2240. if (uppercase(dbconnectorname)='DBF') then
  2241. Ignore('This test does not apply to TDBF as they store currency in BCD fields.');
  2242. TestfieldDefinition(ftCurrency,8,ds,Fld);
  2243. for i := 0 to testValuesCount-1 do
  2244. begin
  2245. CheckEquals(testCurrencyValues[i],Fld.AsCurrency);
  2246. CheckEquals(testCurrencyValues[i],Fld.AsFloat);
  2247. ds.Next;
  2248. end;
  2249. ds.close;
  2250. end;
  2251. procedure TTestDBBasics.TestSupportBCDFields;
  2252. var i : byte;
  2253. ds : TDataset;
  2254. Fld : TField;
  2255. begin
  2256. TestfieldDefinition(ftBCD,8,ds,Fld);
  2257. for i := 0 to testValuesCount-1 do
  2258. begin
  2259. CheckEquals(CurrToStr(testCurrencyValues[i]),Fld.AsString);
  2260. CheckEquals(testCurrencyValues[i],Fld.AsCurrency);
  2261. CheckEquals(testCurrencyValues[i],Fld.AsFloat);
  2262. ds.Next;
  2263. end;
  2264. ds.close;
  2265. end;
  2266. procedure TTestDBBasics.TestSupportfmtBCDFields;
  2267. var i : byte;
  2268. ds : TDataset;
  2269. Fld : TField;
  2270. begin
  2271. TestfieldDefinition(ftFMTBcd,sizeof(TBCD),ds,Fld);
  2272. for i := 0 to testValuesCount-1 do
  2273. begin
  2274. CheckEquals(testFmtBCDValues[i], BCDToStr(Fld.AsBCD,DBConnector.FormatSettings));
  2275. CheckEquals(StrToFloat(testFmtBCDValues[i],DBConnector.FormatSettings), Fld.AsFloat);
  2276. ds.Next;
  2277. end;
  2278. ds.close;
  2279. end;
  2280. procedure TTestDBBasics.TestSupportFixedStringFields;
  2281. var i : byte;
  2282. ds : TDataset;
  2283. Fld : TField;
  2284. begin
  2285. TestfieldDefinition(ftFixedChar,11,ds,Fld);
  2286. for i := 0 to testValuesCount-1 do
  2287. begin
  2288. if Fld.IsNull then // If the field is null, .AsString always returns an empty, non-padded string
  2289. CheckEquals(testStringValues[i],Fld.AsString)
  2290. else
  2291. {$ifdef fpc}
  2292. CheckEquals(PadRight(testStringValues[i],10),Fld.AsString);
  2293. {$else fpc}
  2294. CheckEquals(testStringValues[i],Fld.AsString);
  2295. {$endif fpc}
  2296. ds.Next;
  2297. end;
  2298. ds.close;
  2299. end;
  2300. procedure TTestDBBasics.TestSupportBlobFields;
  2301. var i : byte;
  2302. ds : TDataset;
  2303. Fld : TField;
  2304. begin
  2305. TestfieldDefinition(ftBlob,0,ds,Fld);
  2306. for i := 0 to testValuesCount-1 do
  2307. begin
  2308. CheckEquals(testValues[ftBlob,i],Fld.AsString);
  2309. ds.Next;
  2310. end;
  2311. ds.close;
  2312. end;
  2313. procedure TTestDBBasics.TestSupportMemoFields;
  2314. var i : byte;
  2315. ds : TDataset;
  2316. Fld : TField;
  2317. begin
  2318. TestfieldDefinition(ftMemo,0,ds,Fld);
  2319. for i := 0 to testValuesCount-1 do
  2320. begin
  2321. CheckEquals(testValues[ftMemo,i],Fld.AsString);
  2322. ds.Next;
  2323. end;
  2324. ds.close;
  2325. end;
  2326. procedure TTestDBBasics.TestcalculatedField_OnCalcfields(DataSet: TDataSet);
  2327. begin
  2328. case dataset.fieldbyname('ID').asinteger of
  2329. 1 : dataset.fieldbyname('CALCFLD').AsInteger := 5;
  2330. 2 : dataset.fieldbyname('CALCFLD').AsInteger := 70000;
  2331. 3 : dataset.fieldbyname('CALCFLD').Clear;
  2332. 4 : dataset.fieldbyname('CALCFLD').AsInteger := 1234;
  2333. 10 : dataset.fieldbyname('CALCFLD').Clear;
  2334. else
  2335. dataset.fieldbyname('CALCFLD').AsInteger := 1;
  2336. end;
  2337. CheckTrue(DataSet.State=dsCalcFields, 'State');
  2338. end;
  2339. procedure TTestDBBasics.TestCalculatedField;
  2340. var ds : TDataset;
  2341. AFld1, AFld2, AFld3 : Tfield;
  2342. begin
  2343. ds := DBConnector.GetNDataset(5);
  2344. with ds do
  2345. begin
  2346. AFld1 := TIntegerField.Create(ds);
  2347. AFld1.FieldName := 'ID';
  2348. AFld1.DataSet := ds;
  2349. AFld2 := TStringField.Create(ds);
  2350. AFld2.FieldName := 'NAME';
  2351. AFld2.DataSet := ds;
  2352. AFld3 := TIntegerField.Create(ds);
  2353. AFld3.FieldName := 'CALCFLD';
  2354. AFld3.DataSet := ds;
  2355. Afld3.FieldKind := fkCalculated;
  2356. CheckEquals(3,FieldCount);
  2357. ds.OnCalcFields := TestcalculatedField_OnCalcfields;
  2358. open;
  2359. CheckEquals(1,FieldByName('ID').asinteger);
  2360. CheckEquals(5,FieldByName('CALCFLD').asinteger);
  2361. next;
  2362. CheckEquals(70000,FieldByName('CALCFLD').asinteger);
  2363. next;
  2364. CheckTrue(FieldByName('CALCFLD').IsNull, '#3 Null');
  2365. next;
  2366. CheckEquals(1234,FieldByName('CALCFLD').AsInteger);
  2367. if IsUniDirectional then
  2368. // The CanModify property is always False, so attempts to put the dataset into edit mode always fail
  2369. CheckException(Edit, EDatabaseError)
  2370. else
  2371. begin
  2372. Edit;
  2373. FieldByName('ID').AsInteger := 10;
  2374. Post;
  2375. CheckTrue(FieldByName('CALCFLD').IsNull, '#10 Null');
  2376. end;
  2377. close;
  2378. AFld1.Free;
  2379. AFld2.Free;
  2380. AFld3.Free;
  2381. end;
  2382. end;
  2383. procedure TTestDBBasics.TestCanModifySpecialFields;
  2384. var ds : TDataset;
  2385. lds : TDataset;
  2386. fld : TField;
  2387. begin
  2388. lds := DBConnector.GetNDataset(10);
  2389. ds := DBConnector.GetNDataset(5);
  2390. with ds do
  2391. begin
  2392. Fld := TIntegerField.Create(ds);
  2393. Fld.FieldName:='ID';
  2394. Fld.DataSet:=ds;
  2395. Fld := TStringField.Create(ds);
  2396. Fld.FieldName:='LookupFld';
  2397. Fld.FieldKind:=fkLookup;
  2398. Fld.DataSet:=ds;
  2399. Fld.LookupDataSet:=lds;
  2400. Fld.LookupResultField:='NAME';
  2401. Fld.LookupKeyFields:='ID';
  2402. Fld.KeyFields:='ID';
  2403. lds.Open;
  2404. Open;
  2405. if IsUniDirectional then
  2406. // The CanModify property is always False for UniDirectional datasets
  2407. CheckFalse(FieldByName('ID').CanModify)
  2408. else
  2409. CheckTrue(FieldByName('ID').CanModify);
  2410. CheckFalse(FieldByName('LookupFld').CanModify);
  2411. CheckFalse(FieldByName('ID').ReadOnly);
  2412. CheckFalse(FieldByName('LookupFld').ReadOnly);
  2413. CheckEquals(1,FieldByName('ID').AsInteger);
  2414. if IsUniDirectional then
  2415. // Lookup fields are not supported by UniDirectional datasets
  2416. CheckTrue(FieldByName('LookupFld').IsNull)
  2417. else
  2418. CheckEquals('TestName1',FieldByName('LookupFld').AsString);
  2419. Next;
  2420. Next;
  2421. CheckEquals(3,FieldByName('ID').AsInteger);
  2422. if IsUniDirectional then
  2423. CheckTrue(FieldByName('LookupFld').IsNull)
  2424. else
  2425. CheckEquals('TestName3',FieldByName('LookupFld').AsString);
  2426. Close;
  2427. lds.Close;
  2428. end;
  2429. end;
  2430. procedure TTestDBBasics.TestDoubleClose;
  2431. begin
  2432. with DBConnector.GetNDataset(1) do
  2433. begin
  2434. close;
  2435. close;
  2436. open;
  2437. close;
  2438. close;
  2439. end;
  2440. end;
  2441. procedure TTestDBBasics.TestFieldDefsUpdate;
  2442. begin
  2443. // FieldDefs.Update is called also by Lazarus IDE Fields editor
  2444. with DBConnector.GetNDataset(0) do
  2445. begin
  2446. // call Update on closed unprepared dataset
  2447. FieldDefs.Update;
  2448. CheckEquals(2, FieldDefs.Count);
  2449. end;
  2450. end;
  2451. procedure TTestDBBasics.TestAssignFieldftString;
  2452. var AParam : TParam;
  2453. AField : TField;
  2454. begin
  2455. AParam := TParam.Create(nil);
  2456. with DBConnector.GetNDataset(1) do
  2457. begin
  2458. open;
  2459. AField := fieldbyname('name');
  2460. AParam.AssignField(AField);
  2461. CheckEquals(ord(ftString), ord(AParam.DataType), 'DataType');
  2462. close;
  2463. end;
  2464. AParam.Free;
  2465. end;
  2466. procedure TTestDBBasics.TestAssignFieldftFixedChar;
  2467. var AParam : TParam;
  2468. AField : TField;
  2469. begin
  2470. AParam := TParam.Create(nil);
  2471. with DBConnector.GetNDataset(1) do
  2472. begin
  2473. open;
  2474. AField := fieldbyname('name');
  2475. (AField as tstringfield).FixedChar := true;
  2476. AParam.AssignField(AField);
  2477. CheckEquals(ord(ftFixedChar), ord(AParam.DataType), 'DataType');
  2478. close;
  2479. end;
  2480. AParam.Free;
  2481. end;
  2482. procedure TTestCursorDBBasics.TestBug7007;
  2483. var
  2484. datalink1: tdatalink;
  2485. datasource1: tdatasource;
  2486. query1: TDataSet;
  2487. begin
  2488. query1:= DBConnector.GetNDataset(6);
  2489. datalink1:= TTestDataLink.create;
  2490. datasource1:= tdatasource.create(nil);
  2491. try
  2492. datalink1.datasource:= datasource1;
  2493. datasource1.dataset:= query1;
  2494. datalink1.datasource:= datasource1;
  2495. DataEvents := '';
  2496. query1.open;
  2497. datalink1.buffercount:= query1.recordcount;
  2498. CheckEquals('deUpdateState:0;',DataEvents);
  2499. CheckEquals(0, datalink1.ActiveRecord);
  2500. CheckEquals(6, datalink1.RecordCount);
  2501. CheckEquals(6, query1.RecordCount);
  2502. CheckEquals(1, query1.RecNo);
  2503. DataEvents := '';
  2504. query1.append;
  2505. CheckEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;DataSetChanged;',DataEvents);
  2506. CheckEquals(5, datalink1.ActiveRecord);
  2507. CheckEquals(6, datalink1.RecordCount);
  2508. CheckEquals(6, query1.RecordCount);
  2509. CheckTrue(query1.RecNo in [0,7]);
  2510. DataEvents := '';
  2511. query1.cancel;
  2512. CheckEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;DataSetChanged;',DataEvents);
  2513. CheckEquals(5, datalink1.ActiveRecord);
  2514. CheckEquals(6, datalink1.RecordCount);
  2515. CheckEquals(6, query1.RecordCount);
  2516. CheckEquals(6, query1.RecNo);
  2517. finally
  2518. datalink1.free;
  2519. datasource1.free;
  2520. end;
  2521. end;
  2522. procedure TTestCursorDBBasics.TestBug6893;
  2523. var
  2524. datalink1: tdatalink;
  2525. datasource1: tdatasource;
  2526. query1: TDataSet;
  2527. begin
  2528. query1:= DBConnector.GetNDataset(25);
  2529. datalink1:= TDataLink.create;
  2530. datasource1:= tdatasource.create(nil);
  2531. try
  2532. datalink1.datasource:= datasource1;
  2533. datasource1.dataset:= query1;
  2534. datalink1.buffercount:= 5;
  2535. query1.active := true;
  2536. query1.MoveBy(20);
  2537. {$ifdef fpc}
  2538. CheckEquals(5, THackDataLink(datalink1).Firstrecord);
  2539. CheckEquals(4, datalink1.ActiveRecord);
  2540. CheckEquals(21, query1.RecNo);
  2541. query1.active := False;
  2542. CheckEquals(0, THackDataLink(datalink1).Firstrecord);
  2543. CheckEquals(0, datalink1.ActiveRecord);
  2544. query1.active := true;
  2545. CheckEquals(0, THackDataLink(datalink1).Firstrecord);
  2546. CheckEquals(0, datalink1.ActiveRecord);
  2547. CheckEquals(1, query1.RecNo);
  2548. {$endif fpc}
  2549. finally
  2550. datalink1.free;
  2551. datasource1.free;
  2552. end;
  2553. end;
  2554. procedure TTestCursorDBBasics.TestNullAtOpen;
  2555. begin
  2556. with dbconnector.getndataset(0) do
  2557. begin
  2558. active:= true;
  2559. CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL on a just-opened empty dataset');
  2560. append;
  2561. CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL after append on an empty dataset');
  2562. fieldbyname('id').asinteger:= 123;
  2563. cancel;
  2564. CheckTrue(fieldbyname('id').IsNull,'Field isn''t NULL after cancel');
  2565. end;
  2566. end;
  2567. { TDBBasicsUniDirectionalTestSetup }
  2568. {$ifdef fpc}
  2569. procedure TDBBasicsUniDirectionalTestSetup.OneTimeSetup;
  2570. begin
  2571. inherited OneTimeSetup;
  2572. DBConnector.TestUniDirectional:=true;
  2573. end;
  2574. procedure TDBBasicsUniDirectionalTestSetup.OneTimeTearDown;
  2575. begin
  2576. DBConnector.TestUniDirectional:=false;
  2577. inherited OneTimeTearDown;
  2578. end;
  2579. {$endif fpc}
  2580. initialization
  2581. {$ifdef fpc}
  2582. RegisterTestDecorator(TDBBasicsTestSetup, TTestDBBasics);
  2583. RegisterTestDecorator(TDBBasicsTestSetup, TTestCursorDBBasics);
  2584. // The SQL connectors are descendents of bufdataset and therefore benefit from testing:
  2585. if (uppercase(dbconnectorname)='SQL') or (uppercase(dbconnectorname)='BUFDATASET') then
  2586. begin
  2587. RegisterTestDecorator(TDBBasicsTestSetup, TTestBufDatasetDBBasics);
  2588. RegisterTestDecorator(TDBBasicsUniDirectionalTestSetup, TTestUniDirectionalDBBasics);
  2589. end;
  2590. {$else fpc}
  2591. RegisterTest(TTestDBBasics.Suite);
  2592. {$endif fpc}
  2593. end.