From 3065e3289b70a9527384dd728788fbb870d5c8db Mon Sep 17 00:00:00 2001 From: reiniero Date: Sat, 29 Mar 2014 10:17:31 +0000 Subject: [PATCH] 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 | 51 ++++++++++- .../fcl-db/tests/testbufdatasetstreams.pas | 4 +- packages/fcl-db/tests/testdatasources.pas | 4 +- packages/fcl-db/tests/testdbexport.pas | 4 +- packages/fcl-db/tests/testfieldtypes.pas | 8 +- .../fcl-db/tests/testspecifictbufdataset.pas | 4 +- packages/fcl-db/tests/testspecifictdbf.pas | 4 +- packages/fcl-db/tests/testsqldb.pas | 4 +- packages/fcl-db/tests/toolsunit.pas | 88 +++++++++++++++++-- 9 files changed, 144 insertions(+), 27 deletions(-) diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas index f1ebdd5748..109dbd4857 100644 --- a/packages/fcl-db/tests/sqldbtoolsunit.pas +++ b/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; diff --git a/packages/fcl-db/tests/testbufdatasetstreams.pas b/packages/fcl-db/tests/testbufdatasetstreams.pas index bc07bc898a..97da51ad13 100644 --- a/packages/fcl-db/tests/testbufdatasetstreams.pas +++ b/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; diff --git a/packages/fcl-db/tests/testdatasources.pas b/packages/fcl-db/tests/testdatasources.pas index 4f99dc7dfb..cb5de0df6b 100644 --- a/packages/fcl-db/tests/testdatasources.pas +++ b/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; diff --git a/packages/fcl-db/tests/testdbexport.pas b/packages/fcl-db/tests/testdbexport.pas index 44319da25a..a7a40952fb 100644 --- a/packages/fcl-db/tests/testdbexport.pas +++ b/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; diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index a7db99f120..45e83eb69d 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/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; diff --git a/packages/fcl-db/tests/testspecifictbufdataset.pas b/packages/fcl-db/tests/testspecifictbufdataset.pas index 49866cb224..11b8449910 100644 --- a/packages/fcl-db/tests/testspecifictbufdataset.pas +++ b/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; diff --git a/packages/fcl-db/tests/testspecifictdbf.pas b/packages/fcl-db/tests/testspecifictdbf.pas index d7e4faafd0..6631999535 100644 --- a/packages/fcl-db/tests/testspecifictdbf.pas +++ b/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; diff --git a/packages/fcl-db/tests/testsqldb.pas b/packages/fcl-db/tests/testsqldb.pas index ac5b2a7cf0..3d97dca39e 100644 --- a/packages/fcl-db/tests/testsqldb.pas +++ b/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; diff --git a/packages/fcl-db/tests/toolsunit.pas b/packages/fcl-db/tests/toolsunit.pas index f31c8cdfb4..3277776127 100644 --- a/packages/fcl-db/tests/toolsunit.pas +++ b/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.