Класс TBaseTest

На который я буду ещё ссылаться:

 
unit BaseTest;
 
//
// Библиотека "DUnitTuning"
// Generated from UML model, root element: <<SimpleClass::Class>> Shared Delphi TFW::DUnitTuning::Source::TBaseTest
//
 
interface
 
uses
  l3Filer,
  TestFrameWork,
  l3CardinalList,
  l3EtalonsWorking
  ;
 
type
 ToLogProc = procedure (const aSt: AnsiString) of object;
 
 TimeToLogProc = procedure (aTime: Cardinal;
  const aSt: AnsiString;
  const aSubName: AnsiString) of object;
 
 TBaseTest = {abstract} class(TTestCase)
 private
 // private fields
   f_Starts : Tl3CardinalList;
    {* Начальные точки замеров}
 public
 // realized methods
   procedure CheckOutputWithInput(const aIn: AnsiString;
     const aOut: AnsiString;
     aHeaderBegin: AnsiChar;
     aEtalonNeedsComputerName: Boolean;
     aEtalonCanHaveDiff: Boolean;
     const anExtraFileName: AnsiString;
     aNeedsCheck: Boolean); overload; 
   procedure CheckWithEtalon(const aFileName: AnsiString;
    aHeaderBegin: AnsiChar);
   procedure CheckOutputWithInput(const aSt: AnsiString;
     aHeaderBegin: AnsiChar = #0;
     const anExtraFileName: AnsiString = '';
     aNeedsCheck: Boolean = true); overload; 
 protected
 // overridden protected methods
   procedure Cleanup; override;
   function GetEnabled: Boolean; override;
   procedure SetEnabled(Value: Boolean); override;
 protected
 // protected methods
   procedure ToLog(const aSt: AnsiString);
   function StartTimer: Longword;
   function StopTimer(const aSt: AnsiString = '';
     const aSubName: AnsiString = ''; aNeedTimeToLog : Boolean = true): Longword; overload; 
   class function FileFromCurrent(const aStr: AnsiString;
     aFolderMode: Boolean = False): AnsiString;
     {* Файл из текущей директории }
   procedure TimeToLog(aTime: Cardinal;
     const aSt: AnsiString;
     const aSubName: AnsiString;
     aIgnoreTestName: Boolean = false);
     {* Выводит замер времени в лог }
   function FileForOutput: AnsiString; virtual;
     {* Стандартный файл для вывода, для текщего теста }
   function FilerForOutput: Tl3CustomDosFiler;
   function FilerForInput(const aSt: AnsiString): Tl3CustomDosFiler;
   procedure CheckTimeout(aNow: Cardinal;
     aTimeout: Cardinal);
   function StopTimer(const aSt: AnsiString;
     aNeedTimeToLog: Boolean): Longword; overload; 
   function KPage: AnsiString;
     {* Страница в K }
   function IsGK: Boolean;
     {* Тесты запущены ГК }
   function EtalonSuffix: AnsiString;
     {* Суффикс имени эталонного файла }
   function EtalonNeedsComputerName: Boolean; virtual;
   class function OutputPath: AnsiString;
   function RaiseIfEtalonCreated: Boolean; virtual;
   function EtalonCanHaveDiff: Boolean; virtual;
     {* Эталон может иметь эталонную разницу для конкретного компьютера. Например как в [RequestLink:234362304] }
   function FileNameForOutput: AnsiString; virtual;
   function FolderFromCurrent(const aStr: AnsiString): AnsiString;
   function NeedCreateEtalonsWhileCheckingOutputWithInput: Boolean; virtual;
 public
 // public methods
   class function ComputerName: AnsiString;
   function AlwaysShowAFC: Boolean; virtual;
     {* Всегда показывать сравнивалку файлов, когда не пишем в К }
   class function TestSetFolderName: AnsiString;
 end;//TBaseTest
 
var
   f_ToLog : ToLogProc = nil;
var
   f_TimeToLog : TimeToLogProc = nil;
 
implementation
 
uses
  l3Base,
  Windows,
  SysUtils,
  l3Types,
  StrUtils,
  KTestRunner,
  l3String,
  l3ImageUtils
  ,
  l3Stream,
  l3FileUtils
  ;
 
// start class TBaseTest
 
procedure TBaseTest.ToLog(const aSt: AnsiString);
begin
 if Assigned(f_ToLog) then
  f_ToLog(aSt)
 else
  l3System.Msg2Log(ClassName + '.' + FTestName + ': ' + aSt);
end;//TBaseTest.ToLog
 
function TBaseTest.StartTimer: Longword;
begin
 if (f_Starts = nil) then
  f_Starts := Tl3CardinalList.Make;
 Result := GetTickCount;
 f_Starts.Add(Result);
end;//TBaseTest.StartTimer
 
function TBaseTest.StopTimer(const aSt: AnsiString = '';
  const aSubName: AnsiString = ''; aNeedTimeToLog : Boolean = true): Longword;
begin
 Assert(f_Starts <> nil);
 Assert(f_Starts.Count > 0);
 Result := GetTickCount - f_Starts.Last;
 f_Starts.Delete(f_Starts.Hi);
 if aNeedTimeToLog then
  TimeToLog(Result, aSt, aSubName);
end;//TBaseTest.StopTimer
 
class function TBaseTest.FileFromCurrent(const aStr: AnsiString;
  aFolderMode: Boolean = False): AnsiString;
begin
 Result := KTestRunner.FileFromCurrent(aStr, aFolderMode, false);
end;//TBaseTest.FileFromCurrent
 
procedure TBaseTest.TimeToLog(aTime: Cardinal;
  const aSt: AnsiString;
  const aSubName: AnsiString;
  aIgnoreTestName: Boolean = false);
var
 l_S : AnsiString;
begin
 if Assigned(f_TimeToLog) then
 begin
  if aIgnoreTestName then
   l_S := ''
  else
   l_S := ClassName + '.' + FTestName;
  if (aSt <> '') then
  begin
   if (l_S = '') then
    l_S := aSt
   else
    l_S := l_S + '.' + aSt;
  end;//aSt <> ''
  f_TimeToLog(aTime, l_S, aSubName);
 end//Assigned(f_TimeToLog)
 else
 begin
  l_S := 'time ' + IntToStr(aTime) + ' ms';
  if (aSubName <> '') then
   l_S := aSubName + ' ' + l_S;
  if (aSt <> '') then
   l_S := aSt + ' done: ' + l_S;
  ToLog(l_S);
 end;//Assigned(f_TimeToLog)
end;//TBaseTest.TimeToLog
 
function TBaseTest.FileForOutput: AnsiString;
var
 l_TestFolder: AnsiString;
begin
 if FolderMode then
 begin
  l_TestFolder := OutputPath + DataSubFolder;
  if not DirectoryExists(l_TestFolder) then
   CreateDir(l_TestFolder);
  l_TestFolder := l_TestFolder + '';
 end // if FolderMode then
 else
  l_TestFolder := OutputPath;
 Result := l_TestFolder + FileNameForOutput + '.out';
end;//TBaseTest.FileForOutput
 
function TBaseTest.FilerForOutput: Tl3CustomDosFiler;
begin
 Result := Tl3CustomDosFiler.Make(FileForOutput, l3_fmWrite, false);
end;//TBaseTest.FilerForOutput
 
function TBaseTest.FilerForInput(const aSt: AnsiString): Tl3CustomDosFiler;
begin
 Result := Tl3CustomDosFiler.Make(FileFromCurrent(aSt), l3_fmRead, false);
end;//TBaseTest.FilerForInput
 
procedure TBaseTest.CheckTimeout(aNow: Cardinal;
  aTimeout: Cardinal);
begin
 Check(GetTickCount - aNow < aTimeout);
end;//TBaseTest.CheckTimeout
 
function TBaseTest.StopTimer(const aSt: AnsiString;
  aNeedTimeToLog: Boolean): Longword;
begin
 Result := StopTimer(aSt, '', aNeedTimeToLog);
end;//TBaseTest.StopTimer
 
function TBaseTest.KPage: AnsiString;
begin
 if FolderMode then
  Result := Name
 else
 begin
  Result := ClassName;
  if IsScript then
   Result := CorrectScriptKPageName(Self)
  else
  begin
   Assert(AnsiStartsStr('TK', Result));
   Delete(Result, 1, 2);
  end; 
 end // if Self.DataSubFolder = '' then
end;//TBaseTest.KPage
 
function TBaseTest.IsGK: Boolean;
begin
 Result := KTestRunner.IsGK;
end;//TBaseTest.IsGK
 
function TBaseTest.EtalonSuffix: AnsiString;
begin
 Result := '.etalon';
 if EtalonNeedsComputerName then
  Result := '.' + ComputerName + Result;
end;//TBaseTest.EtalonSuffix
 
function TBaseTest.EtalonNeedsComputerName: Boolean;
begin
 Result := false;
end;//TBaseTest.EtalonNeedsComputerName
 
class function TBaseTest.ComputerName: AnsiString;
var
 l_CompSize : Integer;
begin
 l_CompSize := MAX_COMPUTERNAME_LENGTH + 1;
 SetLength(Result, l_CompSize);
 
 Win32Check(GetComputerNameA(PAnsiChar(Result), LongWord(l_CompSize)));
 SetLength(Result, l_CompSize);
end;//TBaseTest.ComputerName
 
class function TBaseTest.OutputPath: AnsiString;
begin
 Result := ExtractFilePath(ParamStr(0)) + TestSetFolderName + ''
end;//TBaseTest.OutputPath
 
function TBaseTest.RaiseIfEtalonCreated: Boolean;
begin
 Result := true;
end;//TBaseTest.RaiseIfEtalonCreated
 
function TBaseTest.EtalonCanHaveDiff: Boolean;
begin
 Result := false;
end;//TBaseTest.EtalonCanHaveDiff
 
function TBaseTest.FileNameForOutput: AnsiString;
begin
 if FolderMode then
  Result := FTestName
 else
  Result := ClassName + '_' + FTestName;
end;//TBaseTest.FileNameForOutput
 
function TBaseTest.AlwaysShowAFC: Boolean;
begin
 Result := false;
end;//TBaseTest.AlwaysShowAFC
 
function TBaseTest.FolderFromCurrent(const aStr: AnsiString): AnsiString;
begin
 Result := KTestRunner.FileFromCurrent(aStr, false, true);
end;//TBaseTest.FolderFromCurrent
 
function TBaseTest.NeedCreateEtalonsWhileCheckingOutputWithInput: Boolean;
begin
 Result := true;
end;//TBaseTest.NeedCreateEtalonsWhileCheckingOutputWithInput
 
class function TBaseTest.TestSetFolderName: AnsiString;
begin
 Result := 'TestSet';
 {$IfDef Monitorings}
 Result := Result + 'Prime';
 {$Else  Monitorings}
 {$IfDef Admin}
 Result := Result + 'Admin';
 {$EndIf Admin}
 {$EndIf Monitorings}
end;//TBaseTest.TestSetFolderName
 
procedure TBaseTest.CheckOutputWithInput(const aIn: AnsiString;
  const aOut: AnsiString;
  aHeaderBegin: AnsiChar;
  aEtalonNeedsComputerName: Boolean;
  aEtalonCanHaveDiff: Boolean;
  const anExtraFileName: AnsiString;
  aNeedsCheck: Boolean);
 
 procedure ToUnicode(var aDiff : AnsiString);
 var
  l_In  : Text;
  l_Out : Tl3CustomFiler;
  l_S   : Tl3String;
  l_L   : AnsiString;
  l_Now : Cardinal;
 begin//ToUnicode
  l_Now := GetTickCount;
  while not FileExists(aDiff) do
  begin
   Sleep(300);
   CheckTimeout(l_Now, 20 * 60 * 1000);
  end;///while not FileExists(aDiff)
  l_S := Tl3String.Create;
  try
   AssignFile(l_In, aDiff);
   repeat
    try
     Reset(l_In);
    except
     continue;
    end;//try..except 
    break;
   until false;
   try
    aDiff := aDiff + '.uni';
    l_Out := Tl3CustomDosFiler.Make(aDiff, l3_fmWrite);
    try
     //l_Out.CodePage := CP_Unicode;
     l_Out.Open;
     try
      //l_Out.Write(#$FF#$FE);
      //l_Out.Write(#$FE#$FF);
      while not EOF(l_In) do
      begin
       System.ReadLn(l_In, l_L);
       l_S.AsString := l_L;
       l_S.CodePage := CP_Unicode;
       ConvertUTF16toUTF8(l_S.AsWideString, l_L, strictConversion, false);
       l_Out.Write(l_L);
       l_Out.OutEOL;
       l_S._CodePage := CP_ANSI;
      end;//while not EOF(l_In)
     finally
      l_Out.Close;
     end;//try..finally
    finally
     FreeAndNil(l_Out);
    end;//try..finally
   finally
    CloseFile(l_In);
   end;//try..finally
  finally
   FreeAndNil(l_S);
  end;//try..finally
 end;//ToUnicode
 
 procedure WaitDiff(const aDiff : AnsiString);
 var
  l_Counter : Integer;
 begin//WaitDiff
  Sleep(300);
  l_Counter := 10;
  while (l_Counter > 0) AND
        (not FileExists(aDiff) OR
         (l3FileUtils.GetFileSize(aDiff) <= 0)) do
  begin
   Sleep(300);
   Dec(l_Counter);
  end;///while not FileExists(aDiff)
 end;//WaitDiff
 
 procedure MakeDiff(const aIn, aOut : AnsiString; var aDiff : AnsiString);
 var
  l_Params : AnsiString;
  l_Bat    : AnsiString;
 begin//MakeDiff
  l_Bat := Format('%sd.cmd', [ExtractFilePath(ParamStr(0))]);
  Assert(FileExists(l_Bat), 'Не найдена утилита ' + l_Bat);
  l_Params := Format('%s "%s" "%s" "%s" "%s"', [l_Bat, aIn, aOut, aDiff, ExtractFilePath(ParamStr(0))]);
  WinExec(PAnsiChar(l_Params), SW_HIDE);
  WaitDiff(aDiff);
  ToUnicode(aDiff);
 end;//MakeDiff
 
 procedure MakeSDiff(const aIn, aOut : AnsiString; var aDiff : AnsiString);
 var
  l_Params : AnsiString;
  l_Bat    : AnsiString;
 begin//MakeSDiff
  l_Bat := Format('%ssd.cmd', [ExtractFilePath(ParamStr(0))]);
  Assert(FileExists(l_Bat), 'Не найдена утилита ' + l_Bat);
  l_Params := Format('%s "%s" "%s" "%s" %s', [l_Bat, aIn, aOut, aDiff, ExtractFilePath(ParamStr(0))]);
  WinExec(PAnsiChar(l_Params), SW_HIDE);
  WaitDiff(aDiff);
  ToUnicode(aDiff);
  if not IsWritingToK then
   if aNeedsCheck OR AlwaysShowAFC then
   begin
    l_Params := Format('afc.cmd "%s" "%s"', [aIn, aOut]);
    WinExec(PAnsiChar(l_Params), {SW_HIDE}SW_SHOWNORMAL);
 (*   l_Params := 'notepad ' + aDiff;
    WinExec(PAnsiChar(l_Params), {SW_HIDE}SW_SHOWNORMAL);*)
   end;//not IsWritingToK
 end;//MakeSDiff
 
 function MangleFileName(const aName : AnsiString): AnsiString;
 begin//MangleFileName
  Result := ExpandUNCFileName(l3Transliterate(aName));
  if (Result <> '') AND IsWritingToK then
  begin
   Result := Format('[[%s|^%s]]', [Result, ExtractFileName(Result)]);
  end;//IsWritingToK
 end;//MangleFileName
 
var
 l_CVS         : AnsiString;
 l_CVSPath     : AnsiString;
 l_Msg         : AnsiString;
 l_Compared    : Boolean;
 l_Diff        : AnsiString;
 l_UDiff       : AnsiString;
 l_SDiff       : AnsiString;
 l_Extra       : AnsiString;
 l_ExtraEtalon : AnsiString;
 l_ExtraDiff   : AnsiString;
 l_Ext         : AnsiString;
begin
 if NeedCreateEtalonsWhileCheckingOutputWithInput then
 begin
  if not IsWritingToK OR aEtalonNeedsComputerName then
  begin
   if not FileExists(aIn) then
   begin
    CopyFile(aOut, aIn);
    if not IsFakeCVS then
    begin
     l_CVSPath := g_CVSPath + '' + TestSetFolderName + '';
     if DirectoryExists(l_CVSPath) then
     begin
      l_CVS := l_CVSPath + ExtractFileName(aIn);
      if not FileExists(l_CVS) then
      begin
       CopyFile(aOut, l_CVS);
       ToLog(Format('Сделан эталон для помещения в CVS - "%s"', [l_CVS]));
      end;//not FileExists(l_CVS)
     end;//DirectoryExists(l_CVSPath)
    end;//not IsFakeCVS
    l_Msg := Format('Эталон "%s" не существовал. Сделан новый на основе "%s"', [aIn, aOut]);
    if RaiseIfEtalonCreated AND not IsWritingToK then
     Check(false, l_Msg)
    else
     l3System.Msg2Log(l_Msg);
   end;//not FileExists(aIn)
  end;//not IsWritingToK
 end;//NeedCreateEtalonsWhileCheckingOutputWithInput 
 l_Compared := l3CompareFiles(aIn,
                              aOut,
                              aHeaderBegin);
 if not l_Compared then
 begin
  if (anExtraFileName <> '') then
  begin
   l_Extra := FileFromCurrent(anExtraFileName);
   l_Ext := ExtractFileExt(l_Extra);
   l_ExtraEtalon := ChangeFileExt(anExtraFileName, EtalonSuffix + l_Ext);
   l_ExtraEtalon := FileFromCurrent(l_ExtraEtalon);
   if ANSISametext(l_Ext, '.png') then
   begin
    l_ExtraDiff := ChangeFileExt(anExtraFileName, '.diff' + l_Ext);
    l_ExtraDiff := OutputPath + l_ExtraDiff;
    l3BuildComparisonImage(l_ExtraEtalon, l_Extra, l_ExtraDiff);
   end//ANSISametext(l_Ext, '.png')
   else
    l_ExtraDiff := '';
  end//anExtraFileName <> ''
  else
   l_Extra := '';
  l_Diff := aOut + '.diff.log';
  l_UDiff := l_Diff;
  l_SDiff := aOut + '.sdiff.log';
  MakeDiff(aIn, aOut, l_UDiff);
  MakeSDiff(aIn, aOut, l_SDiff);
  if IsWritingToK then
  begin
   {$If defined(MTDORB) AND defined(NoKPageTool)}
   if TKBridge.Exists then
   {$IfEnd} //MTDORB AND NoKPageTool
   begin
    TKTestListener.AttachFile(TKTestListener.ResultsPage, aIn);
    TKTestListener.AttachFile(TKTestListener.ResultsPage, aOut);
    TKTestListener.AttachFile(TKTestListener.ResultsPage, l_UDiff);
    TKTestListener.AttachFile(TKTestListener.ResultsPage, l_SDiff);
    if (l_Extra <> '') then
    begin
     TKTestListener.AttachFile(TKTestListener.ResultsPage, l_Extra);
     TKTestListener.AttachFile(TKTestListener.ResultsPage, l_ExtraEtalon);
    end;//l_Extra <> ''
    if (l_ExtraDiff <> '') then
     TKTestListener.AttachFile(TKTestListener.ResultsPage, l_ExtraDiff);
   end;//TKBridge.Exists
  end;//IsWritingToK
  if aEtalonCanHaveDiff then
  begin
   l_Compared := true;
   CheckOutputWithInput(FileFromCurrent(ExtractFileName(l_Diff) + '.' + ComputerName + '.etalon'),
                        l_Diff,
                        #0,
                        true,
                        false,
                        '',
                        true);
  end;//aEtalonCanHaveDiff
 end;//not l_Compared
 if not l_Compared then
 begin
  l_Msg := Format('Не прошло сравнение: afc "%s" "%s".'+ #13#10 +
               'Результаты сравнения: "%s" "%s"',
               [MangleFileName(aIn),
                MangleFileName(aOut),
                MangleFileName(l_UDiff),
                MangleFileName(l_SDiff)
               ]);
  if (l_Extra <> '') then
   l_Msg := l_Msg + #13#10 +
            Format('Дополнительное сравнение: afc %s %s',
                   [MangleFileName(l_Extra),
                    MangleFileName(l_ExtraEtalon)
                   ]);
  if (l_ExtraDiff <> '') then
   l_Msg := l_Msg + #13#10 +
            Format('Разница: %s',
                   [MangleFileName(l_ExtraDiff)
                   ]);
  if aNeedsCheck then
   Check(l_Compared, l_Msg)
  else
  begin
(*   if IsWritingToK then
    TKTestListener.WriteMsg(l_Msg)
    // - это чтобы было нормальное wiki-оформление
   else*)
    l3System.Msg2Log(l_Msg);
   Exit; 
  end;//aNeedsCheck
 end;//not l_Compared
 ToLog('Compare done');
end;//TBaseTest.CheckOutputWithInput
 
procedure TBaseTest.CheckWithEtalon(const aFileName: AnsiString;
  aHeaderBegin: AnsiChar);
var
 l_S : AnsiString;
begin
 l_S := ExtractFileName(aFileName) + EtalonSuffix + ExtractFileExt(aFileName);
 CheckOutputWithInput(FileFromCurrent(l_S), aFileName, aHeaderBegin,
                      false, false, '', true);
end;//TBaseTest.CheckWithEtalon
 
procedure TBaseTest.CheckOutputWithInput(const aSt: AnsiString;
  aHeaderBegin: AnsiChar = #0;
  const anExtraFileName: AnsiString = '';
  aNeedsCheck: Boolean = true);
begin
 CheckOutputWithInput(FileFromCurrent(aSt),
                      FileForOutput,
                      aHeaderBegin,
                      EtalonNeedsComputerName,
                      EtalonCanHaveDiff,
                      anExtraFileName,
                      aNeedsCheck);
end;//TBaseTest.CheckOutputWithInput
 
procedure TBaseTest.Cleanup;
begin
 FreeAndNil(f_Starts);
 inherited;
end;//TBaseTest.Cleanup
 
function TBaseTest.GetEnabled: Boolean;
begin
(* Result := (ClassName = 'TK235875079');
 Exit;*)
(* Result := (ClassName = 'TK259164768') OR
           (ClassName = 'TK235869064');
 Exit;*)
 if IsTestExcluded(Self) then
  Result := false
 else
  Result := inherited GetEnabled;
end;//TBaseTest.GetEnabled
 
procedure TBaseTest.SetEnabled(Value: Boolean);
begin
 if Value then
  if IsTestExcluded(Self) then
   Value := false;
 inherited SetEnabled(Value);
end;//TBaseTest.SetEnabled
 
end.