testdatasources.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783
  1. unit TestDatasources;
  2. {$IFDEF FPC}
  3. {$mode Delphi}{$H+}
  4. {$ENDIF}
  5. interface
  6. uses
  7. Classes, SysUtils, fpcunit, db;
  8. type
  9. { TTestDatasources }
  10. TTestDatasources = class(TTestCase)
  11. private
  12. procedure FieldNotifyEvent(Sender: TField);
  13. procedure DatasetNotifyEvent(Dataset: TDataset);
  14. protected
  15. procedure SetUp; override;
  16. procedure TearDown; override;
  17. published
  18. // This test is also in TestDBBasics
  19. // procedure TestDataEventsResync;
  20. procedure TestDataEvent1;
  21. procedure TestDataEvent2;
  22. procedure TestDataEvent3;
  23. procedure TestDataEvent4;
  24. procedure TestDataEvent5;
  25. procedure TestDataEvent6;
  26. procedure TestDataEvent7;
  27. procedure TestCalcFirstRecord1;
  28. procedure TestRefreshLookupList;
  29. procedure TestCalculateFields;
  30. procedure TestCalcLookupValue;
  31. procedure TestEnableControls;
  32. end;
  33. implementation
  34. uses ToolsUnit, dbf, testregistry, variants{$IFDEF UNIX},cwstring {$ENDIF};
  35. type THackDataset=class(TDataset);
  36. THackDataLink=class(TDatalink);
  37. { TTestDataSources }
  38. procedure TTestDatasources.FieldNotifyEvent(Sender: TField);
  39. begin
  40. DataEvents := DataEvents + 'FieldNotifyEvent' + ';';
  41. end;
  42. procedure TTestDatasources.DatasetNotifyEvent(Dataset: TDataset);
  43. begin
  44. DataEvents := DataEvents + 'DatasetNotifyEvent' + ';';
  45. end;
  46. procedure TTestDatasources.SetUp;
  47. begin
  48. DBConnector.StartTest(TestName);
  49. end;
  50. procedure TTestDatasources.TearDown;
  51. begin
  52. DBConnector.StopTest(TestName);
  53. end;
  54. {procedure TTestDatasources.TestDataEventsResync;
  55. var i,count : integer;
  56. aDatasource : TDataSource;
  57. aDatalink : TDataLink;
  58. ds : tdataset;
  59. begin
  60. aDatasource := TDataSource.Create(nil);
  61. aDatalink := TTestDataLink.Create;
  62. aDatalink.DataSource := aDatasource;
  63. ds := DBConnector.GetNDataset(6);
  64. ds.BeforeScroll := DBConnector.DataEvent;
  65. with ds do
  66. begin
  67. aDatasource.DataSet := ds;
  68. open;
  69. DataEvents := '';
  70. Resync([rmExact]);
  71. AssertEquals('deDataSetChange:0;',DataEvents);
  72. DataEvents := '';
  73. next;
  74. AssertEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;',DataEvents);
  75. close;
  76. end;
  77. aDatasource.Free;
  78. aDatalink.Free;
  79. end;}
  80. procedure TTestDatasources.TestDataEvent1;
  81. var
  82. aDatasource : TDataSource;
  83. aDatalink1,
  84. aDatalink2 : TDataLink;
  85. ds : tdataset;
  86. begin
  87. aDatasource := TDataSource.Create(nil);
  88. aDatalink1 := TTestDataLink.Create;
  89. aDatalink1.DataSource := aDatasource;
  90. ds := DBConnector.GetNDataset(6);
  91. with ds do
  92. begin
  93. aDatasource.DataSet := ds;
  94. open;
  95. DataEvents := '';
  96. THackDataset(ds).DataEvent(deCheckBrowseMode,0);
  97. AssertEquals('deCheckBrowseMode:0;',DataEvents);
  98. aDatalink2 := TTestDataLink.Create;
  99. aDatalink2.DataSource := aDatasource;
  100. DataEvents := '';
  101. THackDataset(ds).DataEvent(deCheckBrowseMode,0);
  102. AssertEquals('deCheckBrowseMode:0;deCheckBrowseMode:0;',DataEvents);
  103. aDatalink2.free;
  104. DataEvents := '';
  105. THackDataset(ds).DataEvent(deCheckBrowseMode,0);
  106. AssertEquals('deCheckBrowseMode:0;',DataEvents);
  107. close;
  108. end;
  109. end;
  110. procedure TTestDatasources.TestDataEvent2;
  111. var aDatasource : TDataSource;
  112. aDatalink : TDataLink;
  113. ds : tdataset;
  114. begin
  115. aDatasource := TDataSource.Create(nil);
  116. aDatalink := TTestDataLink.Create;
  117. aDatalink.DataSource := aDatasource;
  118. ds := DBConnector.GetTraceDataset(false);
  119. with ds do
  120. begin
  121. aDatasource.DataSet := ds;
  122. open;
  123. // The deDataSetChange and deDataSetScroll events should trigger a call to
  124. // TDataset.UpdateCursorPos...
  125. DataEvents := '';
  126. THackDataset(ds).DataEvent(deDataSetChange,0);
  127. AssertEquals('SetCurrentRecord;deDataSetChange:0;',DataEvents);
  128. DataEvents := '';
  129. THackDataset(ds).DataEvent(deDataSetScroll,0);
  130. AssertEquals('SetCurrentRecord;deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
  131. // unless TDataset.State is dsInsert
  132. ds.insert;
  133. DataEvents := '';
  134. AssertTrue(ds.State=dsInsert);
  135. THackDataset(ds).DataEvent(deDataSetChange,0);
  136. AssertEquals('deDataSetChange:0;',DataEvents);
  137. AssertTrue(ds.State=dsInsert);
  138. DataEvents := '';
  139. THackDataset(ds).DataEvent(deDataSetScroll,0);
  140. AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
  141. end;
  142. end;
  143. procedure TTestDatasources.TestDataEvent3;
  144. var aDatasource : TDataSource;
  145. aDatalink : TDataLink;
  146. ds : tdataset;
  147. AFld : TField;
  148. begin
  149. aDatasource := TDataSource.Create(nil);
  150. aDatalink := TTestDataLink.Create;
  151. aDatalink.DataSource := aDatasource;
  152. ds := DBConnector.GetTraceDataset(false);
  153. with ds do
  154. begin
  155. aDatasource.DataSet := ds;
  156. open;
  157. AFld := FieldByName('id');
  158. // On a deFieldChange event from a field with a fieldkind of fkData or
  159. // fkInternalCalc, TDataset.Modified must be set to true
  160. DataEvents := '';
  161. AssertFalse(Modified);
  162. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  163. AssertTrue(Modified);
  164. AssertEquals('deFieldChange:ID;',DataEvents);
  165. Close;
  166. AFld := TIntegerField.Create(ds);
  167. AFld.FieldName := 'CALCFLD';
  168. AFld.DataSet := ds;
  169. Afld.FieldKind := fkCalculated;
  170. Open;
  171. DataEvents := '';
  172. AssertFalse(Modified);
  173. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  174. AssertFalse(Modified);
  175. AssertEquals('deFieldChange:CALCFLD;',DataEvents);
  176. end;
  177. end;
  178. procedure TTestDatasources.TestDataEvent4;
  179. var aDatasource : TDataSource;
  180. aDatalink : TDataLink;
  181. ds : tdataset;
  182. AFld : TField;
  183. begin
  184. aDatasource := TDataSource.Create(nil);
  185. aDatalink := TTestDataLink.Create;
  186. aDatalink.DataSource := aDatasource;
  187. ds := DBConnector.GetTraceDataset(false);
  188. with ds do
  189. begin
  190. aDatasource.DataSet := ds;
  191. // Ugly hack to imitate InternalCalcField, see
  192. // TDbfTraceDataset.InternalInitFieldDefs
  193. FieldDefs.Add('Name',ftString);
  194. FieldDefs.Find('Name').InternalCalcField:=True;
  195. open;
  196. AssertTrue(THackDataset(ds).InternalCalcFields);
  197. // If there are InternalCalcFields (InternalCalcFields=True) and the fieldkind
  198. // of the field from the deFieldChange event is fkData, then
  199. // RefreshIntenralCalcFields is called
  200. AFld := FieldByName('id');
  201. DataEvents := '';
  202. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  203. AssertEquals('RefreshInternalCalcFields;deFieldChange:ID;',DataEvents);
  204. AFld := FieldByName('name');
  205. AFld.FieldKind:=fkInternalCalc;
  206. DataEvents := '';
  207. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  208. AssertEquals('deFieldChange:NAME;',DataEvents);
  209. // If the TDataset.State is dsSetKey then IntenralCalcFields shoudn't get called
  210. THackDataset(ds).SetState(dsSetKey);
  211. AFld := FieldByName('id');
  212. DataEvents := '';
  213. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  214. AssertEquals('deFieldChange:ID;',DataEvents);
  215. end;
  216. end;
  217. procedure TTestDatasources.TestDataEvent5;
  218. var aDatasource : TDataSource;
  219. aDatalink : TDataLink;
  220. ds : tdataset;
  221. AFld : TField;
  222. begin
  223. aDatasource := TDataSource.Create(nil);
  224. aDatalink := TTestDataLink.Create;
  225. aDatalink.DataSource := aDatasource;
  226. ds := DBConnector.GetTraceDataset(false);
  227. with ds do
  228. begin
  229. aDatasource.DataSet := ds;
  230. open;
  231. AFld := FieldByName('id');
  232. AFld.OnChange:=FieldNotifyEvent;
  233. // When TDataset.State is not dsSetKey then TField.Change is called on a
  234. // deFieldChange event
  235. DataEvents := '';
  236. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  237. AssertEquals('FieldNotifyEvent;deFieldChange:ID;',DataEvents);
  238. THackDataset(ds).SetState(dsSetKey);
  239. DataEvents := '';
  240. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  241. AssertEquals('deFieldChange:ID;',DataEvents);
  242. end;
  243. end;
  244. procedure TTestDatasources.TestDataEvent6;
  245. var aDatasource : TDataSource;
  246. aDatalink : TDataLink;
  247. ds : tdataset;
  248. AFld : TField;
  249. begin
  250. aDatasource := TDataSource.Create(nil);
  251. aDatalink := TTestDataLink.Create;
  252. aDatalink.DataSource := aDatasource;
  253. ds := DBConnector.GetTraceDataset(false);
  254. with ds do
  255. begin
  256. aDatasource.DataSet := ds;
  257. AFld := TIntegerField.Create(ds);
  258. AFld.FieldName := 'ID';
  259. AFld.DataSet := ds;
  260. AFld := TStringField.Create(ds);
  261. AFld.FieldName := 'NAME';
  262. AFld.DataSet := ds;
  263. AFld := TIntegerField.Create(ds);
  264. AFld.FieldName := 'CALCFLD';
  265. AFld.DataSet := ds;
  266. Afld.FieldKind := fkCalculated;
  267. open;
  268. // If there are Calculated fields and AutoCalcFields is true, then call
  269. // CalculateFields in case of a deFieldChange event, if the fields fieldkind
  270. // is fkData
  271. AFld := FieldByName('id');
  272. DataEvents := '';
  273. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  274. AssertEquals('deFieldChange:ID;',DataEvents);
  275. DataEvents := '';
  276. AutoCalcFields:=True;
  277. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  278. AssertEquals('CalculateFields;ClearCalcFields;deFieldChange:ID;',DataEvents);
  279. AFld := FieldByName('calcfld');
  280. DataEvents := '';
  281. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  282. AssertEquals('deFieldChange:CALCFLD;',DataEvents);
  283. // If the TDataset.State is dsSetKey then CalculateFields shoudn't get called
  284. THackDataset(ds).SetState(dsSetKey);
  285. AFld := FieldByName('id');
  286. DataEvents := '';
  287. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  288. AssertEquals('deFieldChange:ID;',DataEvents);
  289. end;
  290. end;
  291. procedure TTestDatasources.TestDataEvent7;
  292. var aDatasource : TDataSource;
  293. aDatalink : TDataLink;
  294. ds : tdataset;
  295. AFld : TField;
  296. begin
  297. aDatasource := TDataSource.Create(nil);
  298. aDatalink := TTestDataLink.Create;
  299. aDatalink.DataSource := aDatasource;
  300. ds := DBConnector.GetTraceDataset(false);
  301. with ds do
  302. begin
  303. aDatasource.DataSet := ds;
  304. AFld := TIntegerField.Create(ds);
  305. AFld.FieldName := 'ID';
  306. AFld.DataSet := ds;
  307. AFld := TStringField.Create(ds);
  308. AFld.FieldName := 'NAME';
  309. AFld.DataSet := ds;
  310. AFld := TIntegerField.Create(ds);
  311. AFld.FieldName := 'CALCFLD';
  312. AFld.DataSet := ds;
  313. Afld.FieldKind := fkCalculated;
  314. // Ugly hack to imitate InternalCalcField, see
  315. // TDbfTraceDataset.InternalInitFieldDefs
  316. FieldDefs.Add('Name',ftString);
  317. FieldDefs.Find('Name').InternalCalcField:=True;
  318. open;
  319. AssertTrue(THackDataset(ds).InternalCalcFields);
  320. // If there are InternalCalcFields and 'normal' Calculated fields, only
  321. // RefreshInternalCalcFields is called
  322. AFld := FieldByName('id');
  323. DataEvents := '';
  324. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  325. AssertEquals('RefreshInternalCalcFields;deFieldChange:ID;',DataEvents);
  326. AFld := FieldByName('name');
  327. AFld.FieldKind:=fkInternalCalc;
  328. DataEvents := '';
  329. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  330. AssertEquals('deFieldChange:NAME;',DataEvents);
  331. // If the TDataset.State is dsSetKey then InternalCalcFields shoudn't get called
  332. THackDataset(ds).SetState(dsSetKey);
  333. AFld := FieldByName('id');
  334. DataEvents := '';
  335. THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
  336. AssertEquals('deFieldChange:ID;',DataEvents);
  337. end;
  338. end;
  339. procedure TTestDatasources.TestCalcFirstRecord1;
  340. var aDatasource : TDataSource;
  341. aDatalink : TDataLink;
  342. ds : tdataset;
  343. FirstRec : Integer;
  344. begin
  345. aDatasource := TDataSource.Create(nil);
  346. aDatalink := TTestDataLink.Create;
  347. aDatalink.DataSource := aDatasource;
  348. ds := DBConnector.GetNDataset(15);
  349. aDatasource.DataSet := ds;
  350. with ds do
  351. begin
  352. open;
  353. FirstRec := THackDataLink(aDatalink).FirstRecord;
  354. // Scroll '0' records, FirstRecord should stay the same,
  355. // and the there's no need to scroll the buffer.
  356. DataEvents := '';
  357. THackDataset(ds).DataEvent(deDataSetScroll,0);
  358. AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
  359. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  360. // Scroll 1 record forward, FirstRecord should stay the same,
  361. // but the buffer is scrolled one place back.
  362. DataEvents := '';
  363. THackDataset(ds).DataEvent(deDataSetScroll,1);
  364. AssertEquals('deDataSetScroll:1;DataSetScrolled:-1;',DataEvents);
  365. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  366. // Scroll 1 record backward, FirstRecord should stay the same,
  367. // but the buffer is scrolled one place back.
  368. DataEvents := '';
  369. THackDataset(ds).DataEvent(deDataSetScroll,-1);
  370. AssertEquals('deDataSetScroll:-1;DataSetScrolled:1;',DataEvents);
  371. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  372. // Remove the datasource.
  373. aDatasource.DataSet := nil;
  374. DataEvents := '';
  375. THackDataset(ds).DataEvent(deDataSetScroll,1);
  376. AssertEquals('',DataEvents);
  377. // Set the buffer-size to 5 and add it to the dataset again
  378. aDatalink.BufferCount:=5;
  379. aDatasource.DataSet := ds;
  380. // Scroll '0' records, firstrecord should stay the same again,
  381. // and there's no need to scroll the buffer.
  382. DataEvents := '';
  383. THackDataset(ds).DataEvent(deDataSetScroll,0);
  384. AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
  385. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  386. // Scroll 1 record backwards with a buffer size of 5.
  387. // Now the buffer won't scroll, but FirstRecord is decremented
  388. DataEvents := '';
  389. THackDataset(ds).DataEvent(deDataSetScroll,-1);
  390. AssertEquals('deDataSetScroll:-1;DataSetScrolled:0;',DataEvents);
  391. dec(FirstRec);
  392. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  393. // Scroll one record forward again, no buffer scroll, FirstRecord
  394. // is inremented
  395. DataEvents := '';
  396. THackDataset(ds).DataEvent(deDataSetScroll,1);
  397. AssertEquals('deDataSetScroll:1;DataSetScrolled:0;',DataEvents);
  398. inc(FirstRec);
  399. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  400. // Scroll one more record forward, buffer will scroll, FirstRecord
  401. // stays constant
  402. DataEvents := '';
  403. THackDataset(ds).DataEvent(deDataSetScroll,1);
  404. AssertEquals('deDataSetScroll:1;DataSetScrolled:-1;',DataEvents);
  405. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  406. // Scroll two records backward, no buffer scroll, FirstRecord
  407. // is inremented twice
  408. DataEvents := '';
  409. THackDataset(ds).DataEvent(deDataSetScroll,-2);
  410. AssertEquals('deDataSetScroll:-2;DataSetScrolled:0;',DataEvents);
  411. dec(FirstRec,2);
  412. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  413. // Scroll 6 records forward, so the buffer is scrolled 4 positions backward
  414. // and FirstRecord is Incremented by 2
  415. DataEvents := '';
  416. THackDataset(ds).DataEvent(deDataSetScroll,6);
  417. AssertEquals('deDataSetScroll:6;DataSetScrolled:-4;',DataEvents);
  418. inc(FirstRec,2);
  419. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  420. // The other way around, scroll 6 records back, so the buffer is scrolled 2
  421. // positions forward and FirstRecord is decremented by 4
  422. DataEvents := '';
  423. THackDataset(ds).DataEvent(deDataSetScroll,-6);
  424. AssertEquals('deDataSetScroll:-6;DataSetScrolled:2;',DataEvents);
  425. dec(FirstRec,4);
  426. AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
  427. end;
  428. end;
  429. procedure TTestDatasources.TestRefreshLookupList;
  430. var ds, lkpDs : TDataset;
  431. AFld1, AFld2, AFld3 : Tfield;
  432. Var1,Var2 : Variant;
  433. procedure TestLookupList;
  434. begin
  435. lkpDs.Open;
  436. lkpDs.first;
  437. while not LkpDs.eof do with AFld3 do
  438. begin
  439. Var1 := LkpDs.FieldValues[LookupResultField];
  440. Var2 := LookupList.ValueOfKey(LkpDs.fieldvalues[LookupKeyFields]);
  441. AssertEquals(VarToStr(Var1),VarToStr(Var2));
  442. lkpDs.Next;
  443. end;
  444. end;
  445. begin
  446. ds := DBConnector.GetNDataset(15);
  447. lkpDs := DBConnector.GetNDataset(5);
  448. with ds do
  449. begin
  450. AFld1 := TIntegerField.Create(ds);
  451. AFld1.FieldName := 'ID';
  452. AFld1.DataSet := ds;
  453. AFld2 := TStringField.Create(ds);
  454. AFld2.FieldName := 'NAME';
  455. AFld2.DataSet := ds;
  456. AFld3 := TIntegerField.Create(ds);
  457. with AFld3 do
  458. begin
  459. // Test if nothing happens when not all properties are filled
  460. FieldName := 'LookupFld';
  461. FieldKind := fkLookup;
  462. DataSet := ds;
  463. RefreshLookupList;
  464. LookupDataSet := lkpDs;
  465. RefreshLookupList;
  466. LookupKeyFields:='name';
  467. RefreshLookupList;
  468. LookupResultField:='ID';
  469. RefreshLookupList;
  470. KeyFields:='name';
  471. // Everything is filled in, this should run wihout any problems:
  472. RefreshLookupList;
  473. // The lookupdataset was closed, and should be closed again:
  474. AssertFalse(lkpDs.Active);
  475. // If some fields don't exist, check if an exception is raised:
  476. LookupKeyFields:='faulty';
  477. AssertException(EDatabaseError,RefreshLookupList);
  478. LookupKeyFields:='name';
  479. LookupResultField :='faulty';
  480. AssertException(EDatabaseError,RefreshLookupList);
  481. LookupResultField :='ID';
  482. // Check if the lookuplist is correctly filled
  483. RefreshLookupList;
  484. TestLookupList;
  485. // Check if the lookuplist is correctly filled when there are multiple
  486. // fields in the key
  487. LookupResultField:='name';
  488. LookupKeyFields:='id;name';
  489. RefreshLookupList;
  490. TestLookupList;
  491. end;
  492. AFld1.Free;
  493. AFld2.Free;
  494. AFld3.Free;
  495. end;
  496. end;
  497. procedure TTestDatasources.TestCalculateFields;
  498. var ds, lkpDs : TDataset;
  499. AFld1, AFld2, AFld3 : Tfield;
  500. StoreValue : Variant;
  501. Buffer: pchar;
  502. begin
  503. ds := DBConnector.GetTraceDataset(True);
  504. lkpDs := DBConnector.GetNDataset(5);
  505. with ds do
  506. begin
  507. AFld1 := TIntegerField.Create(ds);
  508. AFld1.FieldName := 'ID';
  509. AFld1.DataSet := ds;
  510. AFld2 := TStringField.Create(ds);
  511. AFld2.FieldName := 'NAME';
  512. AFld2.DataSet := ds;
  513. AFld3 := TIntegerField.Create(ds);
  514. with AFld3 do
  515. begin
  516. FieldName := 'LookupFld';
  517. FieldKind := fkLookup;
  518. DataSet := ds;
  519. LookupDataSet := lkpDs;
  520. LookupKeyFields:='name';
  521. LookupResultField:='ID';
  522. KeyFields := 'name';
  523. end;
  524. ds.OnCalcFields:=DatasetNotifyEvent;
  525. lkpds.Open;
  526. open;
  527. Buffer:=ds.ActiveBuffer;
  528. // If the state is dsInternalCalc, only the OnCalcField event should be called
  529. THackDataset(ds).SetState(dsInternalCalc);
  530. DataEvents:='';
  531. StoreValue:=AFld3.Value;
  532. THackDataset(ds).CalculateFields(Buffer);
  533. AssertEquals('CalculateFields;DatasetNotifyEvent;',DataEvents);
  534. AssertEquals(VarToStr(StoreValue),VarToSTr(AFld3.Value));
  535. THackDataset(ds).SetState(dsBrowse);
  536. // Also if the dataset is Unidirectional, only the OnCalcField event should be called
  537. THackDataset(ds).SetUniDirectional(True);
  538. DataEvents:='';
  539. StoreValue:=AFld3.Value;
  540. THackDataset(ds).CalculateFields(Buffer);
  541. AssertEquals('CalculateFields;DatasetNotifyEvent;',DataEvents);
  542. AssertEquals(VarToStr(StoreValue),VarToSTr(AFld3.Value));
  543. THackDataset(ds).SetUniDirectional(False);
  544. // Else, the value of all the lookup fields should get calculated
  545. edit;
  546. FieldByName('name').asstring := 'TestName3';
  547. post;
  548. DataEvents:='';
  549. THackDataset(ds).CalculateFields(Buffer);
  550. AssertEquals('CalculateFields;ClearCalcFields;DatasetNotifyEvent;',DataEvents);
  551. AssertEquals('3',VarToStr(AFld3.Value));
  552. end;
  553. end;
  554. procedure TTestDatasources.TestCalcLookupValue;
  555. var ds, lkpDs : TDataset;
  556. AFld1, AFld2, AFld3 : Tfield;
  557. Buffer: pchar;
  558. begin
  559. ds := DBConnector.GetNDataset(True,15);
  560. lkpDs := DBConnector.GetNDataset(5);
  561. with ds do
  562. begin
  563. AFld1 := TIntegerField.Create(ds);
  564. AFld1.FieldName := 'ID';
  565. AFld1.DataSet := ds;
  566. AFld2 := TStringField.Create(ds);
  567. AFld2.FieldName := 'NAME';
  568. AFld2.DataSet := ds;
  569. AFld3 := TIntegerField.Create(ds);
  570. with AFld3 do
  571. begin
  572. FieldName := 'LookupFld';
  573. FieldKind := fkLookup;
  574. DataSet := ds;
  575. LookupDataSet := lkpDs;
  576. LookupKeyFields:='name';
  577. LookupResultField:='ID';
  578. KeyFields := 'name';
  579. end;
  580. ds.OnCalcFields:=DatasetNotifyEvent;
  581. lkpds.Open;
  582. open;
  583. Next;
  584. Buffer:=ds.ActiveBuffer;
  585. // When LookupCache is true, use the lookupCache (Here with the 'wrong' value 412)
  586. AFld3.LookupList.Clear;
  587. AFld3.LookupList.Add('TestName2',412);
  588. AFld3.LookupCache:=True;
  589. // CalculateFields is the only way to call CalcLookupValue
  590. THackDataset(ds).CalculateFields(Buffer);
  591. AssertEquals(412,AFld3.AsInteger);
  592. // Without lookupcache, return the right value
  593. AFld3.LookupCache:=False;
  594. THackDataset(ds).CalculateFields(Buffer);
  595. AssertEquals(2,AFld3.AsInteger);
  596. // If there's no LookupDataset, the result should be Null
  597. AFld3.LookupDataSet:= nil;
  598. THackDataset(ds).CalculateFields(Buffer);
  599. AssertTrue(AFld3.IsNull);
  600. // If there's no LookupDataset, the result should be Null
  601. AFld3.LookupDataSet:= nil;
  602. THackDataset(ds).CalculateFields(Buffer);
  603. AssertTrue(AFld3.IsNull);
  604. // Same holds for closed lookupdatasets
  605. AFld3.LookupDataSet:= lkpDs;
  606. lkpDs.Close;
  607. THackDataset(ds).CalculateFields(Buffer);
  608. AssertTrue(AFld3.IsNull);
  609. lkpds.Open;
  610. // Thing are getting interesting with multiple fields in the key:
  611. AFld3.LookupKeyFields:='name;id';
  612. AFld3.KeyFields := 'name;id';
  613. AFld3.LookupCache:=True;
  614. AFld3.LookupList.Clear;
  615. AFld3.LookupList.Add(VarArrayOf(['TestName2',2]),112);
  616. AFld3.LookupCache:=True;
  617. THackDataset(ds).CalculateFields(Buffer);
  618. AssertEquals(112,AFld3.AsInteger);
  619. AFld3.LookupCache:=False;
  620. // Now without a LookupCache
  621. // Disabled this part, since tDbf has problems with multiple-field keys
  622. {
  623. AFld3.LookupKeyFields:='name;id';
  624. AFld3.KeyFields := 'name;id';
  625. THackDataset(ds).CalculateFields(Buffer);
  626. AssertEquals(2,AFld3.AsInteger);}
  627. end;
  628. end;
  629. procedure TTestDatasources.TestEnableControls;
  630. var ds: TDataset;
  631. ADataLink : TTestDataLink;
  632. ADataSource : TDataSource;
  633. begin
  634. ds := DBConnector.GetTraceDataset(False);
  635. ADatasource := TDataSource.Create(nil);
  636. ADatalink := TTestDataLink.Create;
  637. ADatalink.DataSource := aDatasource;
  638. ADataSource.DataSet := ds;
  639. with ds do
  640. begin
  641. Open;
  642. // If DisableControls isn't called, nothing should happen.
  643. DataEvents:='';
  644. EnableControls;
  645. AssertEquals('',DataEvents);
  646. DisableControls;
  647. DisableControls;
  648. // DisableControls is called twice. Ie: first call to enablecontrols should
  649. // still do nothing.
  650. DataEvents:='';
  651. EnableControls;
  652. AssertEquals('',DataEvents);
  653. // On this call to Enablecontrols, the controls should get enabled again:
  654. DataEvents:='';
  655. EnableControls;
  656. AssertEquals('SetCurrentRecord;deDataSetChange:0;',DataEvents);
  657. // If the state of the dataset has been changed while the controls were
  658. // disabled, then an deUpdateState event should be raised
  659. DisableControls;
  660. THackDataset(ds).SetState(dsSetKey);
  661. DataEvents:='';
  662. EnableControls;
  663. AssertEquals('deUpdateState:0;SetCurrentRecord;deDataSetChange:0;',DataEvents);
  664. THackDataset(ds).SetState(dsBrowse);
  665. // If the dataset is closed while the controls were disabled, then only
  666. // an deUpdateState event should occur.
  667. DisableControls;
  668. Close;
  669. DataEvents:='';
  670. EnableControls;
  671. AssertEquals('deUpdateState:0;',DataEvents);
  672. // And the same happens if the dataset was opened
  673. DisableControls;
  674. Open;
  675. DataEvents:='';
  676. EnableControls;
  677. AssertEquals('deUpdateState:0;',DataEvents);
  678. close;
  679. end;
  680. ADataLink.Free;
  681. ADataSource.Free;
  682. end;
  683. initialization
  684. if uppercase(dbconnectorname)='DBF' then RegisterTest(TTestDatasources);
  685. end.