PageRenderTime 103ms CodeModel.GetById 26ms app.highlight 24ms RepoModel.GetById 23ms app.codeStats 1ms

/packages/fcl-db/tests/testdbbasics.pas

https://github.com/slibre/freepascal
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