testdbbasics.pas 85 KB

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