mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
test(cat): стенд разбора команд — свойства всего набора, а не список
Команд в CATEngine больше трёхсот, и проверять их поимённо бессмысленно: список отстанет от кода в первую же неделю. Поэтому стенд ходит по кодам перебором AA..ZZ (незнакомый движок отсеет сам, ответив «?;») и проверяет свойства, которые обязаны выполняться на всём наборе сразу. Круговой прогон: то, что команда отдала на опрос, она обязана принять обратно. Это ловит расхождение ширин GET и SET — клиент, который читает значение и пишет его назад, обычная идиома логгеров. Read-only статусы (IF, ID, ZZIF, ZZID) исключены списком: их ответ — составной снимок, обратно его не пишут ни Kenwood, ни Thetis. Мусор в поле: разбор не имеет права упасть ни на одном аргументе (сборка с -Criot: диапазоны, переполнения, приведения типов) и обязан отвечать либо ничем, либо «?;»/«E;», либо ОДНИМ корректным кадром — лишняя ';' внутри ответа для клиента означает две команды вместо одной, и дальше он читает мусор. Отдельным прогоном на чистом радио: нечисловое поле не имеет права ничего перестроить. Числовые формы в этот прогон не входят намеренно — «ZZFA00000000000;» синтаксически законна, и решать её судьбу должен контроллер, а не разбор. Радио подставное (TFakeRadio): ни движка, ни железа, но геттеры и сеттеры настоящие, поэтому видно не «команда ответила», а ЧТО она изменила. Плюс точечные регрессии на дефекты, которые уже случались: заглушка, молча правившая радио (ZZVB копировал VFO A в VFO B прямо на опросе), ошибочные алиасы, нечисловое поле как индекс 0, ширины полей. ★-B в обоих стендах (и в TCI тоже). Не «для чистоты»: fpc сверяет .ppu с исходником по времени с точностью до секунды, и правка, попавшая в ту же секунду, что и прошлая сборка, молча не подхватывается — стенд выносит вердикт о СТАРОМ коде. Это хуже, чем не запускаться вовсе, и ловится обычно на негативном контроле, когда исходник меняют туда-обратно (на нём и поймалось). Полная пересборка графа стенда занимает около секунды. Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Claude Opus 5
@@ -0,0 +1,49 @@
|
||||
# Стенд CAT
|
||||
|
||||
Прогон:
|
||||
|
||||
```sh
|
||||
test/cat/run.sh
|
||||
```
|
||||
|
||||
Собирает `cattest.pas` и запускает его; код возврата ненулевой, если хоть одна
|
||||
проверка провалена. Внешних библиотек не требует и железа не касается: команды
|
||||
ходят по подставному радио (`TFakeRadio`), у которого есть настоящие геттеры и
|
||||
сеттеры, поэтому видно не только «команда ответила», но и **что именно она
|
||||
изменила**.
|
||||
|
||||
## Зачем он такой
|
||||
|
||||
Команд в `CATEngine.pas` больше трёхсот, и проверять их по одной бессмысленно —
|
||||
список всё равно отстанет от кода. Поэтому стенд проверяет **свойства всего
|
||||
набора сразу**, а по командам ходит перебором `AA`..`ZZ`: незнакомый код движок
|
||||
отсеет сам («`?;`»), значит новая команда попадает под проверку без правки
|
||||
стенда.
|
||||
|
||||
* **A. Круговой прогон.** То, что команда отдала на опрос, она обязана принять
|
||||
обратно. Так ловится классическое расхождение ширин: `ZZGT;` отвечал
|
||||
`ZZGT000;`, а на установку принимал ровно один символ — клиент, который читает
|
||||
значение и пишет его назад (обычная идиома логгеров), получал `?;`.
|
||||
Read-only статусы (`IF`, `ID`, `ZZIF`, `ZZID`) из прогона исключены списком.
|
||||
|
||||
* **B. Мусор в поле.** Разбор не имеет права упасть ни на одном аргументе
|
||||
(сборка идёт с `-Criot` — проверки диапазонов, ввода-вывода, переполнения и
|
||||
приведения типов включены) и обязан отвечать либо ничем, либо `?;`/`E;`, либо
|
||||
**одним** корректным кадром: лишняя `;` внутри ответа для клиента означает две
|
||||
команды вместо одной, и дальше он читает мусор. Отдельным прогоном на чистом
|
||||
радио проверяется, что **нечисловое** поле ничего не перестроило: этот класс
|
||||
дефектов («`StrToIntDef(s, 0)`» → индекс 0) уводил станцию на нулевой
|
||||
диапазон, нулевой фильтр и нулевую громкость. Числовые формы в этот прогон не
|
||||
входят: `ZZFA00000000000;` — синтаксически законная команда, и решать её
|
||||
судьбу должен контроллер, а не разбор.
|
||||
|
||||
* **C. Точечные регрессии** на дефекты, которые уже случались: заглушка, молча
|
||||
правившая радио (`ZZVB` копировал VFO A в VFO B прямо на опросе), ошибочные
|
||||
алиасы, ширины полей, кенвудовские двойники уже исправленных `ZZ`-команд
|
||||
(`FW`/`SH`/`SL`/`AG`/`SQ`/`GT` — про них однажды забыли).
|
||||
|
||||
## Грабли сборки
|
||||
|
||||
Те же, что и у стенда TCI (см. `test/tci/README.md`): `-Mobjfpc` обязателен, а
|
||||
каталог `.ppu` — свой и по абсолютному пути, иначе компилятор подхватит units
|
||||
GUI-сборки из корня проекта.
|
||||
@@ -0,0 +1,510 @@
|
||||
program cattest;
|
||||
|
||||
{
|
||||
Стенд CAT: разбор команд (CATEngine). Запуск: test/cat/run.sh
|
||||
|
||||
Проверяет не отдельные команды по списку, а СВОЙСТВА, которые обязаны
|
||||
выполняться на всём наборе сразу — их и ломают чаще всего:
|
||||
|
||||
A. Круговой прогон: то, что команда отдала на опрос, она обязана принять
|
||||
обратно. Классический дефект — GET отвечает трёхзначным полем, а SET
|
||||
ждёт одного символа: клиент, который читает значение и пишет его назад
|
||||
(обычная идиома логгеров), получает «?;». Ходим по ВСЕМ парам букв, а не
|
||||
по списку: незнакомая команда отвечает «?;» и отсеивается сама, значит
|
||||
новая команда попадает под проверку без правки стенда.
|
||||
|
||||
B. Мусор в поле: ни одна команда ни на каком аргументе не имеет права
|
||||
уронить разбор исключением (собираем с -Criot: проверки диапазонов,
|
||||
переполнения и приведения типов включены) и обязана отвечать либо
|
||||
ничем, либо «?;»/«E;», либо ОДНИМ корректным кадром — лишняя ';' внутри
|
||||
ответа рассинхронизирует поток команд у клиента.
|
||||
|
||||
C. Точечные регрессии на дефекты, которые уже случались: ошибочные алиасы
|
||||
(команда-заглушка молча правила радио), нечисловое поле как индекс 0,
|
||||
ширины полей.
|
||||
|
||||
Контекст радио — подставной (TFakeRadio): стенду не нужны ни движок, ни
|
||||
железо, а команды при этом ходят по настоящим сеттерам и геттерам, и видно,
|
||||
ЧТО именно команда изменила.
|
||||
}
|
||||
|
||||
{$MODE Delphi}
|
||||
{$LONGSTRINGS ON}
|
||||
|
||||
uses
|
||||
SysUtils, CATEngine, RadioModes;
|
||||
|
||||
var
|
||||
Passed, Failed: Integer;
|
||||
|
||||
procedure Check(const Name: string; OK: Boolean; const Detail: string = '');
|
||||
begin
|
||||
if OK then
|
||||
begin
|
||||
Inc(Passed);
|
||||
WriteLn(' ok ', Name);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(Failed);
|
||||
WriteLn(' FAIL ', Name, ' ', Detail);
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
{ Подставное радио: хранит значения, которые команды читают и пишут.
|
||||
Ровно столько полей, сколько нужно, чтобы команды отвечали осмысленно и
|
||||
круговой прогон не спотыкался о «геттера нет — отдаём ноль». }
|
||||
TFakeRadio = class
|
||||
public
|
||||
VfoA, VfoB: Double;
|
||||
Mode: Integer;
|
||||
ActiveVfo: Integer;
|
||||
AGCMode: Integer;
|
||||
Volume: Integer;
|
||||
Drive: Integer;
|
||||
FilterIdx: Integer;
|
||||
FilterBW: Integer;
|
||||
FilterLow: Integer;
|
||||
FilterHigh: Integer;
|
||||
Band: Integer;
|
||||
TXProfile: Integer;
|
||||
EQBands: Integer;
|
||||
EQGains: TCATEQGains;
|
||||
Squelch: Integer;
|
||||
CWSpeed: Integer;
|
||||
constructor Create;
|
||||
function DoGetVfoA: Double;
|
||||
function DoGetVfoB: Double;
|
||||
procedure DoSetVfoA(V: Double);
|
||||
procedure DoSetVfoB(V: Double);
|
||||
function DoGetMode: Integer;
|
||||
procedure DoSetMode(V: Integer);
|
||||
function DoGetActiveVfo: Integer;
|
||||
procedure DoSetActiveVfo(V: Integer);
|
||||
function DoGetAGCMode: Integer;
|
||||
procedure DoSetAGCMode(V: Integer);
|
||||
function DoGetVolume: Integer;
|
||||
procedure DoSetVolume(V: Integer);
|
||||
function DoGetDrive: Integer;
|
||||
procedure DoSetDrive(V: Integer);
|
||||
function DoGetFilterIdx: Integer;
|
||||
procedure DoSetFilterIdx(V: Integer);
|
||||
function DoGetFilterBW: Integer;
|
||||
function DoGetFilterLow: Integer;
|
||||
procedure DoSetFilterLow(V: Integer);
|
||||
function DoGetFilterHigh: Integer;
|
||||
procedure DoSetFilterHigh(V: Integer);
|
||||
function DoGetBand: Integer;
|
||||
procedure DoSetBand(V: Integer);
|
||||
function DoGetTXProfile: Integer;
|
||||
procedure DoSetTXProfile(V: Integer);
|
||||
function DoGetTXProfileCount: Integer;
|
||||
function DoGetTXEQ(out Gains: TCATEQGains): Integer;
|
||||
procedure DoSetTXEQ(NumBands: Integer; const Gains: TCATEQGains);
|
||||
function DoGetSquelchLevel: Integer;
|
||||
procedure DoSetSquelchLevel(V: Integer);
|
||||
function DoGetCWSpeed: Integer;
|
||||
procedure DoSetCWSpeed(V: Integer);
|
||||
procedure Fill(var Ctx: TCATContext);
|
||||
end;
|
||||
|
||||
constructor TFakeRadio.Create;
|
||||
var i: Integer;
|
||||
begin
|
||||
inherited Create;
|
||||
VfoA := 14250000;
|
||||
VfoB := 7100000;
|
||||
Mode := MODE_USB;
|
||||
ActiveVfo := 0;
|
||||
AGCMode := 2;
|
||||
Volume := 40;
|
||||
Drive := 30;
|
||||
FilterIdx := 1;
|
||||
FilterBW := 2700;
|
||||
FilterLow := 200;
|
||||
FilterHigh := 2900;
|
||||
Band := 3;
|
||||
TXProfile := 1;
|
||||
EQBands := 10;
|
||||
for i := 0 to High(EQGains) do EQGains[i] := 0;
|
||||
Squelch := 20;
|
||||
CWSpeed := 24;
|
||||
end;
|
||||
|
||||
function TFakeRadio.DoGetVfoA: Double; begin Result := VfoA; end;
|
||||
function TFakeRadio.DoGetVfoB: Double; begin Result := VfoB; end;
|
||||
procedure TFakeRadio.DoSetVfoA(V: Double); begin VfoA := V; end;
|
||||
procedure TFakeRadio.DoSetVfoB(V: Double); begin VfoB := V; end;
|
||||
function TFakeRadio.DoGetMode: Integer; begin Result := Mode; end;
|
||||
procedure TFakeRadio.DoSetMode(V: Integer); begin Mode := V; end;
|
||||
function TFakeRadio.DoGetActiveVfo: Integer; begin Result := ActiveVfo; end;
|
||||
procedure TFakeRadio.DoSetActiveVfo(V: Integer); begin ActiveVfo := V; end;
|
||||
function TFakeRadio.DoGetAGCMode: Integer; begin Result := AGCMode; end;
|
||||
procedure TFakeRadio.DoSetAGCMode(V: Integer); begin AGCMode := V; end;
|
||||
function TFakeRadio.DoGetVolume: Integer; begin Result := Volume; end;
|
||||
procedure TFakeRadio.DoSetVolume(V: Integer); begin Volume := V; end;
|
||||
function TFakeRadio.DoGetDrive: Integer; begin Result := Drive; end;
|
||||
procedure TFakeRadio.DoSetDrive(V: Integer); begin Drive := V; end;
|
||||
function TFakeRadio.DoGetFilterIdx: Integer; begin Result := FilterIdx; end;
|
||||
procedure TFakeRadio.DoSetFilterIdx(V: Integer); begin FilterIdx := V; end;
|
||||
function TFakeRadio.DoGetFilterBW: Integer; begin Result := FilterBW; end;
|
||||
function TFakeRadio.DoGetFilterLow: Integer; begin Result := FilterLow; end;
|
||||
procedure TFakeRadio.DoSetFilterLow(V: Integer); begin FilterLow := V; end;
|
||||
function TFakeRadio.DoGetFilterHigh: Integer; begin Result := FilterHigh; end;
|
||||
procedure TFakeRadio.DoSetFilterHigh(V: Integer); begin FilterHigh := V; end;
|
||||
function TFakeRadio.DoGetBand: Integer; begin Result := Band; end;
|
||||
procedure TFakeRadio.DoSetBand(V: Integer); begin Band := V; end;
|
||||
function TFakeRadio.DoGetTXProfile: Integer; begin Result := TXProfile; end;
|
||||
procedure TFakeRadio.DoSetTXProfile(V: Integer); begin TXProfile := V; end;
|
||||
function TFakeRadio.DoGetTXProfileCount: Integer; begin Result := 4; end;
|
||||
function TFakeRadio.DoGetSquelchLevel: Integer; begin Result := Squelch; end;
|
||||
procedure TFakeRadio.DoSetSquelchLevel(V: Integer); begin Squelch := V; end;
|
||||
function TFakeRadio.DoGetCWSpeed: Integer; begin Result := CWSpeed; end;
|
||||
procedure TFakeRadio.DoSetCWSpeed(V: Integer); begin CWSpeed := V; end;
|
||||
|
||||
function TFakeRadio.DoGetTXEQ(out Gains: TCATEQGains): Integer;
|
||||
begin
|
||||
Gains := EQGains;
|
||||
Result := EQBands;
|
||||
end;
|
||||
|
||||
procedure TFakeRadio.DoSetTXEQ(NumBands: Integer; const Gains: TCATEQGains);
|
||||
begin
|
||||
EQBands := NumBands;
|
||||
EQGains := Gains;
|
||||
end;
|
||||
|
||||
procedure TFakeRadio.Fill(var Ctx: TCATContext);
|
||||
begin
|
||||
FillChar(Ctx, SizeOf(Ctx), 0);
|
||||
Ctx.GetVfoA := DoGetVfoA;
|
||||
Ctx.GetVfoB := DoGetVfoB;
|
||||
Ctx.SetVfoA := DoSetVfoA;
|
||||
Ctx.SetVfoB := DoSetVfoB;
|
||||
Ctx.GetMode := DoGetMode;
|
||||
Ctx.SetMode := DoSetMode;
|
||||
Ctx.GetActiveVfo := DoGetActiveVfo;
|
||||
Ctx.SetActiveVfo := DoSetActiveVfo;
|
||||
Ctx.GetAGCMode := DoGetAGCMode;
|
||||
Ctx.SetAGCMode := DoSetAGCMode;
|
||||
Ctx.GetVolume := DoGetVolume;
|
||||
Ctx.SetVolume := DoSetVolume;
|
||||
Ctx.GetDriveLevel := DoGetDrive;
|
||||
Ctx.SetDriveLevel := DoSetDrive;
|
||||
Ctx.GetFilterIdx := DoGetFilterIdx;
|
||||
Ctx.SetFilterIdx := DoSetFilterIdx;
|
||||
Ctx.GetFilterBW := DoGetFilterBW;
|
||||
Ctx.GetFilterLow := DoGetFilterLow;
|
||||
Ctx.SetFilterLow := DoSetFilterLow;
|
||||
Ctx.GetFilterHigh := DoGetFilterHigh;
|
||||
Ctx.SetFilterHigh := DoSetFilterHigh;
|
||||
Ctx.GetCurrentBand := DoGetBand;
|
||||
Ctx.DoBandByIndex := DoSetBand;
|
||||
Ctx.GetTXProfile := DoGetTXProfile;
|
||||
Ctx.SetTXProfile := DoSetTXProfile;
|
||||
Ctx.GetTXProfileCount := DoGetTXProfileCount;
|
||||
Ctx.GetTXEQ := DoGetTXEQ;
|
||||
Ctx.SetTXEQ := DoSetTXEQ;
|
||||
Ctx.GetSquelchLevel := DoGetSquelchLevel;
|
||||
Ctx.SetSquelchLevel := DoSetSquelchLevel;
|
||||
Ctx.GetCWSpeed := DoGetCWSpeed;
|
||||
Ctx.SetCWSpeed := DoSetCWSpeed;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
Общие помощники
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
const
|
||||
{ Команды только для чтения: ответ на опрос — составной статус, обратно его
|
||||
не пишут ни Kenwood, ни Thetis. Круговой прогон их законно не проходит. }
|
||||
READ_ONLY: array[0..3] of string = ('IF', 'ID', 'ZZIF', 'ZZID');
|
||||
|
||||
function IsReadOnly(const Cmd: string): Boolean;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i := 0 to High(READ_ONLY) do
|
||||
if READ_ONLY[i] = Cmd then Exit(True);
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
{ Ответ похож на кадр «<команда><значение>;» — из него можно взять значение. }
|
||||
function AnswerValue(const Cmd, Ans: string; out V: string): Boolean;
|
||||
begin
|
||||
V := '';
|
||||
Result := (Length(Ans) > Length(Cmd) + 1) and
|
||||
(UpperCase(Copy(Ans, 1, Length(Cmd))) = Cmd) and
|
||||
(Ans[Length(Ans)] = ';');
|
||||
if Result then V := Copy(Ans, Length(Cmd) + 1, Length(Ans) - Length(Cmd) - 1);
|
||||
end;
|
||||
|
||||
{ Кадр корректен: одна ';' и та в конце. Лишняя точка с запятой внутри ответа
|
||||
для клиента означает две команды вместо одной — дальше он читает мусор. }
|
||||
function WellFormed(const Ans: string): Boolean;
|
||||
var i: Integer;
|
||||
begin
|
||||
if Ans = '' then Exit(True);
|
||||
if Ans[Length(Ans)] <> ';' then Exit(False);
|
||||
for i := 1 to Length(Ans) - 1 do
|
||||
if Ans[i] = ';' then Exit(False);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ Все двухбуквенные коды: 'AA'..'ZZ'. Незнакомые отсеет сам движок («?;»). }
|
||||
function CodeAt(Idx: Integer): string;
|
||||
begin
|
||||
Result := Chr(Ord('A') + Idx div 26) + Chr(Ord('A') + Idx mod 26);
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
A. Круговой прогон: команда обязана принять собственный ответ
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TestRoundTrip;
|
||||
var
|
||||
R: TFakeRadio;
|
||||
Ctx: TCATContext;
|
||||
E: TCATEngine;
|
||||
i, nZZ, nKW: Integer;
|
||||
Ans, V, Back, Bad: string;
|
||||
|
||||
procedure Try_(const C: string);
|
||||
begin
|
||||
if IsReadOnly(C) then Exit;
|
||||
Ans := E.Parse(C + ';');
|
||||
if (Ans = '') or (Ans = '?;') or (Ans = 'E;') then Exit;
|
||||
if not AnswerValue(C, Ans, V) then
|
||||
begin
|
||||
Bad := Bad + ' ' + C + '(чужой префикс: ' + Ans + ')';
|
||||
Exit;
|
||||
end;
|
||||
if Copy(C, 1, 2) = 'ZZ' then Inc(nZZ) else Inc(nKW);
|
||||
Back := E.Parse(C + V + ';');
|
||||
if Back = '?;' then
|
||||
Bad := Bad + ' ' + C + '(' + Ans + ' → ?;)';
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('A. Круговой прогон: ответ команды принимается ею обратно');
|
||||
R := TFakeRadio.Create;
|
||||
R.Fill(Ctx);
|
||||
E := TCATEngine.Create(Ctx);
|
||||
try
|
||||
Bad := '';
|
||||
nZZ := 0; nKW := 0;
|
||||
for i := 0 to 26 * 26 - 1 do
|
||||
begin
|
||||
Try_('ZZ' + CodeAt(i));
|
||||
Try_(CodeAt(i));
|
||||
end;
|
||||
Check('круговой прогон пройден всеми командами', Bad = '', Bad);
|
||||
// Страховка от «проверка ничего не проверила»: команд, отвечающих на
|
||||
// опрос, должно быть много. Если их вдруг единицы — сломан не набор
|
||||
// команд, а сам прогон.
|
||||
Check('опрос отвечает у сотни с лишним ZZ-команд', nZZ > 100, IntToStr(nZZ));
|
||||
Check('опрос отвечает у кенвудовских команд', nKW > 15, IntToStr(nKW));
|
||||
finally
|
||||
E.Free;
|
||||
R.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
B. Мусор в поле: без исключений и без битых кадров
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TestJunk;
|
||||
const
|
||||
{ Аргументы, которые команда обязана пережить: и заведомый мусор, и
|
||||
правдоподобные числа (иначе проверка не дошла бы до самих значений). }
|
||||
JUNK: array[0..17] of string = (
|
||||
'', '0', '1', 'x', 'abc', '-1', '+', '-', '99999999999999999999',
|
||||
' ', '0.5', '1e40', '-99999999999', '+0000000000', '00', '000',
|
||||
'0000', '00000');
|
||||
{ Заведомо НЕ значения: ни одна команда не имеет права принять их за число и
|
||||
что-нибудь перестроить. Именно этот класс уводил станцию на нулевой
|
||||
диапазон («ZZBSxx;» → индекс 0) и на нулевой фильтр. Числовые формы сюда
|
||||
не входят: «ZZFA00000000000;» — синтаксически законная команда, и решать
|
||||
её судьбу должен контроллер, а не разбор. }
|
||||
BAD: array[0..9] of string = ('x', 'xx', 'abc', 'xxxx', 'xxxxx', '+', '-',
|
||||
' ', '+xxx', '-xx');
|
||||
var
|
||||
R: TFakeRadio;
|
||||
Ctx: TCATContext;
|
||||
E: TCATEngine;
|
||||
i, j, nExc, nBadFrame, nTried: Integer;
|
||||
Ans, First: string;
|
||||
|
||||
procedure Try_(const C, Arg: string);
|
||||
begin
|
||||
Inc(nTried);
|
||||
try
|
||||
Ans := E.Parse(C + Arg + ';');
|
||||
if not WellFormed(Ans) then
|
||||
begin
|
||||
Inc(nBadFrame);
|
||||
if First = '' then First := C + Arg + '; → ' + Ans;
|
||||
end;
|
||||
except
|
||||
on Ex: Exception do
|
||||
begin
|
||||
Inc(nExc);
|
||||
if First = '' then
|
||||
First := C + Arg + '; → ' + Ex.ClassName + ': ' + Ex.Message;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('B. Мусор в поле');
|
||||
R := TFakeRadio.Create;
|
||||
R.Fill(Ctx);
|
||||
E := TCATEngine.Create(Ctx);
|
||||
try
|
||||
nExc := 0; nBadFrame := 0; nTried := 0; First := '';
|
||||
for i := 0 to 26 * 26 - 1 do
|
||||
for j := 0 to High(JUNK) do
|
||||
begin
|
||||
Try_('ZZ' + CodeAt(i), JUNK[j]);
|
||||
Try_(CodeAt(i), JUNK[j]);
|
||||
end;
|
||||
Check('разбор не падает ни на одном аргументе', nExc = 0,
|
||||
IntToStr(nExc) + ' шт., первое: ' + First);
|
||||
Check('ответ всегда один корректный кадр', nBadFrame = 0,
|
||||
IntToStr(nBadFrame) + ' шт., первое: ' + First);
|
||||
Check('прогнан весь набор команд', nTried > 20000, IntToStr(nTried));
|
||||
finally
|
||||
E.Free;
|
||||
R.Free;
|
||||
end;
|
||||
|
||||
// Нечисловой мусор — отдельным прогоном на чистом радио: тут проверяется не
|
||||
// живучесть разбора, а то, что состояние осталось нетронутым.
|
||||
R := TFakeRadio.Create;
|
||||
R.Fill(Ctx);
|
||||
E := TCATEngine.Create(Ctx);
|
||||
try
|
||||
for i := 0 to 26 * 26 - 1 do
|
||||
for j := 0 to High(BAD) do
|
||||
begin
|
||||
E.Parse('ZZ' + CodeAt(i) + BAD[j] + ';');
|
||||
E.Parse(CodeAt(i) + BAD[j] + ';');
|
||||
end;
|
||||
Check('нечисловое поле не сдвинуло VFO A', R.VfoA = 14250000, FloatToStr(R.VfoA));
|
||||
Check('нечисловое поле не сдвинуло VFO B', R.VfoB = 7100000, FloatToStr(R.VfoB));
|
||||
Check('нечисловое поле не переключило диапазон', R.Band = 3, IntToStr(R.Band));
|
||||
Check('нечисловое поле не сменило фильтр', R.FilterIdx = 1, IntToStr(R.FilterIdx));
|
||||
Check('нечисловое поле не сменило режим', R.Mode = MODE_USB, IntToStr(R.Mode));
|
||||
Check('нечисловое поле не тронуло кромки фильтра',
|
||||
(R.FilterLow = 200) and (R.FilterHigh = 2900),
|
||||
Format('%d/%d', [R.FilterLow, R.FilterHigh]));
|
||||
Check('нечисловое поле не сменило режим АРУ', R.AGCMode = 2, IntToStr(R.AGCMode));
|
||||
Check('нечисловое поле не тронуло громкость', R.Volume = 40, IntToStr(R.Volume));
|
||||
Check('нечисловое поле не тронуло мощность', R.Drive = 30, IntToStr(R.Drive));
|
||||
Check('нечисловое поле не тронуло шумоподавитель', R.Squelch = 20,
|
||||
IntToStr(R.Squelch));
|
||||
Check('нечисловое поле не тронуло скорость телеграфа', R.CWSpeed = 24,
|
||||
IntToStr(R.CWSpeed));
|
||||
Check('нечисловое поле не сменило TX-профиль', R.TXProfile = 1,
|
||||
IntToStr(R.TXProfile));
|
||||
Check('нечисловое поле не тронуло эквалайзер', R.EQBands = 10,
|
||||
IntToStr(R.EQBands));
|
||||
finally
|
||||
E.Free;
|
||||
R.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ═══════════════════════════════════════════════════════════════════════════
|
||||
C. Точечные регрессии
|
||||
═══════════════════════════════════════════════════════════════════════════ }
|
||||
|
||||
procedure TestRegressions;
|
||||
var
|
||||
R: TFakeRadio;
|
||||
Ctx: TCATContext;
|
||||
E: TCATEngine;
|
||||
begin
|
||||
WriteLn('C. Точечные регрессии');
|
||||
R := TFakeRadio.Create;
|
||||
R.Fill(Ctx);
|
||||
E := TCATEngine.Create(Ctx);
|
||||
try
|
||||
// ★Заглушка не имеет права трогать радио. ZZVB — «усиление приёма в VAC»,
|
||||
// и опрос по ней когда-то копировал VFO A в VFO B, то есть терял сплит.
|
||||
E.Parse('ZZVB;');
|
||||
Check('ZZVB не трогает VFO B', R.VfoB = 7100000, FloatToStr(R.VfoB));
|
||||
// Тот же класс: команды, ошибочно заалиашенные на настоящие функции.
|
||||
E.Parse('ZZVA;');
|
||||
E.Parse('ZZVA1;');
|
||||
Check('ZZVA не меняет VFO местами',
|
||||
(R.VfoA = 14250000) and (R.VfoB = 7100000));
|
||||
E.Parse('ZZAA0500;');
|
||||
Check('ZZAA не трогает громкость', R.Volume = 40, IntToStr(R.Volume));
|
||||
E.Parse('ZZQM01;');
|
||||
Check('ZZQM не трогает режим', R.Mode = MODE_USB, IntToStr(R.Mode));
|
||||
|
||||
// Ширины полей: ответ на опрос обязан приниматься обратно (ZZGT отвечал
|
||||
// тремя цифрами, а принимал только одну).
|
||||
Check('ZZGT принимает трёхзначную форму', E.Parse('ZZGT003;') <> '?;');
|
||||
Check('ZZGT принимает однозначную форму', E.Parse('ZZGT1;') <> '?;');
|
||||
Check('ZZGT: значение дошло', R.AGCMode = 1, IntToStr(R.AGCMode));
|
||||
Check('ZZGT отвергает нечисловое поле', E.Parse('ZZGTxxx;') = '?;');
|
||||
|
||||
// Нечисловое поле — ошибка формата, а не индекс 0.
|
||||
Check('ZZBS отвергает нечисловое поле', E.Parse('ZZBSxx;') = '?;');
|
||||
Check('ZZBS: диапазон не переключился', R.Band = 3, IntToStr(R.Band));
|
||||
Check('ZZFI отвергает нечисловое поле', E.Parse('ZZFIxx;') = '?;');
|
||||
// ★Кенвудовские двойники тех же величин — их правку однажды забыли, а
|
||||
// фильтр у них общий с ZZFI.
|
||||
Check('FW отвергает нечисловое поле', E.Parse('FWxxxx;') = '?;');
|
||||
Check('SH отвергает нечисловое поле', E.Parse('SHxx;') = '?;');
|
||||
Check('SL отвергает нечисловое поле', E.Parse('SLxx;') = '?;');
|
||||
Check('фильтр после них прежний', R.FilterIdx = 1, IntToStr(R.FilterIdx));
|
||||
Check('AG отвергает нечисловое поле', E.Parse('AG0xxx;') = '?;');
|
||||
Check('громкость после него прежняя', R.Volume = 40, IntToStr(R.Volume));
|
||||
Check('SQ отвергает нечисловое поле', E.Parse('SQ0xxx;') = '?;');
|
||||
Check('порог после него прежний', R.Squelch = 20, IntToStr(R.Squelch));
|
||||
Check('GT отвергает нечисловое поле', E.Parse('GTxxx;') = '?;');
|
||||
// И принимают законное значение (проверка не должна ловить всё подряд).
|
||||
Check('FW принимает индекс', E.Parse('FW0003;') = '');
|
||||
Check('FW: индекс дошёл', R.FilterIdx = 3, IntToStr(R.FilterIdx));
|
||||
Check('AG принимает уровень', E.Parse('AG0128;') = '');
|
||||
Check('AG: уровень дошёл', R.Volume = 50, IntToStr(R.Volume));
|
||||
|
||||
// TX-эквалайзер: сетка бывает только 3- или 10-полосной, и выдача обязана
|
||||
// совпадать с тем, что принимает разбор.
|
||||
Check('ZZEB отвергает ноль полос',
|
||||
E.Parse('ZZEB' + StringOfChar('0', 36) + ';') = '?;');
|
||||
Check('ZZEB принимает три полосы',
|
||||
E.Parse('ZZEB003' + StringOfChar('0', 33) + ';') <> '?;');
|
||||
Check('ZZEB: число полос дошло', R.EQBands = 3, IntToStr(R.EQBands));
|
||||
R.EQBands := 7; // испорченный профиль
|
||||
Check('ZZEB отдаёт только законную сетку',
|
||||
Copy(E.Parse('ZZEB;'), 5, 3) = '010', E.Parse('ZZEB;'));
|
||||
|
||||
// Заглушка отвечает на ОПРОС, а не на установку (ZZBE отвечал наоборот).
|
||||
Check('ZZBE не отвечает данными на установку', E.Parse('ZZBE01;') = '');
|
||||
Check('ZZBE не отвечает данными на опрос', E.Parse('ZZBE;') = '');
|
||||
|
||||
// Разбор кадра: лишний суффикс у команды без параметров не должен
|
||||
// доходить до исполнения (TXfoo; когда-то поднимал передачу).
|
||||
Check('TX с мусорным суффиксом — ошибка', E.Parse('TXfoo;') = '?;');
|
||||
finally
|
||||
E.Free;
|
||||
R.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Passed := 0;
|
||||
Failed := 0;
|
||||
WriteLn('=== Стенд CAT: разбор команд ===');
|
||||
TestRoundTrip;
|
||||
TestJunk;
|
||||
TestRegressions;
|
||||
WriteLn;
|
||||
WriteLn(Format('Итого: %d проверок, провалено %d', [Passed + Failed, Failed]));
|
||||
if Failed > 0 then Halt(1);
|
||||
end.
|
||||
Executable
+31
@@ -0,0 +1,31 @@
|
||||
#!/bin/sh
|
||||
# Стенд CAT: сборка и прогон. Запускать откуда угодно — скрипт сам перейдёт
|
||||
# в свой каталог. Возвращает ненулевой код, если хоть одна проверка провалена.
|
||||
#
|
||||
# Флаги:
|
||||
# -Mobjfpc — командный режим по умолчанию (юниты сами ставят свой {$mode});
|
||||
# с -Mdelphi выключаются вложенные комментарии, и шапки юнитов
|
||||
# закрывают комментарий раньше времени.
|
||||
# -Criot — проверки диапазонов, ввода-вывода, переполнения и приведения
|
||||
# типов. Часть B стенда ищет именно их: разбор мусора из сети
|
||||
# обязан не падать даже со всеми проверками.
|
||||
# ★Каталог .ppu — свой и по абсолютному пути (см. test/tci/run.sh): иначе
|
||||
# компилятор находит units GUI-сборки в корне проекта.
|
||||
set -e
|
||||
cd "$(dirname "$0")"
|
||||
HERE=$(pwd)
|
||||
CPU=$(fpc -iTP)
|
||||
OS=$(fpc -iTO)
|
||||
OUTUNITS="$HERE/units/${CPU}-${OS}"
|
||||
OUT="$HERE/bin/${CPU}-${OS}"
|
||||
mkdir -p "$OUTUNITS" "$OUT"
|
||||
# ★-B (пересобрать всё) обязателен, а не «для чистоты»: fpc сверяет .ppu с
|
||||
# исходником по времени с точностью до секунды, и правка, попавшая в ту же
|
||||
# секунду, что и прошлая сборка, молча не подхватывается. Стенд тогда выносит
|
||||
# ВЕРДИКТ О СТАРОМ КОДЕ — хуже, чем не запускаться вовсе (ловится это обычно на
|
||||
# негативном контроле, когда исходник меняют туда-обратно). Полная пересборка
|
||||
# графа стенда занимает около секунды.
|
||||
fpc -B -Mobjfpc -Criot -O1 \
|
||||
-Fu../.. -FU"$OUTUNITS" \
|
||||
-o"$OUT/cattest" cattest.pas
|
||||
exec "$OUT/cattest" "$@"
|
||||
+7
-1
@@ -23,7 +23,13 @@ OS=$(fpc -iTO)
|
||||
OUTUNITS="$HERE/units/${CPU}-${OS}"
|
||||
OUT="$HERE/bin/${CPU}-${OS}"
|
||||
mkdir -p "$OUTUNITS" "$OUT"
|
||||
fpc -Mobjfpc -O2 -dHEADLESS \
|
||||
# ★-B (пересобрать всё) обязателен, а не «для чистоты»: fpc сверяет .ppu с
|
||||
# исходником по времени с точностью до секунды, и правка, попавшая в ту же
|
||||
# секунду, что и прошлая сборка, молча не подхватывается. Стенд тогда выносит
|
||||
# ВЕРДИКТ О СТАРОМ КОДЕ — хуже, чем не запускаться вовсе (ловится это обычно на
|
||||
# негативном контроле, когда исходник меняют туда-обратно). Полная пересборка
|
||||
# графа стенда занимает около секунды.
|
||||
fpc -B -Mobjfpc -O2 -dHEADLESS \
|
||||
-Fu../.. -FU"$OUTUNITS" -k-L/usr/local/lib \
|
||||
-o"$OUT/tcitest" tcitest.pas
|
||||
exec "$OUT/tcitest" "$@"
|
||||
|
||||
Reference in New Issue
Block a user