воскресенье, 15 марта 2015 г.

GUI-testing 1. About tests and specially fitted “checkpoints”

Original in Russian: http://18delphi.blogspot.ru/2013/04/blog-post_6244.html

GUI-testing. Table of contents

I’ll start with a lyrical digression.

Once I had a computer BK-0010.01. I paid a fantastic sum of 500 roubles for it.

Anyway, I could not connect it to my TV-set. The TV-set had no AV-input. “For video tape recorders”.

My father and I solved the problem. Under my father’s keen guidance I got to know that any radio and television equipment has “checkpoints”. These are the “pins” on the board to which either sensors (for example, oscillograph) or signal sources (for example, frequency generator) are connected.

We found the required checkpoint. It was next to the high and low frequency conversion stage. I can well remember, it called KT-26.

My father and I soldered a connector and connected the computer to it.

And so I entered the happy world of “home computers”. I could learn the architecture of PDP-11 in practice.

Later, when I mastered the technique, I repeated this trick a few times on my own, without my father, with computers and TV-sets of my friends. All were happy. The key thing was taking circuit from TV-set and finding the checkpoint with required parameters in it. So to speak, “matching the required connector with the required INTERFACE”.

Now, let’s get down to business.

When I “seriously” went in for “unit”-testing, I remembered about this technique and decided to apply it in practice. Luckily, it proved to be very usable.

I’ll try to give an example.

Unfortunately – it can not be compiled. I can’t discover the whole code (for the reasons mentioned here - http://18delphi.blogspot.com/2013/04/disclaimer.html  ). However, I hope the idea will be clear from the snippet I’ll give. It is not simple, not just three lines. But, as for me, very significant.

So.

Let’s get back to my first post - http://18delphi.blogspot.com/2013/03/blog-post.html

In it I gave a glowing explanation that the test of print preview was my “first one” in DUnit technology. Which is actually quite true.

Now, let’s see how it looks like.

The test itself:

unit PreviewTestBefore;

// Generated from UML model, root element: TestCase::Class Shared Delphi Operations For Tests::TestFormsTest::Everest::TPreviewTestBefore235875079
//
// Test of constructing Preview

interface

uses
  afwInterfaces,
  TextEditorVisitor,
  evHAFPainterEx,
  nevShapesPaintedSpy,
  afwPreviewPageSpy,
  l3Interfaces,
  PrimTextLoad_Form,
  nevTools,
  afwPreviewPage
  ;

type
 TPreviewTest = {abstract} class(TTextEditorVisitor, IafwPreviewPanel, InevShapesLogger, IafwPagesLogger)
  {* Test of constructing Preview }
 private
 // private fields
   f_Done : Boolean;
   f_Now : Cardinal;
    {* Time of test launch}
 protected
 // realized methods
   procedure SetCurrentPage(aValue: Integer);
   procedure Invalidate;
   procedure Done;
   procedure pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
   function pm_GetPainted: Boolean;
   procedure DoVisit(aForm: TPrimTextLoadForm); override;
     {* Process the text }
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
   procedure LogPage(aPage: TafwPreviewPage;
     aCounter: Boolean);
   function ShouldStop: Boolean;
 protected
 // overridden protected methods
   procedure InitFields; override;
   function FileForOutput: AnsiString; override;
     {* Standard output file, for the current test }
   function GetNormalFontSize: Integer; override;
     {* Returns the size of the font of the “normal” style. 0 – by default }
   function GetFolder: AnsiString; override;
     {* Folder containing the test }
   function RaiseIfEtalonCreated: Boolean; override;
 protected
 // protected fields
   f_LogNumber : Integer;
   f_CurrentOutput : AnsiString;
 protected
 // protected methods
   function PageFileName(aNumber: Integer;
     aWidthNumber: Integer;
     aCounter: Boolean;
     anEtalon: Boolean): AnsiString;
     {* Name of the file for saving the page }
   procedure ReadColontituls(var theColontituls: TevColontituls); virtual;
   function GetHAFFontSize: Integer; virtual;
     {* Size of page headers. 0 – by default }
 end;//TPreviewTest

implementation

uses
  Windows,
  evStyleInterface,
  evdStyles,
  SysUtils,
  vtPreviewPanel,
  Controls,
  Forms,
  l3String,
  l3Stream,
  l3Types,
  imageenio,
  l3FileUtils,
  Graphics,
  Classes,
  KTestRunner,
  evPreviewForTestsTuning,
  l3Defaults,
  l3CanvasPrim,
  TestFrameWork
  ;

// start class TPreviewTestBefore

function TPreviewTest.PageFileName(aNumber: Integer;
  aWidthNumber: Integer;
  aCounter: Boolean;
  anEtalon: Boolean): AnsiString;
var
 l_Et : String;
 l_C  : String;
 l_WN : String;
begin
 if aCounter then
  l_C := 'C_'
 else
  l_C := '';
 if (aWidthNumber = 0) then
  l_WN := ''
 else
  l_WN := '.' + l3LeftPadChar(IntToStr(aWidthNumber), 2, '0');
 if anEtalon then
  l_Et := EtalonSuffix
 else
  l_Et := ''; 
 Result := Format('%s%s.%s%s%s%s.png',
                  [OutputPath,
                   KPage,
                   l_C,
                   l3LeftPadChar(IntToStr(aNumber), 4, '0'),
                   l_WN,
                   l_Et
                  ]);
end;//TPreviewTest.PageFileName

procedure TPreviewTest.ReadColontituls(var theColontituls: TevColontituls);
begin
 // - we do nothing, everything is by default
end;//TPreviewTest.ReadColontituls

function TPreviewTest.GetHAFFontSize: Integer;
begin
 Result := 0; 
end;//TPreviewTest.GetHAFFontSize

procedure TPreviewTest.SetCurrentPage(aValue: Integer);
begin
 // - we do nothing
end;//TPreviewTest.SetCurrentPage

procedure TPreview.Invalidate;
begin
 // - we do nothing
 CheckTimeout(f_Now, 120 * 60 * 1000)
 // - we check if we loop
end;//TPreviewTest.Invalidate

procedure TPreviewTest.Done;
begin
 f_Done := true;
end;//TPreviewTest.Done

procedure TPreviewTest.pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
begin
 // - we do nothing
end;//TPreviewTest.pm_SetPreviewCanvas

function TPreviewTest.pm_GetPainted: Boolean;
begin
 Result := false;
end;//TPreviewTest.pm_GetPainted

procedure TPreviewTest.DoVisit(aForm: TPrimTextLoadForm);
var 
 PP : TvtPreviewPanel;
 l_OnReadColontituls : TevReadColontitulsEvent;
 l_SI : TevStyleInterface;
 l_Size : Integer;
 l_NewSize : Integer;
begin
   TafwPreviewPageSpy.Instance.SetLogger(Self);
   try
    TnevShapesPaintedSpy.Instance.SetLogger(Self);
    try
     l_SI := TevStyleInterface.Make;
     try
      l_SI.SelectStyle(ev_saHFRight);
      l_NewSize := GetHAFFontSize;
      l_Size := l_SI.Font.Size;
      try
       if (l_NewSize > 0) then
       begin
        l_SI.SelectStyle(ev_saHFLeft);
        l_SI.Font.Size := l_NewSize;
        l_SI.SelectStyle(ev_saHFRight);
        l_SI.Font.Size := l_NewSize;
       end;//l_NewSize > 0
       l_OnReadColontituls := g_OnReadColontituls;
       try
        g_OnReadColontituls := Self.ReadColontituls;
        // --------------
        // There is the code one has to uncomment if he wishes to see
        // the results of preview constructing
    (*    try
         PP := TvtPreviewPanel.Create(aForm);
         PP.Align := alClient;
         PP.Parent := aForm;
         PP.Preview := aForm.Text.Preview;
         PP.ZoomToPage(1,1,true);
        except
        end;//try..except
        repeat
         try
          Application.ProcessMessages;
         except
         end;//try..except
        until Application.Terminated;
        Exit;*)
        // --------------
        StartTimer;
        try
         f_Now := GetTickCount;
         aForm.Text.Preview.Update(Self);
        finally
         StopTimer('Preview.Update');
        end;//try..finally
       finally
        g_OnReadColontituls := l_OnReadColontituls;
       end;//try..finally
       Check(f_Done);
      finally
       l_SI.SelectStyle(ev_saHFLeft);
       l_SI.Font.Size := l_Size;
       l_SI.SelectStyle(ev_saHFRight);
       l_SI.Font.Size := l_Size;
      end;//try..finally
     finally
      FreeAndNil(l_SI);
     end;//try..finally
    finally
     TnevShapesPaintedSpy.Instance.RemoveLogger(Self);
    end;//try..finally
   finally
    TafwPreviewPageSpy.Instance.RemoveLogger(Self);
   end;//try..finally
end;//TPreviewTest.DoVisit

function TPreviewTest.OpenLog(const aView: InevView): AnsiString;
var
 l_Cnv : InevInfoCanvas;
 l_C : String;
 l_WN : String;
 l_Page : Integer;

 procedure MakeName;
 begin//MakeName
  Result := Format('%s%s.%s%s%s.shapes',
                   [OutputPath,
                    KPage,
                    l_C,
                    l3LeftPadChar(IntToStr(l_Page), 4, '0'),
                    l_WN
                   ]);
 end;//MakeName

begin
 //Inc(f_LogNumber);
 l_Cnv := aView.Metrics.InfoCanvas;
 if l_Cnv.IsPagesCounter then
  l_C := 'C_'
 else
  l_C := '';
 if (f_LogNumber = 0) then
  l_WN := ''
 else
  l_WN := '.' + l3LeftPadChar(IntToStr(f_LogNumber), 2, '0');
 f_LogNumber := l_Cnv.PageWidthNumber;
 l_Page := l_Cnv.PageNumber;
 if (l_Page > 1) then
  Dec(l_Page)
 else
  Assert(l_Page = 1);
 MakeName;
 //Result := OutputPath + KPage + '.' + l3LeftPadChar(IntToStr(f_LogNumber), 4, '0') + '.shapes';
 if (Result = f_CurrentOutput) then
 begin
  Inc(l_Page);
  MakeName;
 end;//Result = f_CurrentOutput
 f_CurrentOutput := Result;
end;//TPreviewTest.OpenLog

procedure TPreviewTest.CloseLog(const aLogName: AnsiString);
var
 l_N : String;
 l_Extra : String;
 l_Counter : Boolean;
begin
 l_N := ExtractFileName(aLogName);
 l_Counter := (Pos('.C_', l_N) > 0);
 if l_Counter then
  l_Extra := ''
 else
  l_Extra := ChangeFileExt(l_N, '.png');
 CheckOutputWithInput(ChangeFileExt(l_N, EtalonSuffix + '.shapes'),
                      #0,
                      l_Extra,
                      not l_Counter);
end;//TPreviewTest.CloseLog

function TPreviewTest.LogScreen(const aView: InevView): Boolean;
begin
 with aView.Metrics.InfoCanvas do
  Result := Printing AND not IsVirtual;
end;//TPreviewTest.LogScreen

procedure TPreviewTest.LogPage(aPage: TafwPreviewPage;
  aCounter: Boolean);
var
 l_EN  : String;
 l_N   : String;
 l_IO : TImageEnIO;
 l_B  : Graphics.TBitmap;
 l_CVSPath : String;
 l_CVS : String;
begin
 if aCounter then
  Exit;
 if (aPage.PageNumber <= 0) then
  Exit; 
 l_EN := PageFileName(aPage.PageNumber, aPage.PageWidthNumber, aCounter, true);
 l_N := PageFileName(aPage.PageNumber, aPage.PageWidthNumber, aCounter, false);
 l_IO := TImageEnIO.Create(nil);
 try
  l_B := Graphics.TBitmap.Create;
  try
   l_B.PixelFormat := pf24bit;
   l_B.Width := Trunc(IafwPreviewPage(aPage).GetMMWidth * 0.01 * 96 / 25.4);
   l_B.Height := Trunc(IafwPreviewPage(aPage).GetMMHeight * 0.01 * 96 / 25.4);
   IafwPreviewPage(aPage).DrawTo(Rect(0, 0, l_B.Width, l_B.Height), l_B);
   l_IO.Bitmap := l_B;
   l_IO.Params.BitsPerSample := 8;
   l_IO.Params.SamplesPerPixel := 1;
   l_IO.SaveToFilePNG(l_N);
  finally
   FreeAndNil(l_B);
  end;//try..finally
 finally
  FreeAndNil(l_IO);
 end;//try..finally
 if not IsWritingToK then
 begin
  if not FileExists(l_EN) then
   CopyFile(l_N, l_EN);
  if not IsFakeCVS then
  begin
   l_CVSPath := g_CVSPath + '\' + TestSetFolderName + '\';
   if DirectoryExists(l_CVSPath) then
   begin
    l_CVS := l_CVSPath + ExtractFileName(l_EN);
    if not FileExists(l_CVS) then
    begin
     CopyFile(l_N, l_CVS);
     ToLog(Format('The etalon to be loaded to CVS has been made - "%s"', [l_CVS]));
    end;//not FileExists(l_CVS)
   end;//DirectoryExists(l_CVSPath)
  end;//not IsFakeCVS
 end;//not IsWritingToK
end;//TPreviewTest.LogPage

procedure TPreviewTest.InitFields;
begin
 inherited;
 f_LogNumber := 0;
 f_CurrentOutput := '';
end;//TPreviewTest.InitFields

function TPreviewTest.FileForOutput: AnsiString;
begin
 Assert(f_CurrentOutput <> '');
 Result := f_CurrentOutput;
end;//TPreviewTest.FileForOutput

function TPreviewTest.GetNormalFontSize: Integer;
begin
 Result := 12;
end;//TPreviewTest.GetNormalFontSize

function TPreviewTest.RaiseIfEtalonCreated: Boolean;
begin
 Result := false;
end;//TPreviewTest.RaiseIfEtalonCreated

end.

The test implements interfaces IafwPreviewPanel, InevShapesLogger, IafwPagesLogger and connects to the “connector” (checkpoint) TnevShapesPaintedSpy and to the connector TafwPreviewPageSpy.

The interfaces look like this:

 IafwPreviewPanel = interface(IafwBase)
  {* Panel Print-preview. }
   ['{2DF654AF-58CD-4D9D-8F24-E3696D42EB3A}']
   procedure pm_SetPreviewCanvas(const aValue: IafwPreviewCanvas);
   function pm_GetPainted: Boolean;
   procedure SetCurrentPage(aValue: Integer);
   procedure Invalidate;
   procedure Done;
   property PreviewCanvas: IafwPreviewCanvas
     write pm_SetPreviewCanvas;
   property Painted: Boolean
     read pm_GetPainted;
 end;//IafwPreviewPanel

 InevShapesLogger = interface(IUnknown)
  {* Log of the drawn objects }
   ['{D33CDAF3-2F4B-422C-879E-56B02F0686F9}']
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
 end;//InevShapesLogger



 IafwPagesLogger = interface(IUnknown)
   ['{19361554-2DE2-4E58-B896-503677BDD13B}']
   procedure LogPage(aPage: TafwPreviewPage;
    aCounter: Boolean);
 end;//IafwPagesLogger

Now, the connector TnevShapesPaintedSpy looks like this:

unit nevShapesPaintedSpy;

// Generated from UML model, root element: SimpleClass::Class Shared Delphi::Everest::Views::TnevShapesPaintedSpy
//
// “Watchdog” of the drawn objects. {RequestLink:235864309}

interface

uses
  l3Filer,
  nevTools,
  nevShapesPainted,
  l3ProtoObject
  ;

type
 InevShapesLogger = interface(IUnknown)
  {* Log of the drawn object }
   ['{D33CDAF3-2F4B-422C-879E-56B02F0686F9}']
   function OpenLog(const aView: InevView): AnsiString;
   procedure CloseLog(const aLogName: AnsiString);
   function LogScreen(const aView: InevView): Boolean;
 end;//InevShapesLogger

 TnevShapesPaintedSpy = class(Tl3ProtoObject)
  {* “Watchdog” of the drawn objects. [RequestLink:235864309] }
 private
 // private fields
   f_Logger : InevShapesLogger;
   f_Filer : Tl3CustomFiler;
 protected
 // overridden protected methods
   procedure Cleanup; override;
     {* Function of object fields cleaning. }
   procedure ClearFields; override;
 public
 // public methods
   procedure LogShapes(const aView: InevView;
     aShapes: TnevBaseTopShape);
     {* Logs the drawn objects }
   procedure SetLogger(const aLogger: InevShapesLogger);
   procedure RemoveLogger(const aLogger: InevShapesLogger);
   class function Exists: Boolean;
   function LogScreen(const aView: InevView): Boolean;
 public
 // singleton factory method
   class function Instance: TnevShapesPaintedSpy;
    {- returns a singleton instance. }
 end;//TnevShapesPaintedSpy

implementation

uses
  l3Base {a},
  SysUtils,
  l3Types,
  k2Tags,
  l3String,
  evParaTools,
  nevBase,
  l3MinMax
  ;

// start class TnevShapesPaintedSpy

var g_TnevShapesPaintedSpy : TnevShapesPaintedSpy = nil;

procedure TnevShapesPaintedSpyFree;
begin
 FreeAndNil(g_TnevShapesPaintedSpy);
end;

class function TnevShapesPaintedSpy.Instance: TnevShapesPaintedSpy;
begin
 if (g_TnevShapesPaintedSpy = nil) then
 begin
  l3System.AddExitProc(TnevShapesPaintedSpyFree);
  g_TnevShapesPaintedSpy := Create;
 end;
 Result := g_TnevShapesPaintedSpy;
end;

procedure TnevShapesPaintedSpy.LogShapes(const aView: InevView;
  aShapes: TnevBaseTopShape);

 procedure LogShape(aShape : TnevShape);

  function MangleCoord(aValue : Integer): Integer;
  // - here we mangle the coordinates ON PURPOSE, so that tests were done on a larger number of test machines

   function EpsilonIt(aValue : Integer): Integer;
   begin//EpsilonIt
    if (aValue > 0) then
     Result := Max(0, aValue - 20)
    else
    if (aValue < 0) then
     Result := Min(0, aValue + 20)
    else
     Result := aValue;
   end;//EpsilonIt

  begin//MangleCoord
   Result := (EpsilonIt(aValue) div 100) * 100;
  end;//MangleCoord

 var
  l_Index     : Integer;
  l_ImageInfo : PnevControlImageInfo;
 begin//LogShape
  if (aShape <> nil) then
  begin
   f_Filer.WriteLn('----');

   with aShape.__Obj do
   begin
    f_Filer.WriteLn(Format('Obj type = %s', [TagType.AsString]));
    if HasSubAtom(k2_tiText) then
     f_Filer.WriteLn(Format('Text = ''%s''', [l3ReplaceNonReadable(StrA[k2_tiText])]));
   end;//with aShape.__Obj
   if (aShape.Count <> 0) then
    f_Filer.WriteLn(Format('Count = %d', [aShape.Count]));
   with aShape.Bounds do
    f_Filer.WriteLn(Format('Rect = (%d, %d, %d, %d)', [MangleCoord(Top),
                                                       MangleCoord(Left),
                                                       MangleCoord(Bottom),
                                                       MangleCoord(Right)]));
   Assert(aShape.__FI <> nil);
   with aShape.__FI do
   begin
    if (Width <> 0) OR (Height <> 0) then
     f_Filer.WriteLn(Format('Dim = (%d, %d)', [MangleCoord(Width),
                                               MangleCoord(Height)]));
    if Hidden then
     f_Filer.WriteLn(Format('Hidden = %d', [Ord(Hidden)]));
    if (MaxLinesCount <> 0) then
     f_Filer.WriteLn(Format('MaxLinesCount = %d', [MaxLinesCount]));
    if (DeltaHeight <> 0) then
     f_Filer.WriteLn(Format('DeltaHeight = %d', [MangleCoord(DeltaHeight)]));
    if (Zoom <> 100) then
     f_Filer.WriteLn(Format('Zoom = %d', [Zoom]));
    if (Lines <> nil) then
     if (Lines.Count <> 1) then
      f_Filer.WriteLn(Format('LinesCount = %d', [Lines.Count]));
   end;//with aShape.__FI
   if LogScreen(aView) and evHasOwnStyle(aShape.__Obj) then
   begin
    l_ImageInfo := aShape.__FI.ImageInfo;
    if (l_ImageInfo.rFirstIndex > -1) or (l_ImageInfo.rLastIndex > -1) then
    begin
     f_Filer.WriteLn('----');
     f_Filer.WriteLn(Format('ImageInfo FirstIndex = %d, LastIndex = %d', [l_ImageInfo.rFirstIndex, l_ImageInfo.rLastIndex]));
    end; // if EvHasOwnStyle(aShape.__Obj) then
   end; // if EvHasOwnStyle(aShape.__Obj) then
   for l_Index := 0 to Pred(aShape.Count) do
    LogShape(aShape.Items[l_Index]);
  end;//aShape <> nil
 end;//LogShape

var
 l_LogName : String;
begin
 if (f_Logger <> nil) then
 begin
  l_LogName := f_Logger.OpenLog(aView);
  try
   f_Filer := Tl3CustomDOSFiler.Make(l_LogName, l3_fmWrite);
   try
    f_Filer.Open;
    try
     LogShape(aShapes);
    finally
     f_Filer.Close;
    end;//try..finally
   finally
    FreeAndNil(f_Filer);
   end;//try..finally
  finally
   f_Logger.CloseLog(l_LogName);
  end;//try..finally
 end;//f_Logger <> nil
end;//TnevShapesPaintedSpy.LogShapes

procedure TnevShapesPaintedSpy.SetLogger(const aLogger: InevShapesLogger);
begin
 Assert(f_Logger = nil);
 f_Logger := aLogger;
end;//TnevShapesPaintedSpy.SetLogger

procedure TnevShapesPaintedSpy.RemoveLogger(const aLogger: InevShapesLogger);
begin
 Assert(f_Logger = aLogger);
 f_Logger := nil;
end;//TnevShapesPaintedSpy.RemoveLogger

class function TnevShapesPaintedSpy.Exists: Boolean;
begin
 Result := (g_TnevShapesPaintedSpy <> nil);
end;//TnevShapesPaintedSpy.Exists

function TnevShapesPaintedSpy.LogScreen(const aView: InevView): Boolean;
begin
 Result := (f_Logger <> nil) AND f_Logger.LogScreen(aView);
end;//TnevShapesPaintedSpy.LogScreen

procedure TnevShapesPaintedSpy.Cleanup;
begin
 FreeAndNil(f_Filer);
 inherited;
end;//TnevShapesPaintedSpy.Cleanup

procedure TnevShapesPaintedSpy.ClearFields;
 {-}
begin
 f_Logger := nil;
 inherited;
end;//TnevShapesPaintedSpy.ClearFields

end.

The connector TafwPreviewPageSpy looks like this:

unit afwPreviewPageSpy;

// Generated from UML model, root element: SimpleClass::Class Shared Delphi::AFW::Draw::TafwPreviewPageSpy
//
// “Watchdog” of TafwPreviewPage, for {RequestLink:235873282}
//

interface

uses
  afwPreviewPage,
  l3ProtoObject
  ;

type
 IafwPagesLogger = interface(IUnknown)
   ['{19361554-2DE2-4E58-B896-503677BDD13B}']
   procedure LogPage(aPage: TafwPreviewPage;
    aCounter: Boolean);
 end;//IafwPagesLogger

 TafwPreviewPageSpy = class(Tl3ProtoObject)
  {* “Watchdog” of TafwPreviewPage, for [RequestLink:235873282] }
 private
 // private fields
   f_Logger : IafwPagesLogger;
 protected
 // overridden protected methods
   procedure ClearFields; override;
 public
 // public methods
   class function Exists: Boolean;
   procedure SetLogger(const aLogger: IafwPagesLogger);
   procedure RemoveLogger(const aLogger: IafwPagesLogger);
   procedure LogPage(aPage: TafwPreviewPage;
     aCounter: Boolean);
 public
 // singleton factory method
   class function Instance: TafwPreviewPageSpy;
    {- returns a singleton instance. }
 end;//TafwPreviewPageSpy

implementation

uses
  l3Base {a}
  ;

// start class TafwPreviewPageSpy

var g_TafwPreviewPageSpy : TafwPreviewPageSpy = nil;

procedure TafwPreviewPageSpyFree;
begin
 FreeAndNil(g_TafwPreviewPageSpy);
end;

class function TafwPreviewPageSpy.Instance: TafwPreviewPageSpy;
begin
 if (g_TafwPreviewPageSpy = nil) then
 begin
  l3System.AddExitProc(TafwPreviewPageSpyFree);
  g_TafwPreviewPageSpy := Create;
 end;
 Result := g_TafwPreviewPageSpy;
end;

class function TafwPreviewPageSpy.Exists: Boolean;
begin
 Result := (g_TafwPreviewPageSpy <> nil);
end;//TafwPreviewPageSpy.Exists

procedure TafwPreviewPageSpy.SetLogger(const aLogger: IafwPagesLogger);
begin
 Assert(f_Logger = nil);
 f_Logger := aLogger;
end;//TafwPreviewPageSpy.SetLogger

procedure TafwPreviewPageSpy.RemoveLogger(const aLogger: IafwPagesLogger);
begin
 Assert(f_Logger = aLogger);
 f_Logger := nil;
end;//TafwPreviewPageSpy.RemoveLogger

procedure TafwPreviewPageSpy.LogPage(aPage: TafwPreviewPage;
  aCounter: Boolean);
begin
 if (f_Logger <> nil) then
  f_Logger.LogPage(aPage, aCounter);
end;//TafwPreviewPageSpy.LogPage

procedure TafwPreviewPageSpy.ClearFields;
 {-}
begin
 f_Logger := nil;
 inherited;
end;//TafwPreviewPageSpy.ClearFields

end.

Now, about where these connectors are called:

procedure TnevShapesPainted.Clear;
 {* - Clears the list. }
begin
 try
  if (f_Shapes <> nil) then
  begin
   if (f_View <> nil) then
   begin
    if TnevShapesPaintedSpy.Exists then
     if TnevShapesPaintedSpy.Instance.LogScreen(InevView(f_View)) then
      TnevShapesPaintedSpy.Instance.LogShapes(InevView(f_View), f_Shapes);
   end;//f_View <> nil
  end;//f_Shapes <> nil
 finally
  FreeAndNil(f_Current);
  FreeAndNil(f_Shapes);
  inherited;
 end;//try..finally
end;

And:
procedure TafwPreviewPage.Drop(aCounter: Boolean);
var
 l_Stream : IStream;
 l_Index  : Integer;
begin
 if (f_MetaFile <> nil) then
 begin
  if aCounter then
   FreeAndNil(f_MetaFile)
  else
  if (f_DropStream = nil) then
  begin
   if TafwPreviewPageSpy.Exists then
    TafwPreviewPageSpy.Instance.LogPage(Self, aCounter);
   f_DropStream := TevDataCache.CreateTempStream;
   try
    l_Stream := f_DropStream.MakeForWrite;
    try
     MetaFile.SaveToIStream(l_Stream);
    finally
     l_Stream := nil;
    end;//try..finally
    FreeAndNil(f_MetaFile);
   except
    f_DropStream := nil;
    raise;
   end;//try..except
  end//f_DropStream = nil
  else
   FreeAndNil(f_MetaFile);
 end;//f_MetaFile <> nil
 for l_Index := 1 to Pred(WidthCount) do
  WidthPage(l_Index).Drop(aCounter);
end;//TafwPreviewPage.Drop

It is so somehow. I’ve notified – the example is not simple. But the tested code is complex too. I have been debugging print preview and print for two years. It is still not perfect. But now I see – “tomorrow” – what and where has gone wrong.

The resulting (not the abstract) classes look something like this:

unit K182157315;

// Generated from UML model, root element: TestCase::Class Shared Delphi Tests::DailyTest::7.7::K182157315
//
// {RequestLink:182157315}
//

interface

uses
  Classes
  ,
  PreviewTest
  ;
type
 TK182157315 = class(TPreviewTest)
  {* [RequestLink:182157315] }
 end;//TK182157315

implementation

uses
  TestFrameWork
  ;

// start class TK182157315

initialization
 TestFramework.RegisterTest(TK182157315.Suite);

end.

Or like this:

unit K219124975;



// Generated from UML model, root element: TestCase::Class Shared Delphi Tests::DailyTest::7.5::K219124975

//

// {RequestLink:219124975}
//

interface

uses
  Classes
  ,
  PreviewTest
  ,
  evHAFPainterEx
  ;

type
 TK219124975 = class(TPreviewTest)
  {* [RequestLink:219124975] }
 protected
 // overridden protected methods
   function TreatExceptionAsSuccess: Boolean; override;
   function GetNormalFontSize: Integer; override;
     {* Returns the size of the font of “normal” style. 0 – by default }
   procedure ReadColontituls(var theColontituls: TevColontituls); override;
   function GetHAFFontSize: Integer; override;
     {* Size of page headers. 0 - by default }
   function GetFolder: AnsiString; override;
     {* Folder containing the test }
   function GetModelElementGUID: AnsiString; override;
     {* Model element identifier that describes the test }
 end;//TK219124975

implementation

uses
  evTypes,
  l3Base,
  TestFrameWork
  ;

// start class TK219124975

function TK219124975.TreatExceptionAsSuccess: Boolean;
begin
 Result := true;
end;//TK219124975.TreatExceptionAsSuccess

function TK219124975.GetNormalFontSize: Integer;
begin
 Result := 39;
end;//TK219124975.GetNormalFontSize

procedure TK219124975.ReadColontituls(var theColontituls: TevColontituls);
begin
 inherited;
 theColontituls[pcUpRightFirst] := l3CStr('%DocFullName%'#10'%DocRedactionDate%');
 theColontituls[pcUpRight] := theColontituls[pcUpRightFirst];
 theColontituls[pcDownRightFirst] := l3CStr(''{'%DocCurrentPage% / %DocPagesCount%'});
 theColontituls[pcDownRight] := theColontituls[pcDownRightFirst];
end;//TK219124975.ReadColontituls

function TK219124975.GetHAFFontSize: Integer;
begin
 Result := 28;
end;//TK219124975.GetHAFFontSize

initialization
 TestFramework.RegisterTest(TK219124975.Suite);

end.

The name of the file for check is found from the name of the test class (using ClassName and ClassType), and the file with the name is in the test repository.

You would say - "the presence of checkpoints “fouls” the system and it acts not like without them”. And you’d be ABSOLUTELY right. It would be appropriate to recollect Heisenberg’s uncertainty principle. I completely agree with you. Even testers tell me about it, although they are “not supposed” to know the  system’s internal organization. They are ALSO RIGHT. Yes. This approach does not work at 100%, but it is terribly (!) usable. It allows to fulfil many testing tasks. It is not a “silver bullet”. It is only one of the working approaches addressing the special tasks of testing of the SPECIAL code. It is not the “spherical cow”, but – it works.

Better than NOTHING. It’s better to have “boss-eyed” ONE test than have none of a hundred perfect ones.

Try is. May be you will like it.

P.S. The missing classes:

unit TextEditorVisitor;

// The library "TestFormsTest"
// Generated from UML model, root element: TestCase::Class Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextEditorVisitor
//
// Test that works with text of the document using the editor but does not change it
//

interface

uses
  TextEditorVisitorPrim
  ;

type
 TTextEditorVisitor = {abstract} class(TTextEditorVisitorPrim)
  {* Test that works with text of the document using the editor but does not change it
 // protected methods
   function GetNormalFontSize: Integer; virtual;
     {* Returns the size of the font of “normal” style. 0 – by default }
   function MaxHeight: Integer; virtual;
     {* If it does not return 0, the cycle of choosing the height from FormExtent.Y to MaxHeight will be set }
 published
 // published methods
   procedure DoIt;
     {* The body of the test }
 end;//TTextEditorVisitor

implementation

uses
  SysUtils,
  evStyleInterface,
  TestFrameWork
  ;

// start class TTextEditorVisitor

procedure TTextEditorVisitor.DoIt;
var
 l_SI : TevStyleInterface;
 l_Size : Integer;
 l_NewSize : Integer;
 l_MaxHeight : Integer;
begin
 l_SI := TevStyleInterface.Make;
 try
  l_NewSize := GetNormalFontSize;
  l_Size := l_SI.Font.Size;
  try
   if (l_NewSize > 0) then
    l_SI.Font.Size := l_NewSize;
   l_MaxHeight := MaxHeight;
   if (l_MaxHeight > 0) then
   begin
    f_FixedHeight := 0;
    f_FixedHeight := FormExtent.Y;
    if (f_FixedHeight < 0) then
     f_FixedHeight := 300;
    while (f_FixedHeight < l_MaxHeight) do
    begin
     try
      VisitText;
     except
      ToLog('Form height = ' + IntToStr(f_FixedHeight));
      raise;
     end;//try..except
     Inc(f_FixedHeight);
    end;//f_FixedHeight < l_MaxHeight
   end//l_MaxHeight > 0
   else
    VisitText;
  finally
   l_SI.Font.Size := l_Size;
  end;//try..finally
 finally
  FreeAndNil(l_SI);
 end;//try..finally
end;//TTextEditorVisitor.DoIt

function TTextEditorVisitor.GetNormalFontSize: Integer;
begin
 Result := 0;
end;//TTextEditorVisitor.GetNormalFontSize

function TTextEditorVisitor.MaxHeight: Integer;
begin
 Result := 0;
end;//TTextEditorVisitor.MaxHeight

end.
-----------------------------------------

unit TextEditorVisitorPrim;

//
// The library "TestFormsTest"
// Generated from UML model, root element: TestCase::Class Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextEditorVisitorPrim
//
// Test that works with text of the document using the editor but does not change it
//

interface

uses
  TextViaEditorProcessorPrim,
  PrimTextLoad_Form
  ;

type
 TTextEditorVisitorPrim = {abstract} class(TTextViaEditorProcessorPrim)
  {* Test that works with text of the document using the editor but does not change it }
 protected
 // protected methods
   procedure VisitText(const aStr: AnsiString = 'Load');
     {* The procedure of processing the text }
   procedure DoVisit(aForm: TPrimTextLoadForm); virtual; abstract;
     {* Process the text }
   function TreatExceptionAsSuccess: Boolean; virtual;
 end;//TTextEditorVisitorPrim

implementation

uses
  l3Base,
  k2OperationContainer,
  TestFrameWork
  ;

// start class TTextEditorVisitorPrim

procedure TTextEditorVisitorPrim.VisitText(const aStr: AnsiString = 'Load');
var
 l_F : _FormClass_;
 l_Raise : Boolean;
 l_DisableLog : Boolean; 
begin
 l_F := MakeForm;
 try
  l_F.Show;
  l_Raise := TreatExceptionAsSuccess;
  l_DisableLog := l_Raise;
  if l_DisableLog then
   l3System.DisableExceptionToLog;
  try
   Load(l_F, KPage + '.evd', aStr);
   try
    try
     DoVisit(l_F);
    finally
     Check(not Tk2OperationContainer.CheckWasExceptionInFreeInOwner);
    end;//try..finally
   except
    if l_Raise then
     {l_Raise := false}
     Exit
     // - so that not to miss the moment when test succeeds 
    else
     raise;
   end;//try..except
  finally
   if l_DisableLog then
    l3System.EnableExceptionToLog;
  end;//try..finally
  Check(not l_Raise, 'The test is not supposed to succeed, because text does not fit in the paper');
 finally
  l_F.Free;
 end;//try..finally
end;//TTextEditorVisitorPrim.VisitText

function TTextEditorVisitorPrim.TreatExceptionAsSuccess: Boolean;
begin
 Result := false;
end;//TTextEditorVisitorPrim.TreatExceptionAsSuccess

end.
--------------------------------

unit TextViaEditorProcessorPrim;

//
// The library "TestFormsTest"
// Generated from UML model, root element: TestCase::Class Shared Delphi Operations For Tests::TestFormsTest::Everest::TTextViaEditorProcessorPrim
//
// The processor of the text through the editor
//

interface

uses
  nevTools
  ,
  VCMBaseTest
  ,
  PrimTextLoad_Form,
  Types
  ;

type
 _FormClass_ = TPrimTextLoadForm;
 _FormProducer_Parent_ = TVCMBaseTest;
 {$Include FormProducer.imp.pas}
 TTextViaEditorProcessorPrim = {abstract} class(_FormProducer_)
  {* The processor of the text through the editor }
 private
 // private fields
   f_ScrollCount : Integer;
    {* Field for property ScrollCount}
 protected
 // overridden protected methods
   procedure FormMade(const aForm: _FormClass_); override;
   function MakeFormClass: FormClassRef; override;
 protected
 // protected methods
   procedure Load(aForm: TPrimTextLoadForm;
     const aFileName: AnsiString;
     const aStr: AnsiString = 'Load');
     {* Loads the document to the editor of the specified form }
   procedure Save(aForm: TPrimTextLoadForm); virtual;
     {* Saves the text from the editor in a standard output file }
   procedure Scroll(aForm: TPrimTextLoadForm;
     const aSubName: AnsiString);
   procedure ScrollBack(aForm: TPrimTextLoadForm;
     const aSubName: AnsiString);
     {* Scrolls the text in the reverse order }
   procedure ScrollByWeel(aForm: TPrimTextLoadForm;
     aCount: Integer;
     aGoTop: Boolean = True);
     {* Scrolls with the mouse wheel for a specified number of times }
   procedure ScrollByLine(aForm: TPrimTextLoadForm;
     aCount: Integer;
     aUp: Boolean;
     aFromBottom: Boolean);
     {* Scroll line-by-line up and down for a specified number of times }
   procedure GotoDocumentBottom(aForm: TPrimTextLoadForm);
     {* Go to the end of the document }
   procedure PageUp(aForm: TPrimTextLoadForm);
     {* Go one page up }
   procedure PageDown(aForm: TPrimTextLoadForm);
   function ScrollByPage: Boolean; virtual;
   function WebStyle: Boolean; virtual;
   function SendKey: Boolean; virtual;
     {* Managing the editor dialog using key sending instead of calling the editor methods  }
   procedure CheckTopAnchor(const aView: InevInputView); virtual;
     {* check anchor of the beginning of drawing after finishing the scrolling }
   function F1Like: Boolean; virtual;
   function QFLike: Boolean; virtual;
     {* Create editor form to work with КЗ. }
   procedure DoBeforeLoad(aForm: TPrimTextLoadForm); virtual;
     {* Operations before document loading }
   function AllowMultiSelect: Boolean; virtual;
     {* Allow multiselection. }
   function WithBaseSearch: Boolean; virtual;
     {* The form with a base search line. }
 public
 // public properties
   property ScrollCount: Integer
     read f_ScrollCount;
     {* Number of scrollings to the end of the document }
 end;//TTextViaEditorProcessorPrim

implementation

uses
  Document_Const,
  k2OperationContainer,
  evdNativeWriter,
  l3Filer,
  SysUtils,
  evOp,
  l3InternalInterfaces,
  Forms,
  Windows,
  evCustomEditorWindow,
  Messages,
  TextLoad_Form,
  evdSchema,
  F1LikeTextLoad_Form,
  QFLikeTextLoad_Form,
  F1LikeFormWithBS_Form,
  TestFrameWork,
  vcmBase,
  l3Base
  ;

{$Include FormProducer.imp.pas}

// start class TTextViaEditorProcessorPrim

procedure TTextViaEditorProcessorPrim.Load(aForm: TPrimTextLoadForm;
  const aFileName: AnsiString;
  const aStr: AnsiString = 'Load');
begin
 with aForm do
 begin
  DoBeforeLoad(aForm);
  LoadManager.FileName := FileFromCurrent(aFileName);
  StartTimer;
  try
   LoadManager.Load(TextSource, k2_idDocument);
  finally
   StopTimer(aStr);
  end;//try..finally
 end;//with aForm
 Check(not Tk2OperationContainer.CheckWasExceptionInFreeInOwner);
end;//TTextViaEditorProcessorPrim.Load

procedure TTextViaEditorProcessorPrim.Save(aForm: TPrimTextLoadForm);
var
 l_Writer : TevdNativeWriter;
 l_Filer  : Tl3CustomFiler;
begin
 l_Writer := TevdNativeWriter.Create;
 try
  l_Writer.Binary := false;
  l_Filer := FilerForOutput;
  try
   l_Writer.Filer := l_Filer;
  finally
   FreeAndNil(l_Filer);
  end;//try..finally
  aForm.TextSource.Save(l_Writer);
 finally
  FreeAndNil(l_Writer);
 end;//try..finally
end;//TTextViaEditorProcessorPrim.Save

procedure TTextViaEditorProcessorPrim.Scroll(aForm: TPrimTextLoadForm;
  const aSubName: AnsiString);
var
 l_Now : Cardinal;
begin
 with aForm do
 begin
  if (Text.View <> nil) then
  begin
   Il3CommandTarget(Text).ProcessCommand(ev_ocTopLeft, true, 1);
   l_Now := StartTimer;
   try
    try
     f_ScrollCount := 0;
     while not Text.View.IsDocumentTailVisible do
     begin
      if ScrollByPage then
      begin
       if SendKey then
       begin
        PostMessage(Text.Handle, $100, $22, $1510001); //Hold down PgDown
        Inc(f_ScrollCount);
       end
       else
       if Il3CommandTarget(Text).ProcessCommand(ev_ocPageDown, true, 1) then
        Inc(f_ScrollCount)
       else
        break;
      end//ScrollByPage
      else
       Text.Perform(WM_VScroll, SB_WheelDown, 0);
      Application.ProcessMessages;
      CheckTimeout(l_Now, 20 * 60 * 1000);
      if ShouldStop then Break;
     end;//while not Text.View.IsDocumentTailVisible
    finally
     if ScrollByPage then
      if SendKey then
       PostMessage(Text.Handle, $101, $22, $1510001); //Pressing up PgDown
    end;//try..finally
    Application.ProcessMessages;
   finally
    StopTimer('Scroll', aSubName);
   end;//try..finally
  end;//Text.View <> nil
 end;//with aForm
end;//TTextViaEditorProcessorPrim.Scroll

procedure TTextViaEditorProcessorPrim.ScrollBack(aForm: TPrimTextLoadForm;
  const aSubName: AnsiString);
var
 l_Now : Cardinal;
begin
 with aForm do
 begin
  if (Text.View <> nil) then
  begin
   GotoDocumentBottom(aForm);
   l_Now := StartTimer;
   try
    while not Text.View.TopAnchor.AtStart{.IsDocumentTailVisible} do
    begin
//     PostMessage(Text.Handle, $100, $22, $1510001); //Pressing down PgDown
     if ScrollByPage then
     begin
      if not Il3CommandTarget(Text).ProcessCommand(ev_ocPageUp, true, 1) then
       break;
     end//ScrollByPage
     else
      Text.Perform(WM_VScroll, SB_WheelUp, 0);
     Application.ProcessMessages;
     CheckTimeout(l_Now, 20 * 60 * 1000);
     if ShouldStop then Break;
    end;//while not Text.View.IsDocumentTailVisible
//    PostMessage(Text.Handle, $101, $22, $1510001); //Pressing up PgDown
    Application.ProcessMessages;
   finally
    StopTimer('ScrollBack', aSubName);
   end;//try..finally
  end;//Text.View <> nil
 end;//with aForm
end;//TTextViaEditorProcessorPrim.ScrollBack

procedure TTextViaEditorProcessorPrim.ScrollByWeel(aForm: TPrimTextLoadForm;
  aCount: Integer;
  aGoTop: Boolean = True);
var
 i: Integer;
begin
 with aForm do
 begin
  if aGoTop then
   Il3CommandTarget(Text).ProcessCommand(ev_ocTopLeft, true, 1);
  for i := 0 to aCount - 1 do
  begin
   Text.Perform(WM_VScroll, SB_WheelDown, 0);
   Application.ProcessMessages;
   if ShouldStop then Break;
  end;
 end; // with aForm do
end;//TTextViaEditorProcessorPrim.ScrollByWeel

procedure TTextViaEditorProcessorPrim.ScrollByLine(aForm: TPrimTextLoadForm;
  aCount: Integer;
  aUp: Boolean;
  aFromBottom: Boolean);
var
 i: Integer;
begin
 with aForm do
 begin
  if aFromBottom and aUp then
   GotoDocumentBottom(aForm);
  if aCount > 0 then
   if aUp then
    for i := 0 to aCount - 1 do
    begin
     aForm.Text.View.Scroller[True].LineUp(1);
     Application.ProcessMessages;
     if ShouldStop then Break;
    end // for i := 0 to aCount - 1 do
   else
    for i := 0 to aCount - 1 do
    begin
     aForm.Text.View.Scroller[True].LineDown(1);
     Application.ProcessMessages;
     if ShouldStop then Break;
    end // for i := 0 to aCount - 1 do
  else
   if aCount < 0 then
    if aUp then
     while not Text.View.TopAnchor.AtStart do
     begin
      aForm.Text.View.Scroller[True].LineUp(1);
      Application.ProcessMessages;
      CheckTopAnchor(aForm.Text.View);
      if ShouldStop then Break;
     end
    else
     while not Text.View.IsDocumentTailVisible do
     begin
      aForm.Text.View.Scroller[True].LineDown(1);
      Application.ProcessMessages;
      CheckTopAnchor(aForm.Text.View);
      if ShouldStop then Break;
     end;
 end; // with aForm do
end;//TTextViaEditorProcessorPrim.ScrollByLine

procedure TTextViaEditorProcessorPrim.GotoDocumentBottom(aForm: TPrimTextLoadForm);
begin
 if QFLike then
 // - otherwise the editor КЗ processes it in his own way
  aForm.Text.View.Caret.Bottom
 else
  Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocBottomRight, true, 1);
end;//TTextViaEditorProcessorPrim.GotoDocumentBottom

procedure TTextViaEditorProcessorPrim.PageUp(aForm: TPrimTextLoadForm);
begin
 Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocPageUp, true, 1);
end;//TTextViaEditorProcessorPrim.PageUp

procedure TTextViaEditorProcessorPrim.PageDown(aForm: TPrimTextLoadForm);
begin
 Il3CommandTarget(aForm.Text).ProcessCommand(ev_ocPageDown, true, 1);
end;//TTextViaEditorProcessorPrim.PageDown

function TTextViaEditorProcessorPrim.ScrollByPage: Boolean;
begin
 Result := true;
end;//TTextViaEditorProcessorPrim.ScrollByPage

function TTextViaEditorProcessorPrim.WebStyle: Boolean;
begin
 Result := true;
end;//TTextViaEditorProcessorPrim.WebStyle

function TTextViaEditorProcessorPrim.SendKey: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.SendKey

procedure TTextViaEditorProcessorPrim.CheckTopAnchor(const aView: InevInputView);
begin
end;//TTextViaEditorProcessorPrim.CheckTopAnchor

function TTextViaEditorProcessorPrim.F1Like: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.F1Like

function TTextViaEditorProcessorPrim.QFLike: Boolean;
begin
 Result := false;
end;//TTextViaEditorProcessorPrim.QFLike

procedure TTextViaEditorProcessorPrim.DoBeforeLoad(aForm: TPrimTextLoadForm);
begin
end;//TTextViaEditorProcessorPrim.DoBeforeLoad

function TTextViaEditorProcessorPrim.AllowMultiSelect: Boolean;
begin
 Result := True;
end;//TTextViaEditorProcessorPrim.AllowMultiSelect

function TTextViaEditorProcessorPrim.WithBaseSearch: Boolean;
begin
 Result := False;
end;//TTextViaEditorProcessorPrim.WithBaseSearch

procedure TTextViaEditorProcessorPrim.FormMade(const aForm: _FormClass_);
begin
 inherited;
 aForm.Text.WebStyle := WebStyle;
 aForm.Text.AllowMultiSelect := AllowMultiSelect;
end;//TTextViaEditorProcessorPrim.FormMade

function TTextViaEditorProcessorPrim.MakeFormClass: FormClassRef;
begin
 if WithBaseSearch then
  Result := TF1LikeFormWithBSForm
 else
 if QFLike then
  Result := TQFLikeTextLoadForm
 else
 if F1Like then
  Result := TF1LikeTextLoadForm
 else
  Result := TTextLoadForm;
end;//TTextViaEditorProcessorPrim.MakeFormClass

end.


Комментариев нет:

Отправить комментарий