| unit Protokol_Test;
interface
uses
SysUtils, math,
TestFramework, TypeViewsBuilder, SDETask3, SDETask.Run, Blank.Constant, Blank.Operation;
type
TTestProtokol = class(TTestCase)
private
B: TViewsBuilder;
procedure Setup10;
protected
procedure SetUp; override;
procedure TearDown; override;
function Task: TSDETaskRun;
function Protokol: TSDETask;
function MergedProtokol: TSDETask;
function PrintAStatus (const A: array of TScheduleStatus): string;
function PrintAсts (const A: array of integer): string;
function PrintTask (ATask: TSDETask): string;
procedure CheckMaxRate (Rate: integer);
procedure CheckRate (Rate: integer);
procedure CheckProtokol (Acts: array of integer; Schedule: array of TScheduleStatus; MaxRate, Rate: integer);
public
procedure AddCommand (ATask: TSDETask; Acts: array of integer); overload;
function AddCommand (ATaskNode: TTaskNode; Act: integer): TSDEOperation3; overload;
function AddAltNode (AlterOrder: TAlterOrder): TAltTaskNode;
procedure RenderTask (ATask: TSDETask);
procedure CheckCommand (ATask: TSDETask; Acts: array of integer);
procedure CheckSchedule (ATask: TSDETask; Acts: array of TScheduleStatus);
procedure CheckInvertCount (ATask: TSDETask; N: integer; Up: boolean; Cnt: integer);
published
procedure Test_Normal;
procedure Test_Miss_1;
procedure Test_Miss_3;
procedure Test_Miss_4;
procedure Test_Unecessary_1;
procedure Test_Unecessary_2;
procedure Test_Replace;
procedure Test_Repeat;
procedure Test_Other;
procedure Test_Groups;
procedure Test_Early_1;
procedure Test_Early_2;
procedure Test_Early_4;
procedure Test_Early_5;
procedure Test_Alt_Any_1;
procedure Test_Alt_All_1;
procedure Test_Alt_Strict_1;
procedure Test_Alt_Order_1;
procedure Test_Alt_Alternate_1;
procedure Test_Alt_Alternate_2;
end;
const
N = ssNormal;
M = ssMiss;
U = ssUnecessary;
E = ssEarly;
L = ssLate;
SScheduleStatus : array [TScheduleStatus] of string = ('N', 'M', 'U', 'E', 'L','M');
implementation
uses
Common,
SWApplication, IFaceForms, Views0, Constan, FloatType, PageList, Blanks_Form, Views0.Constant;
{ TTestProtokol }
procedure TTestProtokol.SetUp;
begin
inherited;
Setup10;
end;
procedure TTestProtokol.TearDown;
begin
inherited;
end;
function TTestProtokol.Task: TSDETaskRun;
begin
//Result := frmBlanksForm.frmBlankEditor.Task as TSDETaskRun;
Result := Tasks.CurrentTask;
end;
function TTestProtokol.Protokol: TSDETask;
begin
//Result := (frmBlanksForm.frmBlankEditor.Task as TSDETaskRun).Protokol;
Result := Tasks.CurrentTask.CheckProtokol;
end;
function TTestProtokol.MergedProtokol: TSDETask;
begin
//Result := (frmBlanksForm.frmBlankEditor.Task as TSDETaskRun).MergedProtokol;
Result := Tasks.CurrentTask.CheckMergedProtokol;
end;
procedure TTestProtokol.Test_Normal;
begin
{совпадает протокол и бланк}
AddCommand(Task, [1, 2, 3, 4, 5]);
CheckCommand (Task, [1,2,3,4,5]);
AddCommand(Protokol, [1, 2, 3, 4, 5]);
CheckCommand (Protokol, [1,2,3,4,5]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5]);
CheckSchedule (MergedProtokol, [N, N, N, N, N]);
CheckRate (11111);
CheckMaxRate (11111);
end;
procedure TTestProtokol.Test_Miss_1;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
AddCommand(Protokol, [2, 3, 4, 5]);
Task.LinkProtokol;
Task.MergeProtokol.Render;
//frmBlanksForm.frmProtokol.RenderBlank(MergedProtokol);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5]);
CheckSchedule(MergedProtokol, [M, N, N, N, N]);
CheckMaxRate (11111);
CheckRate (11110);
end;
procedure TTestProtokol.Test_Miss_3;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
{пропущенные действия}
AddCommand(Protokol, [1, 2, 4, 5]);
Task.LinkProtokol;
Task.MergeProtokol.Render;
//frmBlanksForm.frmProtokol.RenderBlank(MergedProtokol);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5]);
CheckSchedule (MergedProtokol, [N, N, M, N, N]);
CheckMaxRate (11111);
CheckRate (11011);
end;
procedure TTestProtokol.Test_Miss_4;
begin
AddCommand(Task, [1, 2, 3, 4, 5, 1]);
{пропущенные действия}
AddCommand(Protokol, [1, 2, 3, 4, 5]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 3, 4, 5]);
CheckSchedule (Protokol, [N, N, N, N, N, M]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 1]);
CheckSchedule (MergedProtokol, [N, N, N, N, N, M]);
CheckMaxRate (11112);
CheckRate (011111);
end;
procedure TTestProtokol.Test_Unecessary_1;
begin
AddCommand(Task, [1, 2, 3, 4, 5, 1]);
{лишние действия}
AddCommand(Protokol, [1, 2, 3, 4, 5, 6]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 3, 4, 5, 6]);
CheckSchedule (Protokol, [N, N, N, N, N, U]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 6]);
CheckSchedule (MergedProtokol, [N, N, N, N, N, U]);
CheckMaxRate (11112);
CheckRate (011111);
end;
procedure TTestProtokol.Test_Unecessary_2;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
{лишние действия}
AddCommand(Protokol, [1, 2, 3, 4, 5, 1]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 3, 4, 5, 1]);
CheckSchedule (Protokol, [N, N, N, N, N, U]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 1]);
CheckSchedule (MergedProtokol, [N, N, N, N, N, U]);
CheckMaxRate (11111);
CheckRate (11111);
end;
procedure TTestProtokol.Test_Replace;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
{лишние действия}
AddCommand(Protokol, [1, 2, 6, 4, 5]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 6, 4, 5]);
CheckSchedule (Protokol, [N, N, U, N, N]);
CheckCommand(MergedProtokol, [1, 2, 3, 6, 4, 5]);
CheckSchedule (MergedProtokol, [N, N, M, U, N, N]);
CheckMaxRate (11111);
CheckRate (11011);
end;
procedure TTestProtokol.Test_Repeat;
begin
AddCommand(Task, [1, 1, 1, 1, 1]);
{лишние действия}
AddCommand(Protokol, [1]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1]);
CheckSchedule (Protokol, [N]);
CheckCommand(MergedProtokol, [1, 1, 1, 1, 1]);
CheckSchedule (MergedProtokol, [N, M, M, M, M]);
CheckMaxRate (5);
CheckRate (1);
end;
procedure TTestProtokol.Test_Other;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
{лишние действия}
AddCommand(Protokol, [6]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [6]);
CheckSchedule (Protokol, [U]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 6]);
CheckSchedule (MergedProtokol, [M, M, M, M, M, U]);
CheckMaxRate (11111);
CheckRate (0);
end;
procedure TTestProtokol.Test_Groups;
begin
AddCommand(Task, [1, 2, 3, 4, 5, 3]);
{лишние действия}
AddCommand(Protokol, [1, 2, 4, 5, 3]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 4, 5, 3]);
CheckSchedule (Protokol, [N, N, N, N, N]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 3]);
CheckSchedule (MergedProtokol, [N, N, M, N, N, N]);
AddCommand(Protokol, [1, 2, 3, 4, 5, 3]);
Task.LinkProtokol;
Task.MergeProtokol;
CheckCommand(Protokol, [1, 2, 3, 4, 5]);
CheckSchedule (Protokol, [N, N, N, N, N]);
CheckCommand(MergedProtokol, [1, 2, 3, 4, 5, 3]);
CheckSchedule (MergedProtokol, [N, N, N, N, N, M]);
end;
procedure TTestProtokol.Test_Early_1;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
AddCommand(Protokol, [3, 1, 2, 4, 5]);
Task.LinkProtokol;
CheckInvertCount(Protokol, 0, false, 2);
CheckInvertCount(Protokol, 1, true, 1);
Task.CalcSchedule;
CheckSchedule(Protokol, [E, N, N, N, N]);
CheckMaxRate (11111);
CheckRate (11011);
end;
procedure TTestProtokol.Test_Early_2;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
AddCommand(Protokol, [1, 3, 2, 4, 5]);
Task.CalcSchedule;
CheckSchedule(Protokol, [N, E, N, N, N]);
CheckMaxRate (11111);
CheckRate (11011);
end;
procedure TTestProtokol.Test_Early_4;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
AddCommand(Protokol, [1, 2, 4, 3, 5]);
Task.CalcSchedule;
CheckSchedule (Protokol, [N, N, E, N, N]);
Protokol.Render;
//frmBlanksForm.frmProtokol.RenderBlank(Protokol);
CheckMaxRate (11111);
CheckRate (10111);
end;
procedure TTestProtokol.Test_Early_5;
begin
AddCommand(Task, [1, 2, 3, 4, 5]);
AddCommand(Protokol, [1, 2, 4, 5, 3]);
Task.CalcSchedule;
CheckSchedule (Protokol, [N, N, N, N, L]);
//frmBlanksForm.frmProtokol.RenderBlank(Protokol);
Protokol.Render;
CheckMaxRate (11111);
CheckRate (11011);
end;
function TTestProtokol.AddAltNode (AlterOrder: TAlterOrder): TAltTaskNode;
var
AN: TAltTaskNode;
Op1, Op2: TSDEOperation3;
begin
Task.Clear;
AN := Task.Operations.AddNodeN ('AltNode', TAltTaskNode) as TAltTaskNode;
AN.AlterOrder := AlterOrder;
Op1 := AddCommand (AN, 1);
Op1.Rate := 1;
Op1 := AddCommand (AN, 2);
Op1.Rate := 10;
Result := AN;
Task.Operations.Renumerate;
end;
procedure TTestProtokol.Test_Alt_Any_1;
begin
AddAltNode (aoAny);
CheckProtokol ([1, 2], [N, N], 11, 11);
CheckProtokol ([2, 1], [E, N], 11, 11);
CheckProtokol ([1], [N], 11, 1);
CheckProtokol ([2], [N], 11, 10);
end;
procedure TTestProtokol.Test_Alt_All_1;
begin
AddAltNode (aoAll);
CheckProtokol ([1, 2], [N, N], 11, 11);
CheckProtokol ([2, 1], [E, N], 11, 11);
CheckProtokol ([1], [N], 11, 0);
CheckProtokol ([2], [N], 11, 0);
end;
procedure TTestProtokol.Test_Alt_Strict_1;
begin
AddAltNode (aoStrict);
CheckProtokol ([1, 2], [N, N], 11, 11);
CheckProtokol ([2, 1], [E, N], 11, 0);
CheckProtokol ([1], [N], 11, 0);
CheckProtokol ([2], [N], 11, 0);
end;
procedure TTestProtokol.Test_Alt_Order_1;
begin
AddAltNode (aoOrder_);
CheckProtokol ([1, 2], [N, N], 11, 11);
CheckProtokol ([2, 1], [E, N], 11, 1); //??? или не засчитывать ничего ?
CheckProtokol ([1], [N], 11, 1);
CheckProtokol ([2], [N], 11, 10);
end;
procedure TTestProtokol.Test_Alt_Alternate_1;
begin
AddAltNode (aoAlternate);
CheckProtokol ([1, 2], [N, N], 10, 10);
CheckProtokol ([2, 1], [E, N], 10, 10); //??? [N, N] ?
CheckProtokol ([1], [N], 10, 1);
CheckProtokol ([2], [N], 10, 10);
end;
procedure TTestProtokol.Test_Alt_Alternate_2;
var
AN: TAltTaskNode;
Op1, Op2: TSDEOperation3;
begin
(*
AddAltNode (aoAlternate);
Op1 := AddCommand (Task.Operations, 3);
Op1.Rate := 100;
Task.Operations.Renumerate;
CheckProtokol ([1, 2], [N, N], 10, 10);
CheckProtokol ([2, 1], [E, N], 10, 10); //??? [N, N] ?
CheckProtokol ([1], [N], 10, 1);
CheckProtokol ([2], [N], 10, 10);
AN := Task.Operations.AddNodeN ('AltNode', TAltTaskNode) as TAltTaskNode;
AN.AlterOrder := AlterOrder;
Op1 := AddCommand (AN, 1);
Op1.Rate := 1;
Op1 := AddCommand (AN, 2);
Op1.Rate := 10;
Result := AN;
Task.Operations.Renumerate;
*)
end;
procedure TTestProtokol.Setup10;
var
i: Integer;
sdef: ISDEF;
V: TVectorView;
B: TViewsBuilder;
P: TPageList;
begin
sdef := App.SDEF(App.MainDoc);
sdef.Clear;
P := sdef.GetSchemeSet.ListWN[0];
sdef.GetSchemeBox.Data := P;
B := TViewsBuilder.Create(P, sdef.GetSchemeBox);
for i := 0 to 10 do
begin
V := B.AddView(tcWikl, FloatPoint(i * 5 + 10, 10), 0);
with V.CreateSubscript do
begin
SubscriptName := IntToStr(V.Tag);
SubscriptPosition := pBottom;
end;
//SubscriptColor.RGBColor := VViolet;
end;
B.Free;
end;
function TTestProtokol.AddCommand (ATaskNode: TTaskNode; Act: integer): TSDEOperation3;
var
i: integer;
V: TVectorView;
sdef: ISdef;
P: TPageList;
Op: TSDEOperation3;
begin
sdef := App.SDEF (App.MainDoc);
P := sdef.GetSchemeSet.ListWN [0];
V := P.FindView (tcWikl, Act) as TVectorView;
Result := ATaskNode.AddOperationN ('Действие ' + IntToStr(Act), V.TechMain, 'положение', 'отключен');
RenderTask (ATaskNode.Task);
end;
procedure TTestProtokol.RenderTask (ATask: TSDETask);
begin
ATask.Render;
{if ATask = Task then
frmBlanksForm.frmBlankEditor.RenderBlank (ATask)
else if (ATask = Protokol) then
frmBlanksForm.frmProtokol.RenderBlank (ATask);}
end;
procedure TTestProtokol.AddCommand(ATask: TSDETask; Acts: array of integer);
var
i: integer;
V: TVectorView;
sdef: ISdef;
P: TPageList;
Op: TSDEOperation3;
begin
sdef := App.SDEF (App.MainDoc);
P := sdef.GetSchemeSet.ListWN [0];
ATask.Clear;
for i := low (Acts) to high (Acts) do begin
V := P.FindView (tcWikl, Acts[i]) as TVectorView;
Op := ATask.Operations.AddOperationN
('Действие ' + IntToStr(Acts[i]), V.TechMain, 'положение', 'отключен');
if ATask = Task then
Op.Rate := round(IntPower(10, Acts[i]-1));
end;
ATask.Operations.Renumerate;
RenderTask (ATask);
end;
procedure TTestProtokol.CheckCommand (ATask: TSDETask; Acts: array of integer);
var
i: integer;
V: TVectorView;
sdef: ISdef;
P: TPageList;
S: string;
begin
sdef := App.SDEF (App.MainDoc);
P := sdef.GetSchemeSet.ListWN [0];
S := PrintTask (ATask) + PRet + PrintAсts (Acts);
for i := 0 to ATask.Operations.Count-1 do begin
V := (ATask.Operations.Nodes [i] as TSDEOperation3).Element;
CheckEquals (V.Tag, Acts [i], S);
end;
end;
procedure TTestProtokol.CheckMaxRate (Rate: integer);
begin
CheckEquals (Task.CalcMaxRate, Rate);
end;
procedure TTestProtokol.CheckRate (Rate: integer);
begin
CheckEquals (Task.CalcRate, Rate);
end;
procedure TTestProtokol.CheckProtokol (Acts: array of integer; Schedule: array of TScheduleStatus; MaxRate, Rate: integer);
begin
Protokol.Clear;
AddCommand(Protokol, Acts);
Task.LinkProtokol;
Task.CalcSchedule;
CheckSchedule (Protokol, Schedule);
Protokol.Render;
//frmBlanksForm.frmProtokol.RenderBlank(Protokol);
CheckMaxRate (MaxRate);
CheckRate (Rate);
end;
function TTestProtokol.PrintAStatus (const A: array of TScheduleStatus): string;
var
i: integer;
begin
Result := '';
for i := 0 to High (A) do
Result := Result + SScheduleStatus [A[i]] + ' ';
end;
function TTestProtokol.PrintAсts (const A: array of integer): string;
var
i: integer;
begin
Result := '';
for i := 0 to High (A) do
Result := Result + IntToStr (A[i]) + ' ';
end;
function TTestProtokol.PrintTask (ATask: TSDETask): string;
var
i: integer;
Op: TSDEOperation3;
begin
Result := '';
for i := 0 to ATask.Operations.Count-1 do begin
Op := ATask.Operations.Nodes [i] as TSDEOperation3;
Result := Result + Op.IIDS + ' ';
end;
end;
procedure TTestProtokol.CheckSchedule (ATask: TSDETask; Acts: array of TScheduleStatus);
var
i: integer;
Op: TSDEOperation3;
OpActs: array of TScheduleStatus;
begin
SetLength (OpActs, ATask.Operations.Count);
for i := 0 to ATask.Operations.Count-1 do begin
Op := ATask.Operations.Nodes [i] as TSDEOperation3;
OpActs [i] := Op.Schedule;
end;
for i := 0 to ATask.Operations.Count-1 do begin
Op := ATask.Operations.Nodes [i] as TSDEOperation3;
Check (Op.Schedule = Acts [i],
PrintTask (ATask) + PRet +
PrintAStatus (Acts) + PRet +
PrintAStatus (OpActs));
end;
end;
procedure TTestProtokol.CheckInvertCount (ATask: TSDETask; N: integer; Up: boolean; Cnt: integer);
var
Op: TSDEOperation3;
С: integer;
S: string;
begin
S := PrintTask (ATask);
Op := ATask.Operations.Nodes [N] as TSDEOperation3;
if Up then
С := Task.CalcInversionsUp (Op)
else
С := Task.CalcInversionsDown (Op);
CheckEquals (С, Cnt);
end;
initialization
TestFramework.RegisterTest('TestProtokol Suite', TTestProtokol.Suite);
end.
|