diff --git a/test/cat/README.md b/test/cat/README.md new file mode 100644 index 0000000..08d9591 --- /dev/null +++ b/test/cat/README.md @@ -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-сборки из корня проекта. diff --git a/test/cat/cattest.pas b/test/cat/cattest.pas new file mode 100644 index 0000000..a1b9024 --- /dev/null +++ b/test/cat/cattest.pas @@ -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. diff --git a/test/cat/run.sh b/test/cat/run.sh new file mode 100755 index 0000000..d8213be --- /dev/null +++ b/test/cat/run.sh @@ -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" "$@" diff --git a/test/tci/run.sh b/test/tci/run.sh index 1e4981e..51f27b6 100755 --- a/test/tci/run.sh +++ b/test/tci/run.sh @@ -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" "$@"