fcl-db: dbtestframework:

+ add support for logging test execution/sqldb log events to file. Enable by setting the the logfile= entry in database.ini

git-svn-id: trunk@27329 -

packages/fcl-db/tests/sqldbtoolsunit.pas

@@ -48,6 +48,10 @@ type
     procedure CreateFieldDataset; override;
     procedure DropNDatasets; override;
     procedure DropFieldDataset; override;
+    // If logging is enabled, this procedure will receive the event
+    // from the SQLDB logging system
+    // For custom logging call with sender nil and eventtype detCustom
+    procedure GetLogEvent(Sender: TSQLConnection; EventType: TDBEventType; Const Msg : String);
     Function InternalGetNDataset(n : integer) : TDataset; override;
     Function InternalGetFieldDataset : TDataSet; override;
     procedure TryDropIfExist(ATableName : String);
@@ -189,6 +193,12 @@ begin
     UserName := dbuser;
     Password := dbpassword;
     HostName := dbhostname;
+    if dblogfilename<>'' then
+    begin
+      LogEvents:=[detCustom,detCommit,detExecute,detRollBack];
+      OnLog:=@GetLogEvent;
+    end;
+
     if (dbhostname='') and (SQLConnType=interbase) then
     begin
       // Firebird embedded: create database file if it doesn't yet exist
@@ -396,6 +406,8 @@ begin
     end;
 end;
 
+
+
 procedure TSQLDBConnector.SetTestUniDirectional(const AValue: boolean);
 begin
   FUniDirectional:=avalue;
@@ -427,7 +439,12 @@ begin
 
     Ftransaction.Commit;
   except
-    if Ftransaction.Active then Ftransaction.Rollback
+    on E: Exception do begin
+      if dblogfilename<>'' then
+        GetLogEvent(nil,detCustom,'Exception running CreateNDatasets: '+E.Message);
+      if Ftransaction.Active then
+        Ftransaction.Rollback
+    end;
   end;
 end;
 
@@ -524,7 +541,8 @@ begin
     Ftransaction.Commit;
   except
     on E: Exception do begin
-      //writeln(E.Message);
+      if dblogfilename<>'' then
+        GetLogEvent(nil,detCustom,'Exception running CreateFieldDataset: '+E.Message);
       if Ftransaction.Active then Ftransaction.Rollback;
     end;
   end;
@@ -540,7 +558,11 @@ begin
       Fconnection.ExecuteDirect('DROP TABLE FPDEV');
       Ftransaction.Commit;
     Except
-      if Ftransaction.Active then Ftransaction.Rollback
+      on E: Exception do begin
+        if dblogfilename<>'' then
+          GetLogEvent(nil,detCustom,'Exception running DropNDatasets: '+E.Message);
+        if Ftransaction.Active then Ftransaction.Rollback
+      end;
     end;
     end;
 end;
@@ -555,11 +577,32 @@ begin
       Fconnection.ExecuteDirect('DROP TABLE FPDEV_FIELD');
       Ftransaction.Commit;
     Except
-      if Ftransaction.Active then Ftransaction.Rollback
+      on E: Exception do begin
+        if dblogfilename<>'' then
+          GetLogEvent(nil,detCustom,'Exception running DropFieldDataset: '+E.Message);
+        if Ftransaction.Active then Ftransaction.Rollback
+      end;
     end;
     end;
 end;
 
+procedure TSQLDBConnector.GetLogEvent(Sender: TSQLConnection;
+  EventType: TDBEventType; const Msg: String);
+var
+  Category: string;
+begin
+  case EventType of
+    detCustom:   Category:='Custom';
+    detPrepare:  Category:='Prepare';
+    detExecute:  Category:='Execute';
+    detFetch:    Category:='Fetch';
+    detCommit:   Category:='Commit';
+    detRollBack: Category:='Rollback';
+    else Category:='Unknown event. Please fix program code.';
+  end;
+  LogMessage(Category,Msg);
+end;
+
 function TSQLDBConnector.InternalGetNDataset(n: integer): TDataset;
 begin
   Result := CreateQuery;

packages/fcl-db/tests/testbufdatasetstreams.pas

@@ -760,12 +760,12 @@ end;
 
 procedure TTestBufDatasetStreams.SetUp;
 begin
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TTestBufDatasetStreams.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
 end;
 
 

packages/fcl-db/tests/testdatasources.pas

@@ -58,12 +58,12 @@ end;
 
 procedure TTestDatasources.SetUp;
 begin
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TTestDatasources.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
 end;
 
 {procedure TTestDatasources.TestDataEventsResync;

packages/fcl-db/tests/testdbexport.pas

@@ -163,7 +163,7 @@ procedure TTestDBExport.SetUp;
 begin
   inherited SetUp;
   InitialiseDBConnector;
-  DBConnector.StartTest; //is this needed?
+  DBConnector.StartTest(TestName);
   FExportTempDir:=IncludeTrailingPathDelimiter(ExpandFileName(''))+'exporttests'+PathDelim; //Store output in subdirectory
   ForceDirectories(FExportTempDir);
   FKeepFilesAfterTest:=true; //keep test files; consistent with other units right now
@@ -172,7 +172,7 @@ end;
 procedure TTestDBExport.TearDown;
 begin
   inherited TearDown;
-  DBConnector.StopTest; //is this needed?
+  DBConnector.StopTest(TestName);
   FreeDBConnector;
 end;
 

packages/fcl-db/tests/testfieldtypes.pas

@@ -1196,8 +1196,8 @@ begin
     with query do
       begin
       SQL.Text:='select NAME from FPDEV where ID<5';
-      sql.Add('union');
-      sql.Add('select NAME from FPDEV where ID>5');
+      SQL.Add('union');
+      SQL.Add('select NAME from FPDEV where ID>5');
       Open;
       close;
       end;
@@ -2345,12 +2345,12 @@ end;
 procedure TTestFieldTypes.SetUp;
 begin
   InitialiseDBConnector;
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TTestFieldTypes.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
   if assigned(DBConnector) then
     TSQLDBConnector(DBConnector).Transaction.Rollback;
   FreeDBConnector;

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -124,12 +124,12 @@ end;
 
 procedure TTestSpecificTBufDataset.SetUp;
 begin
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TTestSpecificTBufDataset.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
 end;
 
 procedure TTestSpecificTBufDataset.CreateDatasetFromFielddefs;

packages/fcl-db/tests/testspecifictdbf.pas

@@ -108,12 +108,12 @@ end;
 
 procedure TTestSpecificTDBF.SetUp;
 begin
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TTestSpecificTDBF.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
 end;
 
 procedure TTestSpecificTDBF.TestTableLevel;

packages/fcl-db/tests/testsqldb.pas

@@ -266,12 +266,12 @@ procedure TSQLDBTestCase.SetUp;
 begin
   inherited SetUp;
   InitialiseDBConnector;
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TSQLDBTestCase.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
   if assigned(DBConnector) then
     with TSQLDBConnector(DBConnector) do
       Transaction.Rollback;

packages/fcl-db/tests/toolsunit.pas

@@ -23,6 +23,7 @@ type
   TDBConnectorClass = class of TDBConnector;
   TDBConnector = class(TPersistent)
      private
+       FLogTimeFormat: TFormatSettings; //for error logging only
        FFormatSettings: TFormatSettings;
        FChangedFieldDataset : boolean;
      protected
@@ -53,6 +54,10 @@ type
        // They should clean up all mess, like tables on disk or on a DB server
        procedure DropNDatasets; virtual; abstract;
        procedure DropFieldDataset; virtual; abstract;
+
+       // If logging is enabled, writes Message to log file and flushes
+       // Logging uses tab-separated columns
+       procedure LogMessage(Category,Message: string);
      public
        constructor Create; virtual;
        destructor Destroy; override;
@@ -67,8 +72,10 @@ type
        // Gets a dataset that tracks calculation of calculated fields etc.
        Function GetTraceDataset(AChange : Boolean) : TDataset; virtual;
 
-       procedure StartTest;
-       procedure StopTest;
+       // Run before a test is started
+       procedure StartTest(TestName: string);
+       // Run after a test is stopped
+       procedure StopTest(TestName: string);
        property TestUniDirectional: boolean read GetTestUniDirectional write SetTestUniDirectional;
        property FormatSettings: TFormatSettings read FFormatSettings;
      end;
@@ -217,7 +224,9 @@ var dbtype,
     dbuser,
     dbhostname,
     dbpassword,
+    dblogfilename,
     dbQuoteChars   : string;
+    dblogfile      : TextFile;
     DataEvents     : string;
     DBConnector    : TDBConnector;
     testValues     : Array [TFieldType,0..testvaluescount -1] of string;
@@ -247,6 +256,17 @@ begin
   FFormatSettings.TimeSeparator:=':';
   FFormatSettings.ShortDateFormat:='yyyy/mm/dd';
   FFormatSettings.LongTimeFormat:='hh:nn:ss.zzz';
+
+  // Set up time format for logging output:
+  // ISO 8601 type date string so logging is uniform across machines
+  FLogTimeFormat.DecimalSeparator:='.';
+  FLogTimeFormat.ThousandSeparator:=#0;
+  FLogTimeFormat.DateSeparator:='-';
+  FLogTimeFormat.TimeSeparator:=':';
+  FLogTimeFormat.ShortDateFormat:='yyyy-mm-dd';
+  FLogTimeFormat.LongTimeFormat:='hh:nn:ss';
+
+
   FUsedDatasets := TFPList.Create;
   CreateFieldDataset;
   CreateNDatasets;
@@ -316,15 +336,17 @@ begin
   result := GetNDataset(AChange,NForTraceDataset);
 end;
 
-procedure TDBConnector.StartTest;
+procedure TDBConnector.StartTest(TestName: string);
 begin
-  // Do nothing?
+  // Log if necessary
+  LogMessage('Test','Starting test '+TestName);
 end;
 
-procedure TDBConnector.StopTest;
+procedure TDBConnector.StopTest(TestName: string);
 var i : integer;
     ds : TDataset;
 begin
+  LogMessage('Test','Stopping test '+TestName);
   for i := 0 to FUsedDatasets.Count -1 do
     begin
     ds := tdataset(FUsedDatasets[i]);
@@ -341,6 +363,23 @@ begin
     end;
 end;
 
+procedure TDBConnector.LogMessage(Category,Message: string);
+begin
+  if dblogfilename<>'' then //double check: only if logging enabled
+    begin
+    try
+      Message:=StringReplace(Message, #9, '\t', [rfReplaceAll, rfIgnoreCase]);
+      Message:=StringReplace(Message, LineEnding, '\n', [rfReplaceAll, rfIgnoreCase]);
+      writeln(dbLogFile, TimeToStr(Now(), FLogTimeFormat) + #9 +
+        Category + #9 +
+        Message);
+      Flush(dbLogFile); //in case tests crash
+    except
+      // ignore log file errors
+    end;
+    end;
+end;
+
 
 { TTestDataLink }
 
@@ -387,12 +426,12 @@ end;
 procedure TDBBasicsTestCase.SetUp;
 begin
   inherited SetUp;
-  DBConnector.StartTest;
+  DBConnector.StartTest(TestName);
 end;
 
 procedure TDBBasicsTestCase.TearDown;
 begin
-  DBConnector.StopTest;
+  DBConnector.StopTest(TestName);
   inherited TearDown;
 end;
 
@@ -448,11 +487,42 @@ begin
   dbhostname := IniFile.ReadString(dbtype,'Hostname','');
   dbpassword := IniFile.ReadString(dbtype,'Password','');
   dbconnectorparams := IniFile.ReadString(dbtype,'ConnectorParams','');
+  dblogfilename := IniFile.ReadString(dbtype,'LogFile','');
   dbquotechars := IniFile.ReadString(dbtype,'QuoteChars','"');
 
   IniFile.Free;
 end;
 
+procedure SetupLog;
+begin
+  if dblogfilename<>'' then
+  begin
+    try
+      AssignFile(dblogfile,dblogfilename);
+      if not(FileExists(dblogfilename)) then
+      begin
+        ReWrite(dblogfile);
+        CloseFile(dblogfile);
+      end;
+      Append(dblogfile);
+    except
+      dblogfilename:=''; //rest of code relies on this as a log switch
+    end;
+  end;
+end;
+
+procedure CloseLog;
+begin
+  if dblogfilename<>'' then
+    begin
+    try
+      CloseFile(dbLogFile);
+    except
+      // Ignore log file errors
+    end;
+    end;
+end;
+
 procedure InitialiseDBConnector;
 
 const B: array[boolean] of char=('0','1');  // should be exported from some main db unit, as SQL true/false?
@@ -557,6 +627,10 @@ end;
 
 initialization
   ReadIniFile;
+  SetupLog;
   DBConnectorRefCount:=0;
+
+finalization
+  CloseLog;
 end.