среда, 29 октября 2014 г.

Коротко. Про DUnit и Delphi XE7

Офигенскую тут штуку "нашёл".

Открываем файл с классом:

unit msLine;

interface

uses
 msShape,
 FMX.Graphics,
 System.Types
 ;

type
 TmsLine = class(TmsShape)
 private
  FFinishPoint: TPointF;
 protected
  procedure DoDrawTo(const aCtx: TmsDrawContext); override;
  constructor CreateInner(const aStartPoint: TPointF); override;
  property FinishPoint : TPointF Read FFinishPoint write FFinishPoint;
 public
  function IsNeedsSecondClick : Boolean; override;
  procedure EndTo(const aCtx: TmsEndShapeContext); override;
  procedure MoveTo(const aFinishPoint: TPointF); override;
 end;

implementation

uses
 SysUtils,
 msPointCircle
 ;

constructor TmsLine.CreateInner(const aStartPoint: TPointF);
begin
 inherited;
 FinishPoint := aStartPoint;
end;

procedure TmsLine.EndTo(const aCtx: TmsEndShapeContext);
begin
 FinishPoint := aCtx.rStartPoint;
end;

procedure TmsLine.MoveTo(const aFinishPoint: TPointF);
begin
 Assert(false, 'Примитив ' + ClassName + ' не может быть перемещён');
end;

procedure TmsLine.DoDrawTo(const aCtx: TmsDrawContext);
var
 l_Proxy : TmsShape;
begin
 if (StartPoint = FinishPoint) then
 begin
  l_Proxy := TmsPointCircle.CreateInner(StartPoint);
  try
   l_Proxy.DrawTo(aCtx);
  finally
   FreeAndNil(l_Proxy);
  end;//try..finally
 end//StartPoint = FinishPoint
 else
  aCtx.rCanvas.DrawLine(StartPoint,
                   FinishPoint, 1);
end;

function TmsLine.IsNeedsSecondClick: Boolean;
begin
 Result := true;
end;

end.

Нажимаем Alt-F-N-O.

(File-New-Other)

Получаем:



Выбираем - Test Case.

Получаем:


Нажимаем "Next":

Получаем:

Нажимаем "Finish":

Получаем:

unit TestMsLine;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit 
  being tested.

}

interface

uses
  TestFramework, msLine, FMX.Graphics, System.Types, msShape;

type
  // Test methods for class TmsLine

  TestTmsLine = class(TTestCase)
  strict private
    FmsLine: TmsLine;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestIsNeedsSecondClick;
    procedure TestEndTo;
    procedure TestMoveTo;
  end;

implementation

procedure TestTmsLine.SetUp;
begin
  FmsLine := TmsLine.Create;
end;

procedure TestTmsLine.TearDown;
begin
  FmsLine.Free;
  FmsLine := nil;
end;

procedure TestTmsLine.TestIsNeedsSecondClick;
var
  ReturnValue: Boolean;
begin
  ReturnValue := FmsLine.IsNeedsSecondClick;
  // TODO: Validate method results
end;

procedure TestTmsLine.TestEndTo;
var
  aCtx: msShape.TmsMakeShapeContext;
begin
  // TODO: Setup method call parameters
  FmsLine.EndTo(aCtx);
  // TODO: Validate method results
end;

procedure TestTmsLine.TestMoveTo;
var
  aFinishPoint: TPointF;
begin
  // TODO: Setup method call parameters
  FmsLine.MoveTo(aFinishPoint);
  // TODO: Validate method results
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TestTmsLine.Suite);
end.

Вуаля!

Мы получили "каркас тестов" нашего класса.

Скажем так...Для меня ЛИЧНО - Embarcadero - "открыли Америку". От них - не ожидал.

Приятно :-) Хотя и "требует доработки".

Смежная тема - Коротко. Добавляем "банальные" тесты к нашему приложению

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

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