+ added several tests

 + restructured tests
 + new ini-file format

git-svn-id: trunk@4012 -

fcl/db/sqldb/examples/database.ini

@@ -9,7 +9,7 @@
 # * odbc
 # * postgresql
 
-type=oracle
+type=interbase
 
 # name
 # gives the name of the database that should be used.
@@ -17,7 +17,7 @@ type=oracle
 # used. More information about how to create a dabatase can be find in the
 # documentation of the database-engine.
 
-name=//192.168.3.1/xe
+name=/opt/firebird/examples/employee.fdb
 
 # user
 # name is the name of a user which must have all rights on the selected
@@ -26,12 +26,11 @@ name=//192.168.3.1/xe
 # How to set up users and their rights can be found in the database-engine
 # documentation.
 
-user=system
+user=sysdba
 
 # password
 # password is the password of the provided user. If the password is incorrect,
 # all or one  of the test could fail.
 
-password=rosivrepus
+password=masterkey
 
-hostname=

fcl/dbtests/database.ini

@@ -1,34 +1,31 @@
 [Database]
+type=oracle
 
-# type
-# gives the type of the database-engine. Valid values are:
-# * interbase
-# * mysql
-# * postgresql
-
-type=postgresql
-
-# name
-# gives the name of the database that should be used.
-# This could be a file-name or an alias, dependent on which database-engine is
-# used. More information about how to create a dabatase can be find in the
-# documentation of the database-engine.
-
+[postgresql]
 name=testdb
-
-# user
-# name is the name of a user which must have all rights on the selected
-# database. If the user has insufficient rights, all or one of the test could
-# fail.
-# How to set up users and their rights can be found in the database-engine
-# documentation.
-
 user=
+password=
+hostname=
 
-# password
-# password is the password of the provided user. If the password is incorrect,
-# all or one  of the test could fail.
+[mysql40]
+name=test
+user=root
+password=
+hostname=192.168.3.1
 
+[oracle]
+name=xe
+user=system
 password=
+hostname=192.168.3.1
+
+[interbase]
+name=/opt/firebird/examples/employee.fdb
+user=sysdba
+password=masterkey
 
+[dbf]
+name=/tmp
+user=
+password=
 hostname=

fcl/dbtests/dbtestframework.pas

@@ -11,7 +11,7 @@ program dbtestframework;
 uses
   SysUtils,
   fpcunit,testregistry,
-  testbasics,
+  testbasics, toolsunit,
 {$ifdef SQLDB_AVAILABLE}
   testsqlfieldtypes,
 {$ENDIF}

fcl/dbtests/sqldbtoolsunit.pas

@@ -9,6 +9,8 @@ uses
   db,
   sqldb, ibconnection, mysql40conn, mysql41conn, mysql50conn, pqconnection,odbcconn,oracleconnection;
 
+const SQLDBdbTypes = [mysql40,mysql41,mysql50,postgresql,interbase,odbc,oracle];
+      MySQLdbTypes = [mysql40,mysql41,mysql50];
 
 type
 
@@ -38,13 +40,13 @@ implementation
 procedure TSQLDBConnector.CreateFConnection;
 
 begin
-  if dbtype = 'mysql40' then Fconnection := tMySQL40Connection.Create(nil);
-  if dbtype = 'mysql41' then Fconnection := tMySQL41Connection.Create(nil);
-  if dbtype = 'mysql50' then Fconnection := tMySQL50Connection.Create(nil);
-  if dbtype = 'postgresql' then Fconnection := tpqConnection.Create(nil);
-  if dbtype = 'interbase' then Fconnection := tIBConnection.Create(nil);
-  if dbtype = 'odbc' then Fconnection := tODBCConnection.Create(nil);
-  if dbtype = 'oracle' then Fconnection := TOracleConnection.Create(nil);
+  if dbtype = mysql40 then Fconnection := tMySQL40Connection.Create(nil);
+  if dbtype = mysql41 then Fconnection := tMySQL41Connection.Create(nil);
+  if dbtype = mysql50 then Fconnection := tMySQL50Connection.Create(nil);
+  if dbtype = postgresql then Fconnection := tpqConnection.Create(nil);
+  if dbtype = interbase then Fconnection := tIBConnection.Create(nil);
+  if dbtype = odbc then Fconnection := tODBCConnection.Create(nil);
+  if dbtype = oracle then Fconnection := TOracleConnection.Create(nil);
 
   if not assigned(Fconnection) then writeln('Invalid database-type, check if a valid database-type was provided in the file ''database.ini''');
 

fcl/dbtests/testdbbasics.pas

@@ -21,8 +21,9 @@ type
   protected
     procedure SetUp; override;
     procedure TearDown; override;
-    procedure RunTest; override;
   published
+    procedure TestBufDatasetCancelUpdates; //bug 6938
+    procedure TestBufDatasetCancelUpdates1;
     procedure TestDoubleClose;
     procedure TestAssignFieldftString;
     procedure TestAssignFieldftFixedChar;
@@ -31,14 +32,12 @@ type
     procedure TestMove;                    // bug 5048
     procedure TestActiveBufferWhenClosed;
     procedure TestEOFBOFClosedDataset;
+    procedure TestDataEventsResync;
+    procedure TestBug7007;
     procedure TestdeFieldListChange;
     procedure TestLastAppendCancel;        // bug 5058
     procedure TestRecNo;                   // bug 5061
     procedure TestSetRecNo;                // bug 6919
-
-    procedure TestBufDatasetCancelUpdates; //bug 6938
-    procedure TestBufDatasetCancelUpdates1;
-
   end;
 
   { TSQLTestSetup }
@@ -185,6 +184,37 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.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;
+//    first;
+    DataEvents := '';
+    Resync([rmExact]);
+    AssertEquals('deDataSetChange:0;',DataEvents);
+    DataEvents := '';
+    next;
+    AssertEquals('deCheckBrowseMode:0;DataEvent;deDataSetScroll:0;',DataEvents);
+    close;
+    end;
+  aDatasource.Free;
+  aDatalink.Free;
+end;
+
+
+
 procedure TTestDBBasics.TestLastAppendCancel;
 
 var count : integer;
@@ -311,13 +341,6 @@ begin
   DBConnector.FreeDatasets;
 end;
 
-procedure TTestDBBasics.RunTest;
-begin
-  inherited RunTest;
-//  inherited RunTest;
-//  inherited RunTest;
-end;
-
 procedure TTestDBBasics.TestDoubleClose;
 begin
   with DBConnector.GetNDataset(1) do
@@ -368,6 +391,7 @@ end;
 procedure TTestDBBasics.TestBufDatasetCancelUpdates;
 var i : byte;
 begin
+  AssertTrue(SIgnoreAssertion,DBConnector.GetNDataset(5) is TBufDataset);
   with DBConnector.GetNDataset(5) as TBufDataset do
     begin
     open;
@@ -393,9 +417,57 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.Testbug7007;
+
+var
+ datalink1: tdatalink;
+ datasource1: tdatasource;
+ query1: TDataSet;
+
+begin
+ query1:= DBConnector.GetNDataset(6);
+ datalink1:= TTestDataLink.create;
+ datasource1:= tdatasource.create(nil);
+ try
+  datalink1.datasource:= datasource1;
+  datasource1.dataset:= query1;
+  datalink1.datasource:= datasource1;
+
+  DataEvents := '';
+  query1.open;
+  datalink1.buffercount:= query1.recordcount;
+  AssertEquals('deUpdateState:0;',DataEvents);
+  AssertEquals(0, datalink1.ActiveRecord);
+  AssertEquals(6, datalink1.RecordCount);
+  AssertEquals(6, query1.RecordCount);
+  AssertEquals(1, query1.RecNo);
+
+  DataEvents := '';
+  query1.append;
+  AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
+  AssertEquals(5, datalink1.ActiveRecord);
+  AssertEquals(6, datalink1.RecordCount);
+  AssertEquals(6, query1.RecordCount);
+  AssertEquals(0, query1.RecNo);
+
+
+  DataEvents := '';
+  query1.cancel;
+  AssertEquals('deCheckBrowseMode:0;deUpdateState:0;deDataSetChange:0;',DataEvents);
+  AssertEquals(5, datalink1.ActiveRecord);
+  AssertEquals(6, datalink1.RecordCount);
+  AssertEquals(6, query1.RecordCount);
+  AssertEquals(6, query1.RecNo);
+  finally
+  datalink1.free;
+  datasource1.free;
+ end;
+end;
+
 procedure TTestDBBasics.TestBufDatasetCancelUpdates1;
 var i : byte;
 begin
+  AssertTrue(SIgnoreAssertion,DBConnector.GetNDataset(5) is TBufDataset);
   with DBConnector.GetNDataset(5) as TBufDataset do
     begin
     open;

fcl/dbtests/testsqlfieldtypes.pas

@@ -22,12 +22,12 @@ type
     procedure RunTest; override;
   published
     procedure TestInt;
+    procedure TestFloat;
+    procedure TestDateTime;       // bug 6925
     procedure TestNumeric;
     procedure TestString;
     procedure TestUnlVarChar;
     procedure TestDate;
-    procedure TestDateTime;       // bug 6925
-    procedure TestFloat;
 
     procedure TestNullValues;
     procedure TestParamQuery;
@@ -137,7 +137,7 @@ begin
     Open;
     for i := 0 to testValuesCount-1 do
       begin
-      if (dbtype='mysql40') or  (dbtype='mysql41') or (dbtype='mysql50') then
+      if (dbtype in MySQLdbTypes) then
         AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL automatically trims strings
       else
         AssertEquals(testValues[i],fields[0].AsString);
@@ -180,7 +180,7 @@ var
   i             : byte;
 
 begin
-  if dbtype <> 'postgresql' then exit; // Only postgres accept this type-definition
+  AssertTrue(SIgnoreAssertion,dbtype = postgresql); // Only postgres accept this type-definition
   CreateTableWithFieldType(ftString,'VARCHAR');
   TestFieldDeclaration(ftString,dsMaxStringSize+1);
 
@@ -232,7 +232,10 @@ begin
   TestFieldDeclaration(ftDate,8);
 
   for i := 0 to testValuesCount-1 do
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+    if dbtype=oracle then
+      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD''))')
+    else
+      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
 
 //  TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
 
@@ -294,11 +297,14 @@ begin
   CreateTableWithFieldType(ftDateTime,'TIMESTAMP');
   TestFieldDeclaration(ftDateTime,8);
   
-  if dbtype='mysql40' then corrTestValueCount := testValuesCount-21
+  if dbtype=mysql40 then corrTestValueCount := testValuesCount-21
     else corrTestValueCount := testValuesCount;
 
   for i := 0 to corrTestValueCount-1 do
-    TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
+    if dbtype=oracle then
+      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
+    else
+      TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
 
   with TSQLDBConnector(DBConnector).Query do
     begin
@@ -578,15 +584,11 @@ end;
 
 procedure TTestFieldTypes.RunTest;
 begin
-  if (dbtype = 'interbase') or
-     (dbtype = 'mysql50') or
-     (dbtype = 'mysql40') or
-     (dbtype = 'mysql41') or
-     (dbtype = 'postgresql') then
+  if (dbtype in SQLDBdbTypes) then
     inherited RunTest;
 end;
 
 initialization
-  RegisterTest(TTestFieldTypes);
+  if dbtype in SQLDBdbTypes then RegisterTest(TTestFieldTypes);
 end.
 

fcl/dbtests/toolsunit.pas

@@ -24,6 +24,7 @@ type
        Procedure FreeNDataset(var ds : TDataset); virtual; abstract;
        Function CreateNDataset(n : integer) : TDataset; virtual; abstract;
      public
+       procedure DataEvent(dataset :TDataset);
        Function GetNDataset(n : integer) : TDataset; virtual;
        procedure InitialiseDatasets; virtual;
        procedure FreeDatasets; virtual;
@@ -39,10 +40,14 @@ type
 {$ELSE}
        procedure DataEvent(Event: TDataEvent; Info: longint); override;
 {$ENDIF}
-
      end;
 
+type TDBTypes=(mysql40,mysql41,mysql50,interbase,postgresql,odbc,oracle,dbf);
+
 const
+  DBTypesNames : Array [TDBTypes] of String[19] =
+     ('mysql40','mysql41','mysql50','interbase','postgresql','odbc','oracle','dbf');
+
   DataEventnames : Array [TDataEvent] of String[19] =
     ('deFieldChange', 'deRecordChange', 'deDataSetChange', 'deDataSetScroll',
      'deLayoutChange', 'deUpdateRecord', 'deUpdateState', 'deCheckBrowseMode',
@@ -50,7 +55,7 @@ const
 {$IFNDEF VER2_0_2}, 'deConnectChange','deReconcileError','deDisabledStateChange'{$ENDIF}
     );
 
-var dbtype,
+var dbtype          : TDBTypes;
     dbname,
     dbuser,
     dbhostname,
@@ -62,6 +67,9 @@ var dbtype,
 
 procedure InitialiseDBConnector;
 
+resourcestring
+  SIgnoreAssertion = 'You can safely ignore this failure. This function is just not supported by the selected database';
+
 implementation
 
 uses
@@ -73,29 +81,40 @@ uses
 {$ENDIF}
   inifiles;
 
+procedure TDBConnector.DataEvent(dataset : tdataset);
+
+begin
+  DataEvents := DataEvents + 'DataEvent' + ';';
+end;
+
 procedure ReadIniFile;
 
 var IniFile : TIniFile;
+    s       : string;
+    i       : TDBTypes;
 begin
   IniFile := TIniFile.Create(getcurrentdir + PathDelim + 'database.ini');
-  dbtype := IniFile.ReadString('Database','Type','');
-  dbname := IniFile.ReadString('Database','Name','');
-  dbuser := IniFile.ReadString('Database','User','');
-  dbhostname := IniFile.ReadString('Database','Hostname','');
-  dbpassword := IniFile.ReadString('Database','Password','');
+  s := IniFile.ReadString('Database','Type','');
+  for i := low(DBTypesNames) to high(DBTypesNames) do
+    if s = DBTypesNames[i] then dbtype := i;
+
+  dbname := IniFile.ReadString(s,'Name','');
+  dbuser := IniFile.ReadString(s,'User','');
+  dbhostname := IniFile.ReadString(s,'Hostname','');
+  dbpassword := IniFile.ReadString(s,'Password','');
   IniFile.Free;
 end;
 
 procedure InitialiseDBConnector;
 
 begin
-  ReadIniFile;
+//  ReadIniFile;
   if (1 <> 1) then begin end
 {$IFDEF SQLDB_AVAILABLE}
-  else if (dbtype = 'interbase') or (dbtype = 'postgresql') or (dbtype = 'mysql50') or (dbtype = 'mysql40') or (dbtype = 'mysql41')  then DBConnector := TSQLDBConnector.Create
+  else if (dbtype in SQLDBdbTypes)  then DBConnector := TSQLDBConnector.Create
 {$ENDIF}
 {$IFDEF DBF_AVAILABLE}
-  else if dbtype = 'dbf' then DBConnector := TDBFDBConnector.Create
+  else if dbtype = dbf then DBConnector := TDBFDBConnector.Create
 {$ENDIF}
   else Raise Exception.Create('Invalid database-type specified');
 end;
@@ -133,5 +152,7 @@ begin
     FreeNDataset(FDatasets[count]);
 end;
 
+initialization
+  ReadIniFile;
 end.