Офигенскую тут штуку "нашёл".
Открываем файл с классом:
Нажимаем 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 - "открыли Америку". От них - не ожидал.
Приятно :-) Хотя и "требует доработки".
Смежная тема - Коротко. Добавляем "банальные" тесты к нашему приложению
Комментариев нет:
Отправить комментарий