{ Copyright (C) 2026 - Uladzimir Karpenka, EW8BAK This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. } 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, ни CAT. Круговой прогон их законно не проходит. } 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.