/packages/fcl-db/tests/testdbbasics.pas
Pascal | 2722 lines | 2242 code | 382 blank | 98 comment | 91 complexity | 05b1e07fe66a193dbcbf7a5e1840f220 MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
Large files files are truncated, but you can click here to view the full file
1unit TestDBBasics; 2 3{$IFDEF FPC} 4 {$mode Delphi}{$H+} 5{$ENDIF} 6 7interface 8 9uses 10{$IFDEF FPC} 11 fpcunit, testutils, testregistry, testdecorator, 12{$ELSE FPC} 13 TestFramework, 14{$ENDIF FPC} 15 Classes, SysUtils, db, ToolsUnit; 16 17type 18 19 { TTestDBBasics } 20 21 TTestDBBasics = class(TTestCase) 22 private 23 procedure TestfieldDefinition(AFieldType : TFieldType;ADatasize : integer;var ADS : TDataset; var AFld: TField); 24 procedure TestcalculatedField_OnCalcfields(DataSet: TDataSet); 25 26 protected 27 procedure SetUp; override; 28 procedure TearDown; override; 29 published 30 procedure TestSetFieldValues; 31 procedure TestGetFieldValues; 32 33 procedure TestSupportIntegerFields; 34 procedure TestSupportSmallIntFields; 35 procedure TestSupportStringFields; 36 procedure TestSupportBooleanFields; 37 procedure TestSupportFloatFields; 38 procedure TestSupportLargeIntFields; 39 procedure TestSupportDateFields; 40 procedure TestSupportTimeFields; 41 procedure TestSupportCurrencyFields; 42 procedure TestSupportBCDFields; 43 procedure TestSupportfmtBCDFields; 44 procedure TestSupportFixedStringFields; 45 procedure TestSupportBlobFields; 46 procedure TestSupportMemoFields; 47 48 procedure TestDoubleClose; 49 procedure TestCalculatedField; 50 procedure TestAssignFieldftString; 51 procedure TestAssignFieldftFixedChar; 52 procedure TestSelectQueryBasics; 53 procedure TestPostOnlyInEditState; 54 procedure TestMove; // bug 5048 55 procedure TestActiveBufferWhenClosed; 56 procedure TestEOFBOFClosedDataset; 57 procedure TestLayoutChangedEvents; 58 procedure TestDataEventsResync; 59 procedure TestRecordcountAfterReopen; // partly bug 8228 60 procedure TestdeFieldListChange; 61 procedure TestExceptionLocateClosed; // bug 13938 62 procedure TestCanModifySpecialFields; 63 procedure TestDetectionNonMatchingDataset; 64 end; 65 66 { TTestBufDatasetDBBasics } 67{$ifdef fpc} 68 TTestBufDatasetDBBasics = class(TTestCase) 69 private 70 procedure FTestXMLDatasetDefinition(ADataset : TDataset); 71 procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean); 72 protected 73 procedure SetUp; override; 74 procedure TearDown; override; 75 published 76 procedure TestClosedIndexFieldNames; // bug 16695 77 procedure TestFileNameProperty; 78 procedure TestClientDatasetAsMemDataset; 79 procedure TestSaveAsXML; 80 procedure TestIsEmpty; 81 procedure TestBufDatasetCancelUpd; //bug 6938 82 procedure TestBufDatasetCancelUpd1; 83 procedure TestMultipleDeleteUpdateBuffer; 84 procedure TestDoubleDelete; 85 procedure TestReadOnly; 86 procedure TestMergeChangeLog; 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 97 procedure TestAddIndex; 98 procedure TestAddDescIndex; 99 procedure TestAddCaseInsIndex; 100 procedure TestInactSwitchIndex; 101 102 procedure TestAddIndexActiveDS; 103 procedure TestAddIndexEditDS; 104 105 procedure TestIndexFieldNames; 106 procedure TestIndexFieldNamesAct; 107 108 procedure TestIndexCurRecord; 109 110 procedure TestAddDblIndex; 111 procedure TestIndexEditRecord; 112 procedure TestIndexAppendRecord; 113 end; 114 115{$endif fpc} 116 117 TTestUniDirectionalDBBasics = class(TTestDBBasics) 118 end; 119 120 { TTestCursorDBBasics } 121 122 TTestCursorDBBasics = class(TTestCase) 123 private 124 procedure TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean); 125 procedure FTestDelete1(TestCancelUpdate : boolean); 126 procedure FTestDelete2(TestCancelUpdate : boolean); 127 protected 128 procedure SetUp; override; 129 procedure TearDown; override; 130 published 131 procedure TestCancelUpdDelete1; 132 procedure TestCancelUpdDelete2; 133 134 procedure TestAppendInsertRecord; 135 136 procedure TestBookmarks; 137 procedure TestBookmarkValid; 138 139 procedure TestDelete1; 140 procedure TestDelete2; 141 142 procedure TestLocate; 143 procedure TestLocateCaseIns; 144 procedure TestLocateCaseInsInts; 145 146 procedure TestFirst; 147 procedure TestIntFilter; 148 procedure TestOnFilter; 149 procedure TestStringFilter; 150 151 procedure TestNullAtOpen; 152 153 procedure TestAppendOnEmptyDataset; 154 procedure TestInsertOnEmptyDataset; 155 156 procedure TestEofAfterFirst; //bug 7211 157 procedure TestLastAppendCancel; // bug 5058 158 procedure TestRecNo; // bug 5061 159 procedure TestSetRecNo; // bug 6919 160 procedure TestBug7007; 161 procedure TestBug6893; 162 procedure TestRequired; 163 procedure TestOldValueObsolete; 164 procedure TestOldValue; 165 procedure TestModified; 166 end; 167 168 169 { TDBBasicsUniDirectionalTestSetup } 170{$ifdef fpc} 171 TDBBasicsUniDirectionalTestSetup = class(TDBBasicsTestSetup) 172 protected 173 procedure OneTimeSetup; override; 174 procedure OneTimeTearDown; override; 175 end; 176{$endif fpc} 177implementation 178 179uses 180{$ifdef fpc} 181 bufdataset, 182 sqldb, 183{$endif fpc} 184 variants, 185 strutils, 186 FmtBCD; 187 188type THackDataLink=class(TdataLink); 189 190{ TTestCursorDBBasics } 191 192procedure TTestCursorDBBasics.SetUp; 193begin 194 DBConnector.StartTest; 195end; 196 197procedure TTestCursorDBBasics.TearDown; 198begin 199 DBConnector.StopTest; 200end; 201 202procedure TTestCursorDBBasics.TestAppendOnEmptyDataset; 203begin 204 with DBConnector.GetNDataset(0) do 205 begin 206 open; 207 CheckTrue(CanModify); 208 CheckTrue(eof); 209 CheckTrue(bof); 210 append; 211 FieldByName('id').AsInteger:=0; 212 CheckFalse(Bof); 213 CheckTrue(Eof); 214 post; 215 CheckFalse(eof); 216 CheckFalse(bof); 217 end; 218end; 219 220procedure TTestCursorDBBasics.TestInsertOnEmptyDataset; 221begin 222 with DBConnector.GetNDataset(0) do 223 begin 224 open; 225 CheckTrue(CanModify); 226 CheckTrue(eof); 227 CheckTrue(bof); 228 CheckTrue(IsEmpty); 229 insert; 230 FieldByName('id').AsInteger:=0; 231 CheckTrue(Bof); 232 CheckTrue(Eof); 233 CheckFalse(IsEmpty); 234 post; 235 CheckFalse(IsEmpty); 236 CheckFalse(eof); 237 CheckFalse(bof); 238 end; 239end; 240 241procedure TTestDBBasics.TestSelectQueryBasics; 242var b : TFieldType; 243begin 244 with DBConnector.GetNDataset(1) do 245 begin 246 Open; 247 248 if IsUniDirectional then 249 CheckEquals(-1,RecNo) 250 else 251 CheckEquals(1,RecNo); 252 CheckEquals(1,RecordCount); 253 254 CheckEquals(2,FieldCount); 255 256 CheckTrue(CompareText('ID',fields[0].FieldName)=0); 257 CheckTrue(CompareText('ID',fields[0].DisplayName)=0); 258 CheckTrue(ftInteger=fields[0].DataType, 'The datatype of the field ''ID'' is incorrect, it should be ftInteger'); 259 260 CheckTrue(CompareText('NAME',fields[1].FieldName)=0); 261 CheckTrue(CompareText('NAME',fields[1].DisplayName)=0); 262 CheckTrue(ftString=fields[1].DataType); 263 264 CheckEquals(1,fields[0].Value); 265 CheckEquals('TestName1',fields[1].Value); 266 267 Close; 268 end; 269end; 270 271procedure TTestDBBasics.TestPostOnlyInEditState; 272begin 273 with DBConnector.GetNDataset(1) do 274 begin 275 open; 276 CheckException(Post,EDatabaseError,'Post was called in a non-edit state'); 277 end; 278end; 279 280procedure TTestDBBasics.TestMove; 281var i,count : integer; 282 aDatasource : TDataSource; 283 aDatalink : TDataLink; 284 ABufferCount : Integer; 285 286begin 287 aDatasource := TDataSource.Create(nil); 288 aDatalink := TTestDataLink.Create; 289 try 290 aDatalink.DataSource := aDatasource; 291 ABufferCount := 11; 292 aDatalink.BufferCount := ABufferCount; 293 DataEvents := ''; 294 for count := 0 to 32 do 295 begin 296 aDatasource.DataSet := DBConnector.GetNDataset(count); 297 with aDatasource.Dataset do 298 begin 299 i := 1; 300 Open; 301 CheckEquals('deUpdateState:0;',DataEvents); 302 DataEvents := ''; 303 while not EOF do 304 begin 305 CheckEquals(i,fields[0].AsInteger); 306 CheckEquals('TestName'+inttostr(i),fields[1].AsString); 307 inc(i); 308 309 Next; 310 if (i > ABufferCount) and not EOF then 311 CheckEquals('deCheckBrowseMode:0;deDataSetScroll:-1;DataSetScrolled:1;DataSetChanged;',DataEvents) 312 else 313 CheckEquals('deCheckBrowseMode:0;deDataSetScroll:0;DataSetScrolled:0;DataSetChanged;',DataEvents); 314 DataEvents := ''; 315 end; 316 CheckEquals(count,i-1); 317 close; 318 CheckEquals('deUpdateState:0;',DataEvents); 319 DataEvents := ''; 320 end; 321 end; 322 finally 323 aDatalink.Free; 324 aDatasource.Free; 325 end; 326end; 327 328procedure TTestDBBasics.TestdeFieldListChange; 329 330var i,count : integer; 331 aDatasource : TDataSource; 332 aDatalink : TDataLink; 333 ds : TDataset; 334 335begin 336 aDatasource := TDataSource.Create(nil); 337 aDatalink := TTestDataLink.Create; 338 aDatalink.DataSource := aDatasource; 339 ds := DBConnector.GetNDataset(1); 340 with ds do 341 begin 342 aDatasource.DataSet := ds; 343 DataEvents := ''; 344 open; 345 Fields.add(tfield.Create(DBConnector.GetNDataset(1))); 346 CheckEquals('deUpdateState:0;deFieldListChange:0;',DataEvents); 347 DataEvents := ''; 348 fields.Clear; 349 CheckEquals('deFieldListChange:0;',DataEvents) 350 end; 351 aDatasource.Free; 352 aDatalink.Free; 353end; 354 355 356procedure TTestDBBasics.TestActiveBufferWhenClosed; 357begin 358 with DBConnector.GetNDataset(0) do 359 begin 360{$ifdef fpc} 361 AssertNull(ActiveBuffer); 362{$endif fpc} 363 open; 364 CheckFalse(ActiveBuffer = nil,'Activebuffer of an empty dataset shouldn''t be nil'); 365 end; 366end; 367 368procedure TTestDBBasics.TestEOFBOFClosedDataset; 369begin 370 with DBConnector.GetNDataset(1) do 371 begin 372 CheckTrue(EOF); 373 CheckTrue(BOF); 374 open; 375 CheckTrue(BOF, 'No BOF when opened non-empty dataset'); 376 CheckFalse(EOF, 'EOF after opened non-empty dataset'); 377 close; 378 CheckTrue(EOF); 379 CheckTrue(BOF); 380 end; 381end; 382 383procedure TTestDBBasics.TestLayoutChangedEvents; 384var aDatasource : TDataSource; 385 aDatalink : TDataLink; 386 ds : tdataset; 387 388begin 389 aDatasource := TDataSource.Create(nil); 390 aDatalink := TTestDataLink.Create; 391 try 392 aDatalink.DataSource := aDatasource; 393 ds := DBConnector.GetNDataset(6); 394 aDatasource.DataSet:=ds; 395 with ds do 396 begin 397 open; 398 399 DataEvents := ''; 400 DisableControls; 401 Active:=False; 402 Active:=True; 403 EnableControls; 404 CheckEquals('deLayoutChange:0;DataSetChanged;',DataEvents); 405 406 close; 407 end; 408 finally 409 aDatasource.Free; 410 aDatalink.Free; 411 end; 412end; 413 414procedure TTestDBBasics.TestDataEventsResync; 415var i,count : integer; 416 aDatasource : TDataSource; 417 aDatalink : TDataLink; 418 ds : tdataset; 419 420begin 421 aDatasource := TDataSource.Create(nil); 422 aDatalink := TTestDataLink.Create; 423 try 424 aDatalink.DataSource := aDatasource; 425 ds := DBConnector.GetNDataset(6); 426 ds.BeforeScroll := DBConnector.DataEvent; 427 with ds do 428 begin 429 aDatasource.DataSet := ds; 430 open; 431 DataEvents := ''; 432 Resync([rmExact]); 433 if IsUniDirectional then 434 CheckEquals('',DataEvents) 435 else 436 CheckEquals('deDataSetChange:0;DataSetChanged;',DataEvents); 437 DataEvents := ''; 438 next; 439 CheckEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;DataSetScrolled:1;DataSetChanged;',DataEvents); 440 close; 441 end; 442 finally 443 aDatasource.Free; 444 aDatalink.Free; 445 end; 446end; 447 448procedure TTestCursorDBBasics.TestLastAppendCancel; 449 450var count : integer; 451 452begin 453 for count := 0 to 32 do with DBConnector.GetNDataset(count) do 454 begin 455 open; 456 457 Last; 458 Append; 459 Cancel; 460 461 CheckEquals(count,fields[0].asinteger); 462 CheckEquals(count,RecordCount); 463 464 Close; 465 466 end; 467end; 468 469procedure TTestCursorDBBasics.TestRecNo; 470var i : longint; 471 passed : boolean; 472begin 473 with DBConnector.GetNDataset(0) do 474 begin 475 // Accessing RecNo on a closed dataset should raise an EDatabaseError or should 476 // return 0 477 passed := false; 478 try 479 i := recno; 480 except on E: Exception do 481 begin 482 passed := E.classname = EDatabaseError.className 483 end; 484 end; 485 if not passed then 486 CheckEquals(0,RecNo,'Failed to get the RecNo from a closed dataset'); 487 488 // Accessing Recordcount on a closed dataset should raise an EDatabaseError or should 489 // return 0 490 passed := false; 491 try 492 i := recordcount; 493 except on E: Exception do 494 begin 495 passed := E.classname = EDatabaseError.className 496 end; 497 end; 498 if not passed then 499 CheckEquals(0,RecNo,'Failed to get the Recordcount from a closed dataset'); 500 501 Open; 502 503 CheckEquals(0,RecordCount); 504 CheckEquals(0,RecNo); 505 506 first; 507 CheckEquals(0,RecordCount); 508 CheckEquals(0,RecNo); 509 510 last; 511 CheckEquals(0,RecordCount); 512 CheckEquals(0,RecNo); 513 514 append; 515 CheckEquals(0,RecNo); 516 CheckEquals(0,RecordCount); 517 518 first; 519 CheckEquals(0,RecNo); 520 CheckEquals(0,RecordCount); 521 522 append; 523 FieldByName('id').AsInteger := 1; 524 CheckEquals(0,RecNo); 525 CheckEquals(0,RecordCount); 526 527 first; 528 CheckEquals(1,RecNo); 529 CheckEquals(1,RecordCount); 530 531 last; 532 CheckEquals(1,RecNo); 533 CheckEquals(1,RecordCount); 534 535 append; 536 FieldByName('id').AsInteger := 1; 537 CheckEquals(0,RecNo); 538 CheckEquals(1,RecordCount); 539 540 Close; 541 end; 542end; 543 544procedure TTestCursorDBBasics.TestSetRecNo; 545begin 546 with DBConnector.GetNDataset(15) do 547 begin 548 Open; 549 RecNo := 1; 550 CheckEquals(1,fields[0].AsInteger); 551 CheckEquals(1,RecNo); 552 553 RecNo := 2; 554 CheckEquals(2,fields[0].AsInteger); 555 CheckEquals(2,RecNo); 556 557 RecNo := 8; 558 CheckEquals(8,fields[0].AsInteger); 559 CheckEquals(8,RecNo); 560 561 RecNo := 15; 562 CheckEquals(15,fields[0].AsInteger); 563 CheckEquals(15,RecNo); 564 565 RecNo := 3; 566 CheckEquals(3,fields[0].AsInteger); 567 CheckEquals(3,RecNo); 568 569 RecNo := 14; 570 CheckEquals(14,fields[0].AsInteger); 571 CheckEquals(14,RecNo); 572 573 RecNo := 15; 574 CheckEquals(15,fields[0].AsInteger); 575 CheckEquals(15,RecNo); 576 577 // test for exceptions... 578{ RecNo := 16; 579 CheckEquals(15,fields[0].AsInteger); 580 CheckEquals(15,RecNo);} 581 582 Close; 583 end; 584end; 585 586procedure TTestCursorDBBasics.TestRequired; 587begin 588 with DBConnector.GetNDataset(2) do 589 begin 590 Open; 591 FieldByName('ID').Required := True; 592 Append; 593 CheckException(Post, EDatabaseError); 594 FieldByName('ID').AsInteger := 1000; 595 Post; 596 Close; 597 end; 598end; 599 600procedure TTestDBBasics.TestExceptionLocateClosed; 601var passed: boolean; 602begin 603 with DBConnector.GetNDataset(15) do 604 begin 605 passed := false; 606 try 607 locate('name','TestName1',[]); 608 except on E: Exception do 609 begin 610 passed := E.classname = EDatabaseError.className 611 end; 612 end; 613 CheckTrue(passed); 614 end; 615end; 616 617 618procedure TTestDBBasics.SetUp; 619begin 620 DBConnector.StartTest; 621end; 622 623procedure TTestDBBasics.TearDown; 624begin 625 DBConnector.StopTest; 626end; 627 628procedure TTestCursorDBBasics.TestOldValueObsolete; 629var v : variant; 630 bufds: TDataset; 631begin 632 // this test was created as reaction to AV bug found in TCustomBufDataset.GetFieldData 633 // when retrieving OldValue (State=dsOldValue) of newly inserted or appended record. 634 // In this case was CurrBuff set to nil (and not checked), 635 // because OldValuesBuffer for just inserted record is nil. See rev.17704 636 // (So purpose of this test isn't test InsertRecord on empty dataset or so) 637 // Later was this test replaced by more complex TestOldValue (superset of old test), 638 // but next to it was restored back also original test. 639 // So now we have two tests which test same thing, where this 'old' one is subset of 'new' one 640 // Ideal solution would be remove this 'old' test as it does not test anything what is not tested elsewhere ... 641 bufds := DBConnector.GetNDataset(0) as TDataset; 642 bufds.Open; 643 bufds.InsertRecord([0,'name']); 644 v := VarToStr(bufds.fields[1].OldValue); 645end; 646 647procedure TTestCursorDBBasics.TestOldValue; 648begin 649 with DBConnector.GetNDataset(1) as TDataset do 650 begin; 651 Open; 652 First; 653 CheckEquals('1', VarToStr(Fields[0].OldValue), 'Original value'); // unmodified original value 654 CheckTrue(UpdateStatus=usUnmodified, 'Unmodified'); 655 656 Edit; 657 Fields[0].AsInteger := -1; 658 CheckEquals('1', VarToStr(Fields[0].OldValue), 'Editing'); // dsEdit, there is no update-buffer yet 659 Post; 660 CheckEquals('1', VarToStr(Fields[0].OldValue), 'Edited'); // there is already update-buffer 661 CheckTrue(UpdateStatus=usModified, 'Modified'); 662 663 Append; 664 Fields[0].AsInteger := -2; 665 CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserting'); // dsInsert, there is no update-buffer yet 666 Post; 667 CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserted'); // there is already update-buffer 668 CheckTrue(UpdateStatus=usInserted, 'Inserted'); 669 end; 670end; 671 672procedure TTestCursorDBBasics.TestModified; 673begin 674 // Tests TDataSet.Modified property 675 with DBConnector.GetNDataset(true,1) as TDataset do 676 begin 677 Open; 678 CheckFalse(Modified); 679 680 Edit; 681 CheckFalse(Modified, 'After Edit'); 682 Fields[1].AsString := Fields[1].AsString; 683 CheckTrue(Modified, 'After change'); 684 Post; 685 CheckFalse(Modified, 'After Post'); 686 687 Append; 688 CheckFalse(Modified, 'After Append'); 689 Fields[0].AsInteger := 100; 690 CheckTrue(Modified, 'After change'); 691 Cancel; 692 CheckFalse(Modified, 'After Cancel'); 693 694 Close; 695 end; 696end; 697 698procedure TTestDBBasics.TestCanModifySpecialFields; 699var ds : TDataset; 700 lds : TDataset; 701 fld : TField; 702begin 703 lds := DBConnector.GetNDataset(10); 704 ds := DBConnector.GetNDataset(5); 705 with ds do 706 begin 707 Fld := TIntegerField.Create(ds); 708 Fld.FieldName:='ID'; 709 Fld.DataSet:=ds; 710 711 Fld := TStringField.Create(ds); 712 Fld.FieldName:='LookupFld'; 713 Fld.FieldKind:=fkLookup; 714 Fld.DataSet:=ds; 715 Fld.LookupDataSet:=lds; 716 Fld.LookupResultField:='NAME'; 717 Fld.LookupKeyFields:='ID'; 718 Fld.KeyFields:='ID'; 719 720 lds.Open; 721 Open; 722 if IsUniDirectional then 723 // The CanModify property is always False for UniDirectional datasets 724 CheckFalse(FieldByName('ID').CanModify) 725 else 726 CheckTrue(FieldByName('ID').CanModify); 727 CheckFalse(FieldByName('LookupFld').CanModify); 728 CheckFalse(FieldByName('ID').ReadOnly); 729 CheckFalse(FieldByName('LookupFld').ReadOnly); 730 731 CheckEquals(1,FieldByName('ID').AsInteger); 732 if IsUniDirectional then 733 // Lookup fields are not supported by UniDirectional datasets 734 CheckTrue(FieldByName('LookupFld').IsNull) 735 else 736 CheckEquals('TestName1',FieldByName('LookupFld').AsString); 737 Next; 738 Next; 739 CheckEquals(3,FieldByName('ID').AsInteger); 740 if IsUniDirectional then 741 CheckTrue(FieldByName('LookupFld').IsNull) 742 else 743 CheckEquals('TestName3',FieldByName('LookupFld').AsString); 744 745 Close; 746 lds.Close; 747 end; 748end; 749 750procedure TTestDBBasics.TestDetectionNonMatchingDataset; 751var 752 F: TField; 753 ds: tdataset; 754begin 755 // TDataset.Bindfields should detect problems when the underlying data does 756 // not reflect the fields of the dataset. This test is to check if this is 757 // really done. 758 ds := DBConnector.GetNDataset(true,6); 759 with ds do 760 begin 761 open; 762 close; 763 764 F := TStringField.Create(ds); 765 F.FieldName:='DOES_NOT_EXIST'; 766 F.DataSet:=ds; 767 F.Size:=50; 768 769 CheckException(open,EDatabaseError); 770 end; 771end; 772 773procedure TTestCursorDBBasics.TestAppendInsertRecord; 774begin 775 with DBConnector.GetNDataset(true,6) do 776 begin 777 open; 778 // InsertRecord should insert a record, set the values, post the record and 779 // make the new record active. 780 InsertRecord([152,'TestInsRec']); 781 CheckEquals(152,fields[0].AsInteger); 782 CheckEquals('TestInsRec',fields[1].AsString); 783 CheckTrue(state=dsBrowse); 784 785 // AppendRecord should append a record, further the same as InsertRecord 786 AppendRecord([151,'TestInsRec']); 787 CheckEquals(151,fields[0].AsInteger); 788 CheckEquals('TestInsRec',fields[1].AsString); 789 CheckTrue(state=dsBrowse); 790 next; 791 CheckTrue(EOF); 792 end; 793end; 794 795procedure TTestCursorDBBasics.TestBookmarks; 796var BM1,BM2,BM3,BM4,BM5 : TBookmark; 797begin 798 with DBConnector.GetNDataset(true,14) do 799 begin 800{$ifdef fpc} 801 AssertNull(GetBookmark); 802{$endif fpc} 803 open; 804 BM1:=GetBookmark; // id=1, BOF 805 next;next; 806 BM2:=GetBookmark; // id=3 807 next;next;next; 808 BM3:=GetBookmark; // id=6 809 next;next;next;next;next;next;next;next; 810 BM4:=GetBookmark; // id=14 811 next; 812 BM5:=GetBookmark; // id=14, EOF 813 814 GotoBookmark(BM2); 815 CheckEquals(3,FieldByName('id').AsInteger); 816 817 GotoBookmark(BM1); 818 CheckEquals(1,FieldByName('id').AsInteger); 819 820 GotoBookmark(BM3); 821 CheckEquals(6,FieldByName('id').AsInteger); 822 823 GotoBookmark(BM4); 824 CheckEquals(14,FieldByName('id').AsInteger); 825 826 GotoBookmark(BM3); 827 CheckEquals(6,FieldByName('id').AsInteger); 828 829 GotoBookmark(BM5); 830 CheckEquals(14,FieldByName('id').AsInteger); 831 832 GotoBookmark(BM1); 833 CheckEquals(1,FieldByName('id').AsInteger); 834 835 next; 836 delete; 837 838 GotoBookmark(BM2); 839 CheckEquals(3,FieldByName('id').AsInteger); 840 841 delete;delete; 842 843 GotoBookmark(BM3); 844 CheckEquals(6,FieldByName('id').AsInteger); 845 846 GotoBookmark(BM1); 847 CheckEquals(1,FieldByName('id').AsInteger); 848 insert; 849 fieldbyname('id').AsInteger:=20; 850 insert; 851 fieldbyname('id').AsInteger:=21; 852 insert; 853 fieldbyname('id').AsInteger:=22; 854 insert; 855 fieldbyname('id').AsInteger:=23; 856 post; 857 858 GotoBookmark(BM3); 859 CheckEquals(6,FieldByName('id').AsInteger); 860 861 GotoBookmark(BM1); 862 CheckEquals(1,FieldByName('id').AsInteger); 863 864 GotoBookmark(BM5); 865 CheckEquals(14,FieldByName('id').AsInteger); 866 end; 867end; 868 869procedure TTestCursorDBBasics.TestBookmarkValid; 870var BM1,BM2,BM3,BM4,BM5 : TBookmark; 871begin 872 with DBConnector.GetNDataset(true,14) do 873 begin 874 BM1 := Nil; 875 CheckFalse(BookmarkValid(BM1)); 876 open; 877 BM1:=GetBookmark; // id=1, BOF 878 CheckTrue(BookmarkValid(BM1)); 879 next;next; 880 BM2:=GetBookmark; // id=3 881 CheckTrue(BookmarkValid(BM2)); 882 next;next;next; 883 BM3:=GetBookmark; // id=6 884 CheckTrue(BookmarkValid(BM3)); 885 next;next;next;next;next;next;next;next; 886 BM4:=GetBookmark; // id=14 887 CheckTrue(BookmarkValid(BM4)); 888 next; 889 BM5:=GetBookmark; // id=14, EOF 890 CheckTrue(BookmarkValid(BM5)); 891 892 CheckTrue(BookmarkValid(BM4)); 893 CheckTrue(BookmarkValid(BM3)); 894 CheckTrue(BookmarkValid(BM2)); 895 CheckTrue(BookmarkValid(BM1)); 896 GotoBookmark(BM2); 897 CheckTrue(BookmarkValid(BM5)); 898 CheckTrue(BookmarkValid(BM4)); 899 CheckTrue(BookmarkValid(BM3)); 900 CheckTrue(BookmarkValid(BM2)); 901 CheckTrue(BookmarkValid(BM1)); 902 end; 903end; 904 905procedure TTestCursorDBBasics.TestLocate; 906begin 907 with DBConnector.GetNDataset(true,13) do 908 begin 909 open; 910 CheckTrue(Locate('id',vararrayof([5]),[])); 911 CheckEquals(5,FieldByName('id').AsInteger); 912 CheckFalse(Locate('id',vararrayof([15]),[])); 913 CheckTrue(Locate('id',vararrayof([12]),[])); 914 CheckEquals(12,FieldByName('id').AsInteger); 915 close; 916 open; 917 CheckTrue(Locate('id',vararrayof([12]),[])); 918 CheckEquals(12,FieldByName('id').AsInteger); 919 CheckTrue(Locate('id;name',vararrayof([4,'TestName4']),[])); 920 CheckEquals(4,FieldByName('id').AsInteger); 921 922 CheckFalse(Locate('id;name',vararrayof([4,'TestName5']),[])); 923 924 end; 925end; 926 927procedure TTestCursorDBBasics.TestLocateCaseIns; 928// Tests case insensitive locate, also partial key locate, both against string fields. 929// Together with TestLocateCaseInsInts, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use 930begin 931 with DBConnector.GetNDataset(true,13) do 932 begin 933 open; 934 CheckFalse(Locate('name',vararrayof(['TEstName5']),[])); 935 CheckTrue(Locate('name',vararrayof(['TEstName5']),[loCaseInsensitive])); 936 CheckEquals(5,FieldByName('id').AsInteger); 937 938 CheckFalse(Locate('name',vararrayof(['TestN']),[])); 939 CheckTrue(Locate('name',vararrayof(['TestN']),[loPartialKey])); 940 941 CheckFalse(Locate('name',vararrayof(['TestNA']),[loPartialKey])); 942 CheckTrue(Locate('name',vararrayof(['TestNA']),[loPartialKey, loCaseInsensitive])); 943 close; 944 end; 945end; 946 947procedure TTestCursorDBBasics.TestLocateCaseInsInts; 948// Tests case insensitive locate, also partial key locate, both against integer fields. 949// Together with TestLocateCaseIns, checks 23509 DBF: locate with loPartialkey behaviour differs depending on index use 950begin 951 with DBConnector.GetNDataset(true,13) do 952 begin 953 open; 954 // To really test bug 23509: we should first have a record that matches greater than for non-string locate: 955 first; 956 insert; 957 fieldbyname('id').AsInteger:=55; 958 fieldbyname('name').AsString:='TestName55'; 959 post; 960 first; 961 962 CheckTrue(Locate('id',vararrayof([5]),[])); 963 CheckEquals(5,FieldByName('id').AsInteger); 964 first; 965 966 CheckTrue(Locate('id',vararrayof([5]),[loCaseInsensitive])); 967 CheckEquals(5,FieldByName('id').AsInteger); 968 first; 969 970 // Check specifying partial key doesn't influence search results 971 CheckTrue(Locate('id',vararrayof([5]),[loPartialKey])); 972 CheckEquals(5,FieldByName('id').AsInteger); 973 first; 974 975 CheckTrue(Locate('id',vararrayof([5]),[loPartialKey, loCaseInsensitive])); 976 CheckEquals(5,FieldByName('id').AsInteger); 977 978 close; 979 end; 980end; 981 982procedure TTestDBBasics.TestSetFieldValues; 983var PassException : boolean; 984begin 985 with DBConnector.GetNDataset(true,11) do 986 begin 987 open; 988 // First and Next methods are supported by UniDirectional datasets 989 first; 990 if IsUniDirectional then 991 CheckException(Edit, EDatabaseError) 992 else 993 begin 994 edit; 995 FieldValues['id']:=5; 996 post; 997 CheckEquals('TestName1',FieldByName('name').AsString); 998 CheckEquals(5,FieldByName('id').AsInteger); 999 edit; 1000 FieldValues['name']:='FieldValuesTestName'; 1001 post; 1002 CheckEquals('FieldValuesTestName',FieldByName('name').AsString); 1003 CheckEquals(5,FieldByName('id').AsInteger); 1004 edit; 1005 FieldValues['id;name']:= VarArrayOf([243,'ValuesTestName']); 1006 post; 1007 CheckEquals('ValuesTestName',FieldByName('name').AsString); 1008 CheckEquals(243,FieldByName('id').AsInteger); 1009 1010 PassException:=false; 1011 try 1012 edit; 1013 FieldValues['id;name;fake']:= VarArrayOf([243,'ValuesTestName',4]); 1014 except 1015 on E: EDatabaseError do PassException := True; 1016 end; 1017 post; 1018 CheckTrue(PassException); 1019 end; 1020 end; 1021end; 1022 1023procedure TTestDBBasics.TestGetFieldValues; 1024var AVar : Variant; 1025 PassException : boolean; 1026begin 1027 with DBConnector.GetNDataset(true,14) do 1028 begin 1029 open; 1030 AVar:=FieldValues['id']; 1031 CheckEquals(AVar,1); 1032 1033 AVar:=FieldValues['name']; 1034 CheckEquals(AVar,'TestName1'); 1035 1036 AVar:=FieldValues['id;name']; 1037 CheckEquals(AVar[0],1); 1038 CheckEquals(AVar[1],'TestName1'); 1039 1040 AVar:=FieldValues['name;id;']; 1041 CheckEquals(AVar[1],1); 1042 CheckEquals(AVar[0],'TestName1'); 1043 1044 PassException:=false; 1045 try 1046 AVar:=FieldValues['name;id;fake']; 1047 except 1048 on E: EDatabaseError do PassException := True; 1049 end; 1050 CheckTrue(PassException); 1051 1052 end; 1053end; 1054 1055procedure TTestCursorDBBasics.TestFirst; 1056var i : integer; 1057begin 1058 with DBConnector.GetNDataset(true,14) do 1059 begin 1060 open; 1061 CheckEquals(1,FieldByName('ID').AsInteger); 1062 First; 1063 CheckEquals(1,FieldByName('ID').AsInteger); 1064 next; 1065 CheckEquals(2,FieldByName('ID').AsInteger); 1066 First; 1067 CheckEquals(1,FieldByName('ID').AsInteger); 1068 for i := 0 to 12 do 1069 next; 1070 CheckEquals(14,FieldByName('ID').AsInteger); 1071 First; 1072 CheckEquals(1,FieldByName('ID').AsInteger); 1073 close; 1074 end; 1075end; 1076 1077procedure TTestCursorDBBasics.TestDelete1; 1078begin 1079 FTestDelete1(false); 1080end; 1081 1082procedure TTestCursorDBBasics.TestDelete2; 1083begin 1084 FTestDelete2(false); 1085end; 1086 1087procedure TTestCursorDBBasics.TestCancelUpdDelete1; 1088begin 1089 FTestDelete1(true); 1090end; 1091 1092procedure TTestCursorDBBasics.TestCancelUpdDelete2; 1093begin 1094 FTestDelete2(true); 1095end; 1096 1097procedure TTestCursorDBBasics.FTestDelete1(TestCancelUpdate : boolean); 1098// Test the deletion of records, including the first and the last one 1099var i : integer; 1100 ds : TDataset; 1101begin 1102 ds := DBConnector.GetNDataset(true,17); 1103 with ds do 1104 begin 1105 Open; 1106 1107 for i := 0 to 16 do if i mod 4=0 then 1108 delete 1109 else 1110 next; 1111 1112 First; 1113 for i := 0 to 16 do 1114 begin 1115 if i mod 4<>0 then 1116 begin 1117 CheckEquals(i+1,FieldByName('ID').AsInteger); 1118 CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString); 1119 next; 1120 end; 1121 end; 1122 end; 1123 1124{$ifdef fpc} 1125 if TestCancelUpdate then 1126 begin 1127 if not (ds is TCustomBufDataset) then 1128 Ignore('This test only applies to TCustomBufDataset and descendents.'); 1129 with TCustomBufDataset(ds) do 1130 begin 1131 CancelUpdates; 1132 1133 First; 1134 for i := 0 to 16 do 1135 begin 1136 CheckEquals(i+1,FieldByName('ID').AsInteger); 1137 CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString); 1138 next; 1139 end; 1140 1141 close; 1142 end; 1143 end; 1144{$endif} 1145end; 1146 1147procedure TTestCursorDBBasics.FTestDelete2(TestCancelUpdate : boolean); 1148// Test the deletion of edited and appended records 1149var i : integer; 1150 ds : TDataset; 1151begin 1152 ds := DBConnector.GetNDataset(true,17); 1153 with ds do 1154 begin 1155 Open; 1156 1157 for i := 0 to 16 do 1158 begin 1159 if i mod 4=0 then 1160 begin 1161 edit; 1162 fieldbyname('name').AsString:='this record will be gone soon'; 1163 post; 1164 end; 1165 next; 1166 end; 1167 1168 for i := 17 to 20 do 1169 begin 1170 append; 1171 fieldbyname('id').AsInteger:=i+1; 1172 fieldbyname('name').AsString:='TestName'+inttostr(i+1); 1173 post; 1174 end; 1175 1176 first; 1177 for i := 0 to 20 do if i mod 4=0 then 1178 delete 1179 else 1180 next; 1181 1182 First; 1183 i := 0; 1184 for i := 0 to 20 do 1185 begin 1186 if i mod 4<>0 then 1187 begin 1188 CheckEquals(i+1,FieldByName('ID').AsInteger); 1189 CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString); 1190 next; 1191 end; 1192 end; 1193 end; 1194 1195{$ifdef fpc} 1196 if TestCancelUpdate then 1197 begin 1198 if not (ds is TCustomBufDataset) then 1199 Ignore('This test only applies to TCustomBufDataset and descendents.'); 1200 with TCustomBufDataset(ds) do 1201 begin 1202 CancelUpdates; 1203 1204 First; 1205 for i := 0 to 16 do 1206 begin 1207 CheckEquals(i+1,FieldByName('ID').AsInteger); 1208 CheckEquals('TestName'+inttostr(i+1),FieldByName('NAME').AsString); 1209 next; 1210 end; 1211 1212 close; 1213 end; 1214 end; 1215{$endif fpc} 1216end; 1217 1218procedure TTestCursorDBBasics.TestOnFilterProc(DataSet: TDataSet; var Accept: Boolean); 1219 1220var a : TDataSetState; 1221begin 1222 Accept := odd(Dataset.FieldByName('ID').AsInteger); 1223end; 1224 1225procedure TTestCursorDBBasics.TestOnFilter; 1226var tel : byte; 1227begin 1228 with DBConnector.GetNDataset(15) do 1229 begin 1230 OnFilterRecord := TestOnFilterProc; 1231 Filtered := True; 1232 Open; 1233 for tel := 1 to 8 do 1234 begin 1235 CheckTrue(odd(FieldByName('ID').asinteger)); 1236 next; 1237 end; 1238 CheckTrue(EOF); 1239 end; 1240end; 1241 1242procedure TTestCursorDBBasics.TestIntFilter; 1243var tel : byte; 1244begin 1245 with DBConnector.GetNDataset(15) do 1246 begin 1247 Filtered := True; 1248 Filter := '(id>4) and (id<9)'; 1249 Open; 1250 for tel := 5 to 8 do 1251 begin 1252 CheckEquals(tel,FieldByName('ID').asinteger); 1253 next; 1254 end; 1255 CheckTrue(EOF); 1256 Close; 1257 end; 1258end; 1259 1260procedure TTestDBBasics.TestRecordcountAfterReopen; 1261var 1262 datalink1: tdatalink; 1263 datasource1: tdatasource; 1264 query1: TDataSet; 1265 1266begin 1267 query1:= DBConnector.GetNDataset(11); 1268 datalink1:= TDataLink.create; 1269 datasource1:= tdatasource.create(nil); 1270 try 1271 datalink1.datasource:= datasource1; 1272 datasource1.dataset:= query1; 1273 1274 query1.active := true; 1275 query1.active := False; 1276 CheckEquals(0, THackDataLink(datalink1).RecordCount); 1277 query1.active := true; 1278 CheckTrue(THackDataLink(datalink1).RecordCount>0); 1279 query1.active := false; 1280 finally 1281 datalink1.free; 1282 datasource1.free; 1283 end; 1284end; 1285 1286procedure TTestCursorDBBasics.TestStringFilter; 1287var tel : byte; 1288begin 1289 with DBConnector.GetNDataset(15) do 1290 begin 1291 Open; 1292 Filter := '(name=''TestName3'')'; 1293 Filtered := True; 1294 CheckFalse(EOF); 1295 CheckEquals(3,FieldByName('ID').asinteger); 1296 CheckEquals('TestName3',FieldByName('NAME').asstring); 1297 next; 1298 CheckTrue(EOF); 1299 1300 // Check partial compare 1301 Filter := '(name=''*Name5'')'; 1302 CheckFalse(EOF); 1303 CheckEquals(5,FieldByName('ID').asinteger); 1304 CheckEquals('TestName5',FieldByName('NAME').asstring); 1305 next; 1306 CheckTrue(EOF); 1307 1308 // Check case-sensitivity 1309 Filter := '(name=''*name3'')'; 1310 first; 1311 CheckTrue(EOF); 1312 1313 FilterOptions:=[foCaseInsensitive]; 1314 Filter := '(name=''testname3'')'; 1315 first; 1316 CheckFalse(EOF); 1317 CheckEquals(3,FieldByName('ID').asinteger); 1318 CheckEquals('TestName3',FieldByName('NAME').asstring); 1319 next; 1320 CheckTrue(EOF); 1321 1322 // Check case-insensitive partial compare 1323 Filter := '(name=''*name3'')'; 1324 first; 1325 CheckFalse(EOF); 1326 CheckEquals(3,FieldByName('ID').asinteger); 1327 CheckEquals('TestName3',FieldByName('NAME').asstring); 1328 next; 1329 CheckTrue(EOF); 1330 1331 Filter := '(name=''*name*'')'; 1332 first; 1333 CheckFalse(EOF); 1334 CheckEquals(1,FieldByName('ID').asinteger); 1335 CheckEquals('TestName1',FieldByName('NAME').asstring); 1336 next; 1337 CheckFalse(EOF); 1338 CheckEquals(2,FieldByName('ID').asinteger); 1339 CheckEquals('TestName2',FieldByName('NAME').asstring); 1340 1341 Filter := '(name=''*neme*'')'; 1342 first; 1343 CheckTrue(EOF); 1344 1345 1346 Close; 1347 end; 1348end; 1349 1350{$ifdef fpc} 1351procedure TTestBufDatasetDBBasics.TestIsEmpty; 1352begin 1353 with tCustombufdataset(DBConnector.GetNDataset(True,1)) do 1354 begin 1355 open; 1356 delete; 1357 Resync([]); 1358 applyupdates; 1359 CheckTrue(IsEmpty); 1360 1361 end; 1362end; 1363 1364procedure TTestBufDatasetDBBasics.TestClosedIndexFieldNames; 1365var s : string; 1366 bufds: TCustomBufDataset; 1367begin 1368 bufds := DBConnector.GetNDataset(5) as TCustomBufDataset; 1369 s := bufds.IndexFieldNames; 1370 s := bufds.IndexName; 1371 bufds.CompareBookmarks(nil,nil); 1372end; 1373 1374procedure TTestBufDatasetDBBasics.TestSaveAsXML; 1375var ds : TDataset; 1376 LoadDs: TCustomBufDataset; 1377begin 1378 ds := DBConnector.GetNDataset(true,5); 1379 1380 ds.open; 1381 TCustomBufDataset(ds).SaveToFile('test.xml'); 1382 ds.close; 1383 1384 LoadDs := TCustomBufDataset.Create(nil); 1385 LoadDs.LoadFromFile('test.xml'); 1386 FTestXMLDatasetDefinition(LoadDS); 1387end; 1388 1389procedure TTestBufDatasetDBBasics.TestFileNameProperty; 1390var ds1,ds2: TDataset; 1391 LoadDs: TCustomBufDataset; 1392begin 1393 ds2 := nil; 1394 ds1 := DBConnector.GetNDataset(true,5); 1395 try 1396 ds1.open; 1397 TCustomBufDataset(ds1).FileName:='test.xml'; 1398 ds1.close; 1399 1400 ds2 := DBConnector.GetNDataset(True,7); 1401 TCustomBufDataset(ds2).FileName:='test.xml'; 1402 ds2.Open; 1403 FTestXMLDatasetDefinition(Ds2); 1404 finally 1405 TCustomBufDataset(ds1).FileName:=''; 1406 if assigned(ds2) then 1407 TCustomBufDataset(ds2).FileName:=''; 1408 end; 1409end; 1410 1411procedure TTestBufDatasetDBBasics.TestClientDatasetAsMemDataset; 1412var ds : TCustomBufDataset; 1413 i : integer; 1414begin 1415 ds := TCustomBufDataset.Create(nil); 1416 DS.FieldDefs.Add('ID',ftInteger); 1417 DS.FieldDefs.Add('NAME',ftString,50); 1418 DS.CreateDataset; 1419 DS.Open; 1420 for i := 1 to 10 do 1421 begin 1422 ds.Append; 1423 ds.FieldByName('ID').AsInteger := i; 1424 ds.FieldByName('NAME').AsString := 'TestName' + inttostr(i); 1425 DS.Post; 1426 end; 1427 ds.first; 1428 for i := 1 to 10 do 1429 begin 1430 CheckEquals(i,ds.fieldbyname('ID').asinteger); 1431 CheckEquals('TestName' + inttostr(i),ds.fieldbyname('NAME').AsString); 1432 ds.next; 1433 end; 1434 CheckTrue(ds.EOF); 1435 DS.Close; 1436end; 1437 1438procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd; 1439var i : byte; 1440begin 1441 with DBConnector.GetNDataset(5) as TCustomBufDataset do 1442 begin 1443 open; 1444 next; 1445 next; 1446 1447 edit; 1448 FieldByName('name').AsString := 'changed'; 1449 post; 1450 next; 1451 delete; 1452 1453 CancelUpdates; 1454 1455 First; 1456 1457 for i := 1 to 5 do 1458 begin 1459 CheckEquals(i,fields[0].AsInteger); 1460 CheckEquals('TestName'+inttostr(i),fields[1].AsString); 1461 Next; 1462 end; 1463 end; 1464end; 1465 1466procedure TTestBufDatasetDBBasics.TestBufDatasetCancelUpd1; 1467var i : byte; 1468begin 1469 with DBConnector.GetNDataset(5) as TCustomBufDataset do 1470 begin 1471 open; 1472 next; 1473 next; 1474 1475 delete; 1476 insert; 1477 FieldByName('id').AsInteger := 100; 1478 post; 1479 1480 CancelUpdates; 1481 1482 last; 1483 1484 for i := 5 downto 1 do 1485 begin 1486 CheckEquals(i,fields[0].AsInteger); 1487 CheckEquals('TestName'+inttostr(i),fields[1].AsString); 1488 Prior; 1489 end; 1490 end; 1491end; 1492 1493procedure TTestBufDatasetDBBasics.TestMultipleDeleteUpdateBuffer; 1494var ds : TDataset; 1495begin 1496 ds := DBConnector.GetNDataset(true,5); 1497 1498 ds.open; 1499 with TCustomBufDataset(ds) do 1500 begin 1501 CheckEquals(0,ChangeCount); 1502 edit; 1503 fieldbyname('id').asinteger := 500; 1504 fieldbyname('name').AsString := 'JoJo'; 1505 post; 1506 CheckEquals(1,ChangeCount); 1507 next; next; 1508 Delete; 1509 CheckEquals(2,ChangeCount); 1510 Delete; 1511 CheckEquals(3,ChangeCount); 1512 CancelUpdates; 1513 end; 1514 ds.close; 1515end; 1516 1517procedure TTestBufDatasetDBBasics.TestDoubleDelete; 1518var ds : TCustomBufDataset; 1519begin 1520 ds := TCustomBufDataset(DBConnector.GetNDataset(true,5)); 1521 1522 with ds do 1523 begin 1524 open; 1525 next; next; 1526 Delete; 1527 Delete; 1528 1529 first; 1530 CheckEquals(1,fieldbyname('id').AsInteger); 1531 next; 1532 CheckEquals(2,fieldbyname('id').AsInteger); 1533 next; 1534 CheckEquals(5,fieldbyname('id').AsInteger); 1535 1536 CancelUpdates; 1537 1538 first; 1539 CheckEquals(1,fieldbyname('id').AsInteger); 1540 next; 1541 CheckEquals(2,fieldbyname('id').AsInteger); 1542 next; 1543 CheckEquals(3,fieldbyname('id').AsInteger); 1544 next; 1545 CheckEquals(4,fieldbyname('id').AsInteger); 1546 next; 1547 CheckEquals(5,fieldbyname('id').AsInteger); 1548 end; 1549end; 1550 1551procedure TTestBufDatasetDBBasics.TestReadOnly; 1552var 1553 ds: TCustomBufDataset; 1554begin 1555 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1556 with ds do 1557 begin 1558 ReadOnly:=true; 1559 CheckFalse(CanModify); 1560 end; 1561end; 1562 1563procedure TTestBufDatasetDBBasics.TestMergeChangeLog; 1564var 1565 ds: TCustomBufDataset; 1566 i: integer; 1567 s: string; 1568begin 1569 ds := DBConnector.GetNDataset(5) as TCustomBufDataset; 1570 with ds do 1571 begin 1572 open; 1573 Edit; 1574 i := fields[0].AsInteger; 1575 s := fields[1].AsString; 1576 fields[0].AsInteger:=64; 1577 fields[1].AsString:='Changed'; 1578 Post; 1579 checkequals(fields[0].OldValue,i); 1580 checkequals(fields[1].OldValue,s); 1581 CheckEquals(ChangeCount,1); 1582 MergeChangeLog; 1583 CheckEquals(ChangeCount,0); 1584 checkequals(fields[0].OldValue,64); 1585 checkequals(fields[1].OldValue,'Changed'); 1586 end; 1587end; 1588 1589procedure TTestBufDatasetDBBasics.FTestXMLDatasetDefinition(ADataset: TDataset); 1590var i : integer; 1591begin 1592 CheckEquals(2,ADataset.FieldDefs.Count); 1593 CheckEquals(2,ADataset.Fields.Count); 1594 CheckTrue(SameText('ID',ADataset.Fields[0].FieldName)); 1595 CheckTrue(SameText('NAME',ADataset.Fields[1].FieldName)); 1596 CheckEquals(ord(ftString), ord(ADataset.Fields[1].DataType), 'Incorrect FieldType'); 1597 i := 1; 1598 while not ADataset.EOF do 1599 begin 1600 CheckEquals('TestName'+inttostr(i),ADataset.FieldByName('name').AsString); 1601 ADataset.Next; 1602 inc(i); 1603 end; 1604end; 1605 1606procedure TTestBufDatasetDBBasics.TestAddIndexFieldType(AFieldType: TFieldType; ActiveDS : boolean); 1607var ds : TCustomBufDataset; 1608 FList : TStringList; 1609 LastValue : Variant; 1610 StrValue : String; 1611begin 1612 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1613 with ds do 1614 begin 1615 1616 if not ActiveDS then 1617 begin 1618 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]); 1619 IndexName:='testindex'; 1620 end 1621 else 1622 MaxIndexesCount := 3; 1623 1624 try 1625 open; 1626 except 1627 if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then 1628 Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset') 1629 else 1630 raise; 1631 end; 1632 1633 if ActiveDS then 1634 begin 1635 if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then 1636 Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset'); 1637 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]); 1638 IndexName:='testindex'; 1639 First; 1640 end; 1641 1642 LastValue:=null; 1643 while not eof do 1644 begin 1645 if AFieldType=ftString then 1646 CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))<=0) 1647 else 1648 CheckTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant); 1649 LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant; 1650 Next; 1651 end; 1652 1653 while not bof do 1654 begin 1655 if AFieldType=ftString then 1656 CheckTrue(AnsiCompareStr(VarToStr(LastValue),VarToStr(FieldByName('F'+FieldTypeNames[AfieldType]).AsString))>=0) 1657 else 1658 CheckTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant); 1659 LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant; 1660 Prior; 1661 end; 1662 end; 1663end; 1664 1665procedure TTestBufDatasetDBBasics.TestAddIndexSmallInt; 1666begin 1667 TestAddIndexFieldType(ftSmallint,False); 1668end; 1669 1670procedure TTestBufDatasetDBBasics.TestAddIndexBoolean; 1671begin 1672 TestAddIndexFieldType(ftBoolean,False); 1673end; 1674 1675procedure TTestBufDatasetDBBasics.TestAddIndexFloat; 1676begin 1677 TestAddIndexFieldType(ftFloat,False); 1678end; 1679 1680procedure TTestBufDatasetDBBasics.TestAddIndexInteger; 1681begin 1682 TestAddIndexFieldType(ftInteger,False); 1683end; 1684 1685procedure TTestBufDatasetDBBasics.TestAddIndexLargeInt; 1686begin 1687 TestAddIndexFieldType(ftLargeint,False); 1688end; 1689 1690procedure TTestBufDatasetDBBasics.TestAddIndexDateTime; 1691begin 1692 TestAddIndexFieldType(ftDateTime,False); 1693end; 1694 1695procedure TTestBufDatasetDBBasics.TestAddIndexCurrency; 1696begin 1697 TestAddIndexFieldType(ftCurrency,False); 1698end; 1699 1700procedure TTestBufDatasetDBBasics.TestAddIndexBCD; 1701begin 1702 TestAddIndexFieldType(ftBCD,False); 1703end; 1704 1705procedure TTestBufDatasetDBBasics.TestAddIndex; 1706var ds : TCustomBufDataset; 1707 AFieldType : TFieldType; 1708 FList : TStringList; 1709 i : integer; 1710begin 1711 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1712 with ds do 1713 begin 1714 1715 AFieldType:=ftString; 1716 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]); 1717 FList := TStringList.Create; 1718 FList.Sorted:=true; 1719 FList.CaseSensitive:=True; 1720 FList.Duplicates:=dupAccept; 1721 open; 1722 1723 while not eof do 1724 begin 1725 flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1726 Next; 1727 end; 1728 1729 IndexName:='testindex'; 1730 first; 1731 i:=0; 1732 1733 while not eof do 1734 begin 1735 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1736 inc(i); 1737 Next; 1738 end; 1739 1740 while not bof do 1741 begin 1742 dec(i); 1743 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1744 Prior; 1745 end; 1746 end; 1747end; 1748 1749procedure TTestBufDatasetDBBasics.TestAddDescIndex; 1750var ds : TCustomBufDataset; 1751 AFieldType : TFieldType; 1752 FList : TStringList; 1753 i : integer; 1754begin 1755 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1756 with ds do 1757 begin 1758 1759 AFieldType:=ftString; 1760 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'F'+FieldTypeNames[AfieldType]); 1761 FList := TStringList.Create; 1762 FList.Sorted:=true; 1763 FList.CaseSensitive:=True; 1764 FList.Duplicates:=dupAccept; 1765 open; 1766 1767 while not eof do 1768 begin 1769 flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1770 Next; 1771 end; 1772 1773 IndexName:='testindex'; 1774 first; 1775 i:=FList.Count-1; 1776 1777 while not eof do 1778 begin 1779 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1780 dec(i); 1781 Next; 1782 end; 1783 1784 while not bof do 1785 begin 1786 inc(i); 1787 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1788 Prior; 1789 end; 1790 end; 1791end; 1792 1793procedure TTestBufDatasetDBBasics.TestAddCaseInsIndex; 1794var ds : TCustomBufDataset; 1795 AFieldType : TFieldType; 1796 FList : TStringList; 1797 i : integer; 1798begin 1799 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1800 with ds do 1801 begin 1802 1803 AFieldType:=ftString; 1804 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[],'','F'+FieldTypeNames[AfieldType]); 1805 FList := TStringList.Create; 1806 FList.Sorted:=true; 1807 FList.Duplicates:=dupAccept; 1808 open; 1809 1810 while not eof do 1811 begin 1812 flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1813 Next; 1814 end; 1815 1816 IndexName:='testindex'; 1817 first; 1818 i:=0; 1819 1820 while not eof do 1821 begin 1822 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1823 inc(i); 1824 Next; 1825 end; 1826 1827 while not bof do 1828 begin 1829 dec(i); 1830 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1831 Prior; 1832 end; 1833 end; 1834end; 1835 1836procedure TTestBufDatasetDBBasics.TestInactSwitchIndex; 1837// Test if the default-index is properly build when the active index is not 1838// the default-index while opening then dataset 1839var ds : TCustomBufDataset; 1840 AFieldType : TFieldType; 1841 i : integer; 1842begin 1843 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1844 with ds do 1845 begin 1846 1847 AFieldType:=ftString; 1848 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]); 1849 IndexName:='testindex'; 1850 open; 1851 IndexName:=''; // This should set the default index (default_order) 1852 first; 1853 1854 i := 0; 1855 1856 while not eof do 1857 begin 1858 CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1859 inc(i); 1860 Next; 1861 end; 1862 end; 1863end; 1864 1865procedure TTestBufDatasetDBBasics.TestAddIndexActiveDS; 1866var ds : TCustomBufDataset; 1867 I : integer; 1868begin 1869 TestAddIndexFieldType(ftString,true); 1870end; 1871 1872procedure TTestBufDatasetDBBasics.TestAddIndexEditDS; 1873var ds : TCustomBufDataset; 1874 I : integer; 1875 LastValue : String; 1876begin 1877 ds := DBConnector.GetNDataset(True,5) as TCustomBufDataset; 1878 with ds do 1879 begin 1880 MaxIndexesCount:=3; 1881 open; 1882 edit; 1883 FieldByName('name').asstring := 'Zz'; 1884 post; 1885 next; 1886 next; 1887 edit; 1888 FieldByName('name').asstring := 'aA'; 1889 post; 1890 1891 AddIndex('test','name',[]); 1892 1893 first; 1894 ds.IndexName:='test'; 1895 first; 1896 LastValue:=''; 1897 while not eof do 1898 begin 1899 CheckTrue(AnsiCompareStr(LastValue,FieldByName('name').AsString)<=0); 1900 LastValue:=FieldByName('name').AsString; 1901 Next; 1902 end; 1903 end; 1904end; 1905 1906procedure TTestBufDatasetDBBasics.TestIndexFieldNamesAct; 1907var ds : TCustomBufDataset; 1908 AFieldType : TFieldType; 1909 FList : TStringList; 1910 i : integer; 1911begin 1912 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1913 with ds do 1914 begin 1915 AFieldType:=ftString; 1916 FList := TStringList.Create; 1917 FList.Sorted:=true; 1918 FList.CaseSensitive:=True; 1919 FList.Duplicates:=dupAccept; 1920 open; 1921 1922 while not eof do 1923 begin 1924 flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1925 Next; 1926 end; 1927 1928 IndexFieldNames:='F'+FieldTypeNames[AfieldType]; 1929 first; 1930 i:=0; 1931 1932 while not eof do 1933 begin 1934 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1935 inc(i); 1936 Next; 1937 end; 1938 1939 while not bof do 1940 begin 1941 dec(i); 1942 CheckEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1943 Prior; 1944 end; 1945 1946 CheckEquals('F'+FieldTypeNames[AfieldType],IndexFieldNames); 1947 1948 IndexFieldNames:='ID'; 1949 first; 1950 i:=0; 1951 1952 while not eof do 1953 begin 1954 CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1955 inc(i); 1956 Next; 1957 end; 1958 1959 CheckEquals('ID',IndexFieldNames); 1960 1961 IndexFieldNames:=''; 1962 first; 1963 i:=0; 1964 1965 while not eof do 1966 begin 1967 CheckEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 1968 inc(i); 1969 Next; 1970 end; 1971 1972 CheckEquals('',IndexFieldNames); 1973 1974 end; 1975end; 1976 1977procedure TTestBufDatasetDBBasics.TestIndexCurRecord; 1978// Test if the currentrecord stays the same after an index change 1979var ds : TCustomBufDataset; 1980 AFieldType : TFieldType; 1981 i : integer; 1982 OldID : Integer; 1983 OldStringValue : string; 1984begin 1985 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 1986 with ds do 1987 begin 1988 AFieldType:=ftString; 1989 AddIndex('testindex','F'+FieldTypeNames[AfieldType],[]); 1990 open; 1991 1992 for i := 0 to (testValuesCount div 3) do 1993 Next; 1994 1995 OldID:=FieldByName('id').AsInteger; 1996 OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString; 1997 1998 IndexName:='testindex'; 1999 2000 CheckEquals(OldID,FieldByName('id').AsInteger); 2001 CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 2002 2003 next; 2004 CheckTrue(OldStringValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 2005 prior; 2006 prior; 2007 CheckTrue(OldStringValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 2008 2009 OldID:=FieldByName('id').AsInteger; 2010 OldStringValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsString; 2011 2012 IndexName:=''; 2013 2014 CheckEquals(OldID,FieldByName('id').AsInteger); 2015 CheckEquals(OldStringValue,FieldByName('F'+FieldTypeNames[AfieldType]).AsString); 2016 2017 next; 2018 CheckEquals(OldID+1,FieldByName('ID').AsInteger); 2019 prior; 2020 prior; 2021 CheckEquals(OldID-1,FieldByName('ID').AsInteger); 2022 end; 2023end; 2024 2025procedure TTestBufDatasetDBBasics.TestAddDblIndex; 2026var ds : TCustomBufDataset; 2027 LastInteger : Integer; 2028 LastString : string; 2029begin 2030 ds := DBConnector.GetFieldDataset as TCustomBufDataset; 2031 with ds do 2032 begin 2033 2034 AddIndex('testindex','F'+FieldTypeNames[ftString]+';F'+FieldTypeNames[ftInteger],[]); 2035 open; 2036 2037 IndexName:='testindex'; 2038 first; 2039 2040 LastString:=''; 2041 while not eof do 2042 begin 2043 CheckTrue(AnsiCompareStr(FieldByName('F'+FieldTypeNames[ftString]).AsString,LastString)>=0); 2044 LastString:= FieldByName('F'+FieldTypeNames[ftString]).AsString; 2045 2046 LastInteger:=-MaxInt; 2047 while (FieldByName('F'+FieldTypeNames[ftString]).AsString=LastString) and not eof d…
Large files files are truncated, but you can click here to view the full file