Merged revisions 10383,10387-10393,10398,10400,10403,10423,10430-10431,10436,10439,10441,10444-10446,10452,10469-10470,10472,10476,10489-10491,10502-10503,10507-10515,10519-10520,10522-10523,10525-10529 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
  r10383 | joost | 2008-02-24 14:21:16 +0100 (Sun, 24 Feb 2008) | 1 line
  
   * Do not depend on TDataset.DataEvent when setting up the test-data
........
  r10392 | joost | 2008-02-26 22:36:52 +0100 (Tue, 26 Feb 2008) | 1 line
  
   * Tests for Set- and GetFieldValues
........
  r10431 | joost | 2008-03-02 18:08:16 +0100 (Sun, 02 Mar 2008) | 1 line
  
   * Set Modified to false when te state of a dataset changes
........
  r10439 | joost | 2008-03-03 23:00:37 +0100 (Mon, 03 Mar 2008) | 2 lines
  
   * Added TDataset.DataEvent tests
   * Initialise the connector manually in the console-application, for better error messages in case of connection problems
........
  r10469 | joost | 2008-03-09 21:00:53 +0100 (Sun, 09 Mar 2008) | 2 lines
  
   * Added Meta, Link and Script methods to THTMLWriter
   * Fixed typo Attrubute - Attribute
........
  r10470 | joost | 2008-03-09 21:11:17 +0100 (Sun, 09 Mar 2008) | 1 line
  
   * Set TDataSet.InternalCalcFields if there are InternalCalcFields
........
  r10476 | joost | 2008-03-12 21:25:32 +0100 (Wed, 12 Mar 2008) | 2 lines
  
   * Added forgotten unit
   * Add test for CalcFirstRecord
........
  r10502 | joost | 2008-03-17 23:27:40 +0100 (Mon, 17 Mar 2008) | 1 line
  
   * Test for RefreshLookupList
........
  r10508 | joost | 2008-03-19 16:59:36 +0100 (Wed, 19 Mar 2008) | 3 lines
  
   * TFormFieldItem.GetValue now uses TField.Displaytext instead of Text
   * Do not crash when there are no records on the current page 
   * Set TTableCell.FormField
........
  r10519 | joost | 2008-03-21 14:38:44 +0100 (Fri, 21 Mar 2008) | 1 line
  
   * Fix for ValueOfKey for multiple-fields keys
........
  r10520 | joost | 2008-03-21 15:28:34 +0100 (Fri, 21 Mar 2008) | 2 lines
  
   * Test for CalculateFields
   * Added cwstring unit on unix to avoid Widestring-issues
........
  r10523 | joost | 2008-03-21 16:22:11 +0100 (Fri, 21 Mar 2008) | 2 lines
  
   * Added test for TDataset.EnableControls
   * Adapted test for CalculateFields for fix of bug #11027
........
  r10528 | joost | 2008-03-21 19:19:02 +0100 (Fri, 21 Mar 2008) | 1 line
  
   * Added test for CalcLookupValue
........
  r10529 | joost | 2008-03-21 19:26:01 +0100 (Fri, 21 Mar 2008) | 1 line
  
   * Patch from Petr Kristan to allocate Constraints
........

git-svn-id: branches/fixes_2_2@10686 -

.gitattributes

@@ -1280,6 +1280,7 @@ packages/fcl-db/tests/dbtestframework.pas -text
 packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/sqldbtoolsunit.pas -text
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
+packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
 packages/fcl-db/tests/testdbbasics.pas -text
 packages/fcl-db/tests/toolsunit.pas -text
 packages/fcl-fpcunit/Makefile svneol=native#text/plain

packages/fcl-db/src/base/db.pas

@@ -2304,12 +2304,33 @@ end;
 
 function TLookupList.ValueOfKey(const AKey: Variant): Variant;
 
+  Function VarArraySameValues(VarArray1,VarArray2 : Variant) : Boolean;
+  // This only works for one-dimensional vararrays with a lower bound of 0
+  // and equal higher bounds wich only contains variants.
+  // The vararrays returned by GetFieldValues do apply.
+  var i : integer;
+  begin
+    Result := True;
+    if (VarArrayHighBound(VarArray1,1))<> (VarArrayHighBound(VarArray2,1)) then exit;
+    for i := 0 to VarArrayHighBound(VarArray1,1) do
+    begin
+      if VarArray1[i]<>VarArray2[i] then
+        begin
+        Result := false;
+        Exit;
+        end;
+    end;
+  end;
+
 var I: Integer;
 begin
   Result := Null;
   if VarIsNull(AKey) then Exit;
   i := FList.Count - 1;
-  while (i > 0) And (PLookupListRec(FList.Items[I])^.Key <> AKey) do Dec(i);
+  if VarIsArray(AKey) then
+    while (i > 0) And not VarArraySameValues(PLookupListRec(FList.Items[I])^.Key,AKey) do Dec(i)
+  else
+    while (i > 0) And (PLookupListRec(FList.Items[I])^.Key <> AKey) do Dec(i);
   if i >= 0 then Result := PLookupListRec(FList.Items[I])^.Value;
 end;
 

packages/fcl-db/tests/dbftoolsunit.pas

@@ -21,6 +21,19 @@ type
     procedure DropFieldDataset; override;
     Function InternalGetNDataset(n : integer) : TDataset; override;
     Function InternalGetFieldDataset : TDataSet; override;
+  public
+    function GetTraceDataset(AChange : Boolean) : TDataset; override;
+  end;
+
+  { TDbfTraceDataset }
+
+  TDbfTraceDataset = class(Tdbf)
+  protected
+    procedure SetCurrentRecord(Index: Longint); override;
+    procedure RefreshInternalCalcFields(Buffer: PChar); override;
+    procedure InternalInitFieldDefs; override;
+    procedure CalculateFields(Buffer: PChar); override;
+    procedure ClearCalcFields(Buffer: PChar); override;
   end;
 
 implementation
@@ -43,6 +56,10 @@ begin
         Append;
         FieldByName('ID').AsInteger := countID;
         FieldByName('NAME').AsString := 'TestName'+inttostr(countID);
+        // Explicitly call .post, since there could be a bug which disturbs
+        // the automatic call to post. (example: when TDataset.DataEvent doesn't
+        // work properly)
+        Post;
         end;
       if state = dsinsert then
         Post;
@@ -124,6 +141,60 @@ begin
     end;
 end;
 
+function TDBFDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
+var ADS, AResDS : TDbf;
+begin
+  ADS := GetNDataset(AChange,15) as TDbf;
+  AResDS := TDbfTraceDataset.Create(nil);
+  AResDS.FilePath:=ADS.FilePath;
+  AResDs.TableName:=ADS.TableName;
+  Result:=AResDS;
+end;
+
+{ TDbfTraceDataset }
+
+procedure TDbfTraceDataset.SetCurrentRecord(Index: Longint);
+begin
+  DataEvents := DataEvents + 'SetCurrentRecord' + ';';
+  inherited SetCurrentRecord(Index);
+end;
+
+procedure TDbfTraceDataset.RefreshInternalCalcFields(Buffer: PChar);
+begin
+  DataEvents := DataEvents + 'RefreshInternalCalcFields' + ';';
+  inherited RefreshInternalCalcFields(Buffer);
+end;
+
+procedure TDbfTraceDataset.InternalInitFieldDefs;
+var i : integer;
+    IntCalcFieldName : String;
+begin
+  // To fake a internal calculated field, set it's fielddef InternalCalcField
+  // property to true, before the dataset is opened.
+  // This procedure takes care of setting the automatically created fielddef's
+  // InternalCalcField property to true. (works for only one field)
+  IntCalcFieldName:='';
+  for i := 0 to FieldDefs.Count -1 do
+    if fielddefs[i].InternalCalcField then IntCalcFieldName := FieldDefs[i].Name;
+  inherited InternalInitFieldDefs;
+  if IntCalcFieldName<>'' then with FieldDefs.find(IntCalcFieldName) do
+    begin
+    InternalCalcField := True;
+    end;
+end;
+
+procedure TDbfTraceDataset.CalculateFields(Buffer: PChar);
+begin
+  DataEvents := DataEvents + 'CalculateFields' + ';';
+  inherited CalculateFields(Buffer);
+end;
+
+procedure TDbfTraceDataset.ClearCalcFields(Buffer: PChar);
+begin
+  DataEvents := DataEvents + 'ClearCalcFields' + ';';
+  inherited ClearCalcFields(Buffer);
+end;
+
 initialization
   RegisterClass(TDBFDBConnector);
 end.

packages/fcl-db/tests/testdatasources.pas

@@ -0,0 +1,783 @@
+unit TestDatasources;
+
+{$IFDEF FPC}
+  {$mode Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, db;
+
+type
+
+  { TTestDatasources }
+
+  TTestDatasources = class(TTestCase)
+  private
+    procedure FieldNotifyEvent(Sender: TField);
+    procedure DatasetNotifyEvent(Dataset: TDataset);
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+// This test is also in TestDBBasics
+//    procedure TestDataEventsResync;
+    procedure TestDataEvent1;
+    procedure TestDataEvent2;
+    procedure TestDataEvent3;
+    procedure TestDataEvent4;
+    procedure TestDataEvent5;
+    procedure TestDataEvent6;
+    procedure TestDataEvent7;
+    procedure TestCalcFirstRecord1;
+    procedure TestRefreshLookupList;
+    procedure TestCalculateFields;
+    procedure TestCalcLookupValue;
+    procedure TestEnableControls;
+  end;
+  
+implementation
+
+uses ToolsUnit, dbf, testregistry, variants{$IFDEF UNIX},cwstring {$ENDIF};
+
+type THackDataset=class(TDataset);
+     THackDataLink=class(TDatalink);
+
+{ TTestDataSources }
+
+procedure TTestDatasources.FieldNotifyEvent(Sender: TField);
+begin
+  DataEvents := DataEvents + 'FieldNotifyEvent' + ';';
+end;
+
+procedure TTestDatasources.DatasetNotifyEvent(Dataset: TDataset);
+begin
+  DataEvents := DataEvents + 'DatasetNotifyEvent' + ';';
+end;
+
+procedure TTestDatasources.SetUp;
+begin
+  DBConnector.StartTest;
+end;
+
+procedure TTestDatasources.TearDown;
+begin
+  DBConnector.StopTest;
+end;
+
+{procedure TTestDatasources.TestDataEventsResync;
+var i,count     : integer;
+    aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetNDataset(6);
+  ds.BeforeScroll := DBConnector.DataEvent;
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    open;
+    DataEvents := '';
+    Resync([rmExact]);
+    AssertEquals('deDataSetChange:0;',DataEvents);
+    DataEvents := '';
+    next;
+    AssertEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;',DataEvents);
+    close;
+    end;
+  aDatasource.Free;
+  aDatalink.Free;
+end;}
+
+procedure TTestDatasources.TestDataEvent1;
+var i,count     : integer;
+    aDatasource : TDataSource;
+    aDatalink1,
+    aDatalink2  : TDataLink;
+    ds          : tdataset;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink1 := TTestDataLink.Create;
+  aDatalink1.DataSource := aDatasource;
+  ds := DBConnector.GetNDataset(6);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    open;
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deCheckBrowseMode,0);
+    AssertEquals('deCheckBrowseMode:0;',DataEvents);
+
+    aDatalink2 := TTestDataLink.Create;
+    aDatalink2.DataSource := aDatasource;
+
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deCheckBrowseMode,0);
+    AssertEquals('deCheckBrowseMode:0;deCheckBrowseMode:0;',DataEvents);
+
+    aDatalink2.free;
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deCheckBrowseMode,0);
+    AssertEquals('deCheckBrowseMode:0;',DataEvents);
+
+    close;
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent2;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    open;
+    // The deDataSetChange and deDataSetScroll events should trigger a call to
+    // TDataset.UpdateCursorPos...
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetChange,0);
+    AssertEquals('SetCurrentRecord;deDataSetChange:0;',DataEvents);
+
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,0);
+    AssertEquals('SetCurrentRecord;deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
+    
+    // unless TDataset.State is dsInsert
+    
+    ds.insert;
+    DataEvents := '';
+    AssertTrue(ds.State=dsInsert);
+    THackDataset(ds).DataEvent(deDataSetChange,0);
+    AssertEquals('deDataSetChange:0;',DataEvents);
+
+    AssertTrue(ds.State=dsInsert);
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,0);
+    AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent3;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    AFld        : TField;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    open;
+    AFld := FieldByName('id');
+    // On a deFieldChange event from a field with a fieldkind of fkData or
+    // fkInternalCalc, TDataset.Modified must be set to true
+    DataEvents := '';
+    AssertFalse(Modified);
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertTrue(Modified);
+    AssertEquals('deFieldChange:ID;',DataEvents);
+
+    Close;
+    AFld := TIntegerField.Create(ds);
+    AFld.FieldName := 'CALCFLD';
+    AFld.DataSet := ds;
+    Afld.FieldKind := fkCalculated;
+    Open;
+
+    DataEvents := '';
+    AssertFalse(Modified);
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertFalse(Modified);
+    AssertEquals('deFieldChange:CALCFLD;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent4;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    AFld        : TField;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    
+    // Ugly hack to imitate InternalCalcField, see
+    // TDbfTraceDataset.InternalInitFieldDefs
+    FieldDefs.Add('Name',ftString);
+    FieldDefs.Find('Name').InternalCalcField:=True;
+    open;
+    AssertTrue(THackDataset(ds).InternalCalcFields);
+    // If there are InternalCalcFields (InternalCalcFields=True) and the fieldkind
+    // of the field from the deFieldChange event is fkData, then
+    // RefreshIntenralCalcFields is called
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('RefreshInternalCalcFields;deFieldChange:ID;',DataEvents);
+
+    AFld := FieldByName('name');
+    AFld.FieldKind:=fkInternalCalc;
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:NAME;',DataEvents);
+
+    // If the TDataset.State is dsSetKey then IntenralCalcFields shoudn't get called
+    THackDataset(ds).SetState(dsSetKey);
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:ID;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent5;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    AFld        : TField;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+    open;
+    AFld := FieldByName('id');
+    AFld.OnChange:=FieldNotifyEvent;
+    // When TDataset.State is not dsSetKey then TField.Change is called on a
+    // deFieldChange event
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('FieldNotifyEvent;deFieldChange:ID;',DataEvents);
+
+    THackDataset(ds).SetState(dsSetKey);
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:ID;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent6;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    AFld        : TField;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+
+    AFld := TIntegerField.Create(ds);
+    AFld.FieldName := 'ID';
+    AFld.DataSet := ds;
+
+    AFld := TStringField.Create(ds);
+    AFld.FieldName := 'NAME';
+    AFld.DataSet := ds;
+
+    AFld := TIntegerField.Create(ds);
+    AFld.FieldName := 'CALCFLD';
+    AFld.DataSet := ds;
+    Afld.FieldKind := fkCalculated;
+
+    open;
+    // If there are Calculated fields and AutoCalcFields is true, then call
+    // CalculateFields in case of a deFieldChange event, if the fields fieldkind
+    // is fkData
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:ID;',DataEvents);
+
+    DataEvents := '';
+    AutoCalcFields:=True;
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('CalculateFields;ClearCalcFields;deFieldChange:ID;',DataEvents);
+
+    AFld := FieldByName('calcfld');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:CALCFLD;',DataEvents);
+
+    // If the TDataset.State is dsSetKey then CalculateFields shoudn't get called
+    THackDataset(ds).SetState(dsSetKey);
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:ID;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestDataEvent7;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    AFld        : TField;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetTraceDataset(false);
+  with ds do
+    begin
+    aDatasource.DataSet := ds;
+
+    AFld := TIntegerField.Create(ds);
+    AFld.FieldName := 'ID';
+    AFld.DataSet := ds;
+    
+    AFld := TStringField.Create(ds);
+    AFld.FieldName := 'NAME';
+    AFld.DataSet := ds;
+
+    AFld := TIntegerField.Create(ds);
+    AFld.FieldName := 'CALCFLD';
+    AFld.DataSet := ds;
+    Afld.FieldKind := fkCalculated;
+
+    // Ugly hack to imitate InternalCalcField, see
+    // TDbfTraceDataset.InternalInitFieldDefs
+    FieldDefs.Add('Name',ftString);
+    FieldDefs.Find('Name').InternalCalcField:=True;
+    open;
+    AssertTrue(THackDataset(ds).InternalCalcFields);
+    // If there are InternalCalcFields and 'normal' Calculated fields, only
+    // RefreshIntenralCalcFields is called
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('RefreshInternalCalcFields;deFieldChange:ID;',DataEvents);
+
+    AFld := FieldByName('name');
+    AFld.FieldKind:=fkInternalCalc;
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:NAME;',DataEvents);
+
+    // If the TDataset.State is dsSetKey then IntenralCalcFields shoudn't get called
+    THackDataset(ds).SetState(dsSetKey);
+    AFld := FieldByName('id');
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deFieldChange,PtrInt(AFld));
+    AssertEquals('deFieldChange:ID;',DataEvents);
+    end;
+end;
+
+procedure TTestDatasources.TestCalcFirstRecord1;
+var aDatasource : TDataSource;
+    aDatalink   : TDataLink;
+    ds          : tdataset;
+    FirstRec    : Integer;
+begin
+  aDatasource := TDataSource.Create(nil);
+  aDatalink := TTestDataLink.Create;
+  aDatalink.DataSource := aDatasource;
+  ds := DBConnector.GetNDataset(15);
+  aDatasource.DataSet := ds;
+  with ds do
+    begin
+    open;
+    FirstRec := THackDataLink(aDatalink).FirstRecord;
+    
+    // Scroll '0' records, FirstRecord should stay the same,
+    // and the there's no need to scroll the buffer.
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,0);
+    AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Scroll 1 record forward, FirstRecord should stay the same,
+    // but the buffer is scrolled one place back.
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,1);
+    AssertEquals('deDataSetScroll:1;DataSetScrolled:-1;',DataEvents);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+
+    // Scroll 1 record backward, FirstRecord should stay the same,
+    // but the buffer is scrolled one place back.
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,-1);
+    AssertEquals('deDataSetScroll:-1;DataSetScrolled:1;',DataEvents);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Remove the datasource.
+    aDatasource.DataSet := nil;
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,1);
+    AssertEquals('',DataEvents);
+    
+    // Set the buffer-size to 5 and add it to the dataset again
+    aDatalink.BufferCount:=5;
+    aDatasource.DataSet := ds;
+    
+    // Scroll '0' records, firstrecord should stay the same again,
+    // and there's no need to scroll the buffer.
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,0);
+    AssertEquals('deDataSetScroll:0;DataSetScrolled:0;',DataEvents);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Scroll 1 record backwards with a buffer size of 5.
+    // Now the buffer won't scroll, but FirstRecord is decremented
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,-1);
+    AssertEquals('deDataSetScroll:-1;DataSetScrolled:0;',DataEvents);
+    dec(FirstRec);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Scroll one record forward again, no buffer scroll, FirstRecord
+    // is inremented
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,1);
+    AssertEquals('deDataSetScroll:1;DataSetScrolled:0;',DataEvents);
+    inc(FirstRec);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Scroll one more record forward, buffer will scroll, FirstRecord
+    // stays constant
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,1);
+    AssertEquals('deDataSetScroll:1;DataSetScrolled:-1;',DataEvents);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+    
+    // Scroll two records backward, no buffer scroll, FirstRecord
+    // is inremented twice
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,-2);
+    AssertEquals('deDataSetScroll:-2;DataSetScrolled:0;',DataEvents);
+    dec(FirstRec,2);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // Scroll 6 records forward, so the buffer is scrolled 4 positions backward
+    // and FirstRecord is Incremented by 2
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,6);
+    AssertEquals('deDataSetScroll:6;DataSetScrolled:-4;',DataEvents);
+    inc(FirstRec,2);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    // The other way around, scroll 6 records back, so the buffer is scrolled 2
+    // positions forward and FirstRecord is decremented by 4
+    DataEvents := '';
+    THackDataset(ds).DataEvent(deDataSetScroll,-6);
+    AssertEquals('deDataSetScroll:-6;DataSetScrolled:2;',DataEvents);
+    dec(FirstRec,4);
+    AssertEquals(FirstRec,THackDataLink(aDatalink).FirstRecord);
+
+    end;
+end;
+
+procedure TTestDatasources.TestRefreshLookupList;
+var ds, lkpDs   : TDataset;
+    AFld1, AFld2, AFld3 : Tfield;
+    Var1,Var2 : Variant;
+    
+  procedure TestLookupList;
+  begin
+    lkpDs.Open;
+    lkpDs.first;
+    while not LkpDs.eof do with AFld3 do
+      begin
+      Var1 := LkpDs.FieldValues[LookupResultField];
+      Var2 := LookupList.ValueOfKey(LkpDs.fieldvalues[LookupKeyFields]);
+      AssertEquals(VarToStr(Var1),VarToStr(Var2));
+      lkpDs.Next;
+      end;
+  end;
+begin
+  ds := DBConnector.GetNDataset(15);
+  lkpDs := DBConnector.GetNDataset(5);
+  with ds do
+    begin
+    AFld1 := TIntegerField.Create(ds);
+    AFld1.FieldName := 'ID';
+    AFld1.DataSet := ds;
+
+    AFld2 := TStringField.Create(ds);
+    AFld2.FieldName := 'NAME';
+    AFld2.DataSet := ds;
+
+    AFld3 := TIntegerField.Create(ds);
+    with AFld3 do
+      begin
+      // Test if nothing happens when not all properties are filled
+      FieldName := 'LookupFld';
+      FieldKind := fkLookup;
+      DataSet := ds;
+      RefreshLookupList;
+      LookupDataSet := lkpDs;
+      RefreshLookupList;
+      LookupKeyFields:='name';
+      RefreshLookupList;
+      LookupResultField:='ID';
+      RefreshLookupList;
+      KeyFields:='name';
+      // Everything is filled in, this should run wihout any problems:
+      RefreshLookupList;
+      // The lookupdataset was closed, and should be closed again:
+      AssertFalse(lkpDs.Active);
+
+      // If some fields don't exist, check if an exception is raised:
+      LookupKeyFields:='faulty';
+      AssertException(EDatabaseError,RefreshLookupList);
+      LookupKeyFields:='name';
+
+      LookupResultField :='faulty';
+      AssertException(EDatabaseError,RefreshLookupList);
+      LookupResultField :='ID';
+
+      // Check if the lookuplist is correctly filled
+      RefreshLookupList;
+      TestLookupList;
+
+      // Check if the lookuplist is correctly filled when there are multiple
+      // fields in the key
+      LookupResultField:='name';
+      LookupKeyFields:='id;name';
+      RefreshLookupList;
+      TestLookupList;
+      end;
+    AFld1.Free;
+    AFld2.Free;
+    AFld3.Free;
+    end;
+end;
+
+procedure TTestDatasources.TestCalculateFields;
+var ds, lkpDs   : TDataset;
+    AFld1, AFld2, AFld3 : Tfield;
+    StoreValue : Variant;
+    Buffer: pchar;
+begin
+  ds := DBConnector.GetTraceDataset(True);
+  lkpDs := DBConnector.GetNDataset(5);
+  with ds do
+    begin
+    AFld1 := TIntegerField.Create(ds);
+    AFld1.FieldName := 'ID';
+    AFld1.DataSet := ds;
+
+    AFld2 := TStringField.Create(ds);
+    AFld2.FieldName := 'NAME';
+    AFld2.DataSet := ds;
+
+    AFld3 := TIntegerField.Create(ds);
+    with AFld3 do
+      begin
+      FieldName := 'LookupFld';
+      FieldKind := fkLookup;
+      DataSet := ds;
+      LookupDataSet := lkpDs;
+      LookupKeyFields:='name';
+      LookupResultField:='ID';
+      KeyFields := 'name';
+      end;
+    ds.OnCalcFields:=DatasetNotifyEvent;
+    lkpds.Open;
+    open;
+    Buffer:=ds.ActiveBuffer;
+
+    // If the state is dsInternalCalc, only the OnCalcField event should be called
+    THackDataset(ds).SetState(dsInternalCalc);
+    DataEvents:='';
+    StoreValue:=AFld3.Value;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals('CalculateFields;DatasetNotifyEvent;',DataEvents);
+    AssertEquals(VarToStr(StoreValue),VarToSTr(AFld3.Value));
+    THackDataset(ds).SetState(dsBrowse);
+
+    // Also if the dataset is Unidirectional, only the OnCalcField event should be called
+    THackDataset(ds).SetUniDirectional(True);
+    DataEvents:='';
+    StoreValue:=AFld3.Value;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals('CalculateFields;DatasetNotifyEvent;',DataEvents);
+    AssertEquals(VarToStr(StoreValue),VarToSTr(AFld3.Value));
+    THackDataset(ds).SetUniDirectional(False);
+
+    // Else, the value of all the lookup fields should get calculated
+    edit;
+    FieldByName('name').asstring := 'TestName3';
+    post;
+    DataEvents:='';
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals('CalculateFields;ClearCalcFields;DatasetNotifyEvent;',DataEvents);
+    AssertEquals('3',VarToStr(AFld3.Value));
+    end;
+end;
+
+procedure TTestDatasources.TestCalcLookupValue;
+var ds, lkpDs   : TDataset;
+    AFld1, AFld2, AFld3 : Tfield;
+    Buffer: pchar;
+begin
+  ds := DBConnector.GetNDataset(True,15);
+  lkpDs := DBConnector.GetNDataset(5);
+  with ds do
+    begin
+    AFld1 := TIntegerField.Create(ds);
+    AFld1.FieldName := 'ID';
+    AFld1.DataSet := ds;
+
+    AFld2 := TStringField.Create(ds);
+    AFld2.FieldName := 'NAME';
+    AFld2.DataSet := ds;
+
+    AFld3 := TIntegerField.Create(ds);
+    with AFld3 do
+      begin
+      FieldName := 'LookupFld';
+      FieldKind := fkLookup;
+      DataSet := ds;
+      LookupDataSet := lkpDs;
+      LookupKeyFields:='name';
+      LookupResultField:='ID';
+      KeyFields := 'name';
+      end;
+    ds.OnCalcFields:=DatasetNotifyEvent;
+    lkpds.Open;
+    open;
+    Next;
+    Buffer:=ds.ActiveBuffer;
+
+    // When LookupCache is true, use the lookupCache (Here with the 'wrong' value 412)
+    AFld3.LookupList.Clear;
+    AFld3.LookupList.Add('TestName2',412);
+    AFld3.LookupCache:=True;
+    // CalculateFields is the only way to call CalcLookupValue
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals(412,AFld3.AsInteger);
+
+    // Without lookupcache, return the right value
+    AFld3.LookupCache:=False;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals(2,AFld3.AsInteger);
+
+    // If there's no LookupDataset, the result should be Null
+    AFld3.LookupDataSet:= nil;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertTrue(AFld3.IsNull);
+
+    // If there's no LookupDataset, the result should be Null
+    AFld3.LookupDataSet:= nil;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertTrue(AFld3.IsNull);
+
+    // Same holds for closed lookupdatasets
+    AFld3.LookupDataSet:= lkpDs;
+    lkpDs.Close;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertTrue(AFld3.IsNull);
+    lkpds.Open;
+    
+    // Thing are getting interesting with multiple fields in the key:
+    AFld3.LookupKeyFields:='name;id';
+    AFld3.KeyFields := 'name;id';
+    AFld3.LookupCache:=True;
+    AFld3.LookupList.Clear;
+    AFld3.LookupList.Add(VarArrayOf(['TestName2',2]),112);
+    AFld3.LookupCache:=True;
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals(112,AFld3.AsInteger);
+    AFld3.LookupCache:=False;
+
+    // Now without a LookupCache
+    // Disabled this part, since tDbf has problems with multiple-field keys
+{
+    AFld3.LookupKeyFields:='name;id';
+    AFld3.KeyFields := 'name;id';
+    THackDataset(ds).CalculateFields(Buffer);
+    AssertEquals(2,AFld3.AsInteger);}
+    end;
+
+end;
+
+procedure TTestDatasources.TestEnableControls;
+var ds: TDataset;
+    ADataLink : TTestDataLink;
+    ADataSource : TDataSource;
+begin
+  ds := DBConnector.GetTraceDataset(False);
+  ADatasource := TDataSource.Create(nil);
+  ADatalink := TTestDataLink.Create;
+  ADatalink.DataSource := aDatasource;
+  ADataSource.DataSet := ds;
+  with ds do
+    begin
+    Open;
+    
+    // If DisableControls isn't called, nothing should happen.
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('',DataEvents);
+
+    DisableControls;
+    DisableControls;
+    // DisableControls is called twice. Ie: first call to enablecontrols should
+    // still do nothing.
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('',DataEvents);
+
+    // On this call to Enablecontrols, the controls should get enabled again:
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('SetCurrentRecord;deDataSetChange:0;',DataEvents);
+
+    // If the state of the dataset has been changed while the controls were
+    // disabled, then an deUpdateState event should be raised
+    DisableControls;
+    THackDataset(ds).SetState(dsSetKey);
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('deUpdateState:0;SetCurrentRecord;deDataSetChange:0;',DataEvents);
+    THackDataset(ds).SetState(dsBrowse);
+
+    // If the dataset is closed while the controls were disabled, then only
+    // an deUpdateState event should occur.
+    DisableControls;
+    Close;
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('deUpdateState:0;',DataEvents);
+
+    // And the same happens if the dataset was opened
+    DisableControls;
+    Open;
+    DataEvents:='';
+    EnableControls;
+    AssertEquals('deUpdateState:0;',DataEvents);
+    close;
+    end;
+  ADataLink.Free;
+  ADataSource.Free;
+end;
+
+initialization
+  if uppercase(dbconnectorname)='DBF' then RegisterTest(TTestDatasources);
+end.
+

packages/fcl-db/tests/testdbbasics.pas

@@ -38,6 +38,9 @@ type
     procedure TestOnFilter;
     procedure TestStringFilter;
 
+    procedure TestSetFieldValues;
+    procedure TestGetFieldValues;
+
     procedure TestAddIndex;
     procedure TestInactSwitchIndex;
 
@@ -110,7 +113,7 @@ type
 
 implementation
 
-uses toolsunit, bufdataset;
+uses toolsunit, bufdataset, variants;
 
 type THackDataLink=class(TdataLink);
 
@@ -559,6 +562,73 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestSetFieldValues;
+var PassException : boolean;
+begin
+  with DBConnector.GetNDataset(true,11) do
+    begin
+    open;
+    first;
+    edit;
+    FieldValues['id']:=5;
+    post;
+    AssertEquals('TestName1',FieldByName('name').AsString);
+    AssertEquals(5,FieldByName('id').AsInteger);
+    edit;
+    FieldValues['name']:='FieldValuesTestName';
+    post;
+    AssertEquals('FieldValuesTestName',FieldByName('name').AsString);
+    AssertEquals(5,FieldByName('id').AsInteger);
+    edit;
+    FieldValues['id;name']:= VarArrayOf([243,'ValuesTestName']);
+    post;
+    AssertEquals('ValuesTestName',FieldByName('name').AsString);
+    AssertEquals(243,FieldByName('id').AsInteger);
+    
+    PassException:=false;
+    try
+      edit;
+      FieldValues['id;name;fake']:= VarArrayOf([243,'ValuesTestName',4]);
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    post;
+    AssertTrue(PassException);
+    end;
+end;
+
+procedure TTestDBBasics.TestGetFieldValues;
+var AVar          : Variant;
+    PassException : boolean;
+begin
+  with DBConnector.GetNDataset(true,14) do
+    begin
+    open;
+    AVar:=FieldValues['id'];
+    AssertEquals(AVar,1);
+
+    AVar:=FieldValues['name'];
+    AssertEquals(AVar,'TestName1');
+
+    AVar:=FieldValues['id;name'];
+    AssertEquals(AVar[0],1);
+    AssertEquals(AVar[1],'TestName1');
+
+    AVar:=FieldValues['name;id;'];
+    AssertEquals(AVar[1],1);
+    AssertEquals(AVar[0],'TestName1');
+    
+    PassException:=false;
+    try
+      AVar:=FieldValues['name;id;fake'];
+    except
+      on E: EDatabaseError do PassException := True;
+    end;
+    AssertTrue(PassException);
+
+    end;
+end;
+
 procedure TTestDBBasics.TestFirst;
 var i : integer;
 begin

packages/fcl-db/tests/toolsunit.pas

@@ -52,6 +52,8 @@ type
        Function GetNDataset(AChange : Boolean; n : integer) : TDataset;  overload;
        Function GetFieldDataset : TDataSet; overload;
        Function GetFieldDataset(AChange : Boolean) : TDataSet; overload;
+       
+       Function GetTraceDataset(AChange : Boolean) : TDataset; virtual;
 
        procedure StartTest;
        procedure StopTest;
@@ -62,6 +64,7 @@ type
 
   TTestDataLink = class(TDataLink)
      protected
+       procedure DataSetScrolled(Distance: Integer); override;
 {$IFDEF fpc}
        procedure DataEvent(Event: TDataEvent; Info: Ptrint); override;
 {$ELSE}
@@ -250,12 +253,22 @@ end;
 { TTestDataLink }
 
 {$IFDEF FPC}
+
+procedure TTestDataLink.DataSetScrolled(Distance: Integer);
+begin
+  DataEvents := DataEvents + 'DataSetScrolled' + ':' + inttostr(Distance) + ';';
+  inherited DataSetScrolled(Distance);
+end;
+
 procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
 {$ELSE}
 procedure TTestDataLink.DataEvent(Event: TDataEvent; Info: Longint);
 {$ENDIF}
 begin
-  DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';';
+  if Event <> deFieldChange then
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + inttostr(info) + ';'
+  else
+    DataEvents := DataEvents + DataEventnames[Event] + ':' + TField(info).FieldName + ';';
   inherited DataEvent(Event, Info);
 end;
 
@@ -280,6 +293,11 @@ begin
   FUsedDatasets.Add(Result);
 end;
 
+function TDBConnector.GetTraceDataset(AChange: Boolean): TDataset;
+begin
+  result := GetNDataset(AChange,15);
+end;
+
 procedure TDBConnector.StartTest;
 begin
 // Do nothing?

packages/fcl-web/src/fpdatasetform.pp

@@ -506,7 +506,7 @@ begin
   if inputType in [fitcheckbox,fitradio] then
     Result := 'T'
   else
-    Result := FField.Text;
+    Result := FField.DisplayText;
   if assigned (FOnGetValue) then
     onGetValue(self,Result);
 end;
@@ -888,7 +888,13 @@ begin
           if Page < 0 then
             first
           else
-            RecNo := ((Page-1) * RecordsPerPage) + 1; // zero based? yes: + 1 has to be deleted
+            begin
+            try  // Catch exception if the record doesn't exist.
+              RecNo := ((Page-1) * RecordsPerPage) + 1; // zero based? yes: + 1 has to be deleted
+            except
+              Last;
+              end;
+            end;
           r := 0;
           while not eof and (r < RecordsPerPage) do
             begin
@@ -992,6 +998,7 @@ procedure THTMLDatasetFormEditProducer.ControlToTableDef (aControldef : TFormFie
   begin
     with TableDef.CopyTablePosition(aControlDef.LabelPos) do
       begin
+      FormField := aControldef;
       CellType := ctLabel;
       IsLabel := true;
       Value := aControldef.getLabel;
@@ -1063,6 +1070,7 @@ procedure THTMLDatasetFormShowProducer.ControlToTableDef (aControldef : TFormFie
       begin
       CellType := ctLabel;
       IsLabel := false;
+      FormField := aControldef;
       Value := aControlDef.getValue;
       if not FSeparateLabel and not FIncludeHeader then
         begin
@@ -1077,6 +1085,7 @@ procedure THTMLDatasetFormShowProducer.ControlToTableDef (aControldef : TFormFie
     with TableDef.CopyTablePosition(aControlDef.LabelPos) do
       begin
       CellType := ctLabel;
+      FormField := aControldef;
       IsLabel := true;
       Value := aControldef.getLabel;
       end;

packages/fcl-xml/src/htmlelements.pp

@@ -51,8 +51,8 @@ type
     property ElementTag : THTMLElementTag read FElementTag write FElementTag;
     property TagName : DOMString read GetTagName;
     property NodeName : DOMstring read GetTagName;
-    property AttrubuteNames [index:integer] : DOMString read GetAttributeName;
-    property AttrubuteValues [index:integer] : DOMString read GetAttributeValue;
+    property AttributeNames [index:integer] : DOMString read GetAttributeName;
+    property AttributeValues [index:integer] : DOMString read GetAttributeValue;
   end;
   THTMLElementClass = class of THTMLCustomELement;
 

packages/fcl-xml/src/htmlwriter.pp

@@ -62,6 +62,10 @@ type
     function FormButton (aname, caption, aOnClick: DOMstring) : THTML_Input;
     function FormHidden (aname, aValue: DOMstring) : THTML_Input;
     function FormFile (aname, aValue:DOMstring) : THTML_Input;
+    { Other usefull links to elements }
+    function Meta (aname, ahtpequiv,acontent: DOMString) : THTML_meta;
+    function Link (arel, ahref, athetype, amedia: DOMString) : THTML_link;
+    function Script (s, athetype, asrc: DOMString) : THTML_script;
     {$i wtagsintf.inc}
     property Document : THTMLDocument read FDocument write SetDocument;
     property CurrentElement : THTMLCustomElement read FCurrentElement write SetCurrentElement;
@@ -353,6 +357,39 @@ begin
     end;
 end;
 
+function THTMLwriter.Meta(aname, ahtpequiv, acontent: DOMString): THTML_meta;
+begin
+  result := tagmeta;
+  with result do
+    begin
+    name := aname;
+    httpequiv := ahtpequiv;
+    content := acontent;
+    end;
+end;
+
+function THTMLwriter.Link(arel, ahref, athetype, amedia: DOMString): THTML_link;
+begin
+  result := taglink;
+  with result do
+    begin
+    rel := arel;
+    href := ahref;
+    thetype := athetype;
+    media := amedia;
+    end;
+end;
+
+function THTMLwriter.Script(s, athetype, asrc: DOMString): THTML_script;
+begin
+  result := tagscript(s);
+  with result do
+    begin
+    thetype := athetype;
+    src := asrc;
+    end;
+end;
+
 {$i wtagsimpl.inc}
 
 end.