Офигенскую тут штуку "нашёл".
Открываем файл с классом:
Нажимаем Alt-F-N-O.
(File-New-Other)
Получаем:
Выбираем - Test Case.
Получаем:
Нажимаем "Next":
Получаем:
Нажимаем "Finish":
Получаем:
Вуаля!
Мы получили "каркас тестов" нашего класса.
Скажем так...Для меня ЛИЧНО - Embarcadero - "открыли Америку". От них - не ожидал.
Приятно :-) Хотя и "требует доработки".
Смежная тема - Коротко. Добавляем "банальные" тесты к нашему приложению
Открываем файл с классом:
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 - "открыли Америку". От них - не ожидал.
Приятно :-) Хотя и "требует доработки".
Смежная тема - Коротко. Добавляем "банальные" тесты к нашему приложению



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