mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
feat(serial): своя обёртка последовательного порта — macOS собирается
RTL-модуль Serial собирается только для [android, linux, netbsd, openbsd,
win32, win64] — Darwin в списке нет (rtl-extra/fpmake.pp). Из-за этого под
macOS CAT по последовательному порту стоял заглушкой, а CWKeyer не собирался
вовсе.
★Скопировать чужой исходник было нельзя. Serial.SerSetParams кладёт B-константу
скорости прямо в c_cflag — идиома Linux, где это битовая маска. На BSD и macOS
B115200 это просто ЧИСЛО 115200, и в c_cflag прилетает $1C200: CLOCAL | HUPCL |
CCTS_OFLOW плюс мусор в поле CSIZE. Молча включается аппаратный CTS-flow, и
передача встаёт, если железка не держит CTS, — а ошибки никакой, порт
«открылся».
Новый SerialPort.pas:
* Unix — termios напрямую, Linux и macOS ОДНИМ путём (разница спрятана в
константах RTL; Darwin даёт и termio, и все TIOCM_*). Скорость только через
CFSetISpeed/CFSetOSpeed, c_cflag собирается с нуля чистой SerCFlags;
CRTSCTS — исключительно по явной просьбе; сырой режим и VMIN/VTIME явные;
open с O_NONBLOCK и снятием флага сразу после (часть USB-драйверов, как и
tty-устройство на маке, висит в open до DCD).
* Windows — тонкая переадресация в RTL Serial: там он есть и в termios не лезет.
* Неуспех SerOpen на ВСЕХ платформах даёт SER_INVALID_HANDLE (RTL возвращал 0
под Windows и −1 под Unix, из-за чего вызывающие держали свои развилки).
Проверка — SerValid.
Точки вызова: CATSerial и CWKeyer переведены на обёртку, заглушка
CAT_SERIAL_STUB и платформенные {$IFDEF} вокруг хендлов убраны. Имена портов по
умолчанию и подсказка в настройках теперь платформенные (SerDefaultPortName /
SerPortNameHint): на маке порт зовётся /dev/cu.usbserial-XXXX, и '/dev/ttyS0'
там — заведомо неверная подсказка; осмысленного умолчания не существует,
поэтому пусто.
Новый стенд test/serial (36 проверок) — на псевдотерминале: открытие, termios
обратным чтением, ★«CRTSCTS сам не включился», ★«в c_cflag нет ничего, кроме
наших флагов», формат через чистую SerCFlags (обратным чтением его не
проверить: pty восьмибитно-чистый и молча меняет CS7 на CS8), обмен, срок
таймаута, CR не превращается в CR+LF, эха нет, и сквозной прогон CAT через
обёртку. Негативный контроль: с `or Cardinal(BitsPerSec)` в SerSetParams (та
самая идиома, что ломает RTL на BSD) проверка c_cflag падает — «1CAB0 против
8B0».
test/platform расширен: теперь сим-компилирует и SerialPort, для его
Windows-ветки добавлена заглушка модуля Serial с теми же сигнатурами.
Модемные линии (DTR/RTS/CTS/DSR/CD/RI) на pty не проверяются — ioctl TIOCM*
там не работает; это остаётся на живой порт.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV
This commit is contained in:
Claude Opus 5
@@ -0,0 +1,329 @@
|
||||
program serialtest;
|
||||
|
||||
{
|
||||
Стенд обёртки последовательного порта (SerialPort.pas) на псевдотерминале.
|
||||
|
||||
Зачем именно pty. Настоящего COM-порта на сборочной машине нет, а проверить
|
||||
надо ровно то, на чём обжигается перенос: как обёртка НАСТРАИВАЕТ порт.
|
||||
Псевдотерминал — тот же tty с той же дисциплиной линии, поэтому termios
|
||||
проверяется всерьёз: скорость, размер символа, чётность, стоп-биты и — самое
|
||||
важное — что аппаратный поток CRTSCTS НЕ включился сам собой. Именно этим
|
||||
грешит `Serial` из RTL на BSD/macOS: там B-константы это числа, а он кладёт
|
||||
их в c_cflag, и в поле прилетает CCTS_OFLOW (см. шапку SerialPort.pas).
|
||||
|
||||
Чего pty НЕ проверяет: модемные линии DTR/RTS/CTS/DSR/CD/RI — ioctl TIOCM* на
|
||||
псевдотерминале не работает. Это остаётся на живой порт с железкой.
|
||||
}
|
||||
|
||||
{$MODE Delphi}
|
||||
|
||||
uses
|
||||
cthreads, SysUtils, BaseUnix, termio, Unix,
|
||||
SerialPort, CATEngine, CATSerial;
|
||||
|
||||
var
|
||||
Passed, Failed: Integer;
|
||||
|
||||
procedure Check(const Name: string; Cond: Boolean; const Extra: string = '');
|
||||
begin
|
||||
if Cond then
|
||||
begin
|
||||
Inc(Passed);
|
||||
WriteLn(' ok ', Name);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Inc(Failed);
|
||||
if Extra <> '' then
|
||||
WriteLn(' FAIL ', Name, ' ', Extra)
|
||||
else
|
||||
WriteLn(' FAIL ', Name);
|
||||
end;
|
||||
end;
|
||||
|
||||
// ── Псевдотерминал ──────────────────────────────────────────────────────────
|
||||
function posix_openpt(Flags: cint): cint; cdecl; external 'c' name 'posix_openpt';
|
||||
function grantpt(Fd: cint): cint; cdecl; external 'c' name 'grantpt';
|
||||
function unlockpt(Fd: cint): cint; cdecl; external 'c' name 'unlockpt';
|
||||
function ptsname(Fd: cint): PChar; cdecl; external 'c' name 'ptsname';
|
||||
|
||||
function OpenPty(out Master: cint; out SlaveName: string): Boolean;
|
||||
var P: PChar;
|
||||
begin
|
||||
Result := False;
|
||||
SlaveName := '';
|
||||
Master := posix_openpt(O_RDWR or O_NOCTTY);
|
||||
if Master < 0 then Exit;
|
||||
if (grantpt(Master) <> 0) or (unlockpt(Master) <> 0) then
|
||||
begin
|
||||
fpClose(Master);
|
||||
Exit;
|
||||
end;
|
||||
P := ptsname(Master);
|
||||
if P = nil then
|
||||
begin
|
||||
fpClose(Master);
|
||||
Exit;
|
||||
end;
|
||||
SlaveName := string(P);
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function MasterWrite(Master: cint; const S: AnsiString): Boolean;
|
||||
begin
|
||||
Result := (Length(S) > 0) and (fpWrite(Master, S[1], Length(S)) = Length(S));
|
||||
end;
|
||||
|
||||
function MasterReadStr(Master: cint; TimeoutMs: Integer): AnsiString;
|
||||
// Собирает всё, что мастер отдаёт, пока не замолчит на TimeoutMs.
|
||||
var
|
||||
FDS: TFDSet;
|
||||
TV: TimeVal;
|
||||
Buf: array[0..255] of Byte;
|
||||
N, i: LongInt;
|
||||
begin
|
||||
Result := '';
|
||||
repeat
|
||||
fpFD_Zero(FDS);
|
||||
fpFD_Set(Master, FDS);
|
||||
TV.tv_sec := TimeoutMs div 1000;
|
||||
TV.tv_usec := (TimeoutMs mod 1000) * 1000;
|
||||
if fpSelect(Master + 1, @FDS, nil, nil, @TV) <= 0 then Break;
|
||||
N := fpRead(Master, Buf[0], SizeOf(Buf));
|
||||
if N <= 0 then Break;
|
||||
for i := 0 to N - 1 do Result := Result + Chr(Buf[i]);
|
||||
until False;
|
||||
end;
|
||||
|
||||
// ── A. Открытие ─────────────────────────────────────────────────────────────
|
||||
procedure TestOpen;
|
||||
var
|
||||
H, Master: cint;
|
||||
Slave: string;
|
||||
begin
|
||||
WriteLn('A. Открытие порта');
|
||||
|
||||
H := SerOpen('/dev/does-not-exist-ewsdr');
|
||||
Check('несуществующий порт не открывается', not SerValid(H));
|
||||
Check('неуспех даёт SER_INVALID_HANDLE, а не ноль',
|
||||
H = SER_INVALID_HANDLE, IntToStr(H));
|
||||
|
||||
if not OpenPty(Master, Slave) then
|
||||
begin
|
||||
Check('псевдотерминал создан', False);
|
||||
Exit;
|
||||
end;
|
||||
H := SerOpen(Slave);
|
||||
Check('порт открывается', SerValid(H), Slave);
|
||||
SerClose(H);
|
||||
Check('после закрытия хендл больше не годится', not SerValid(SER_INVALID_HANDLE));
|
||||
fpClose(Master);
|
||||
end;
|
||||
|
||||
// ── B. Настройка порта ──────────────────────────────────────────────────────
|
||||
procedure TestParams;
|
||||
var
|
||||
H, Master: cint;
|
||||
Slave: string;
|
||||
T: termios;
|
||||
|
||||
function Attrs: Boolean;
|
||||
begin
|
||||
FillChar(T, SizeOf(T), 0);
|
||||
Result := TCGetAttr(H, T) = 0;
|
||||
end;
|
||||
|
||||
begin
|
||||
WriteLn('B. Настройка порта (termios читается обратно)');
|
||||
if not OpenPty(Master, Slave) then
|
||||
begin
|
||||
Check('псевдотерминал создан', False);
|
||||
Exit;
|
||||
end;
|
||||
H := SerOpen(Slave);
|
||||
if not SerValid(H) then
|
||||
begin
|
||||
Check('порт открыт', False);
|
||||
fpClose(Master);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SerSetParams(H, 115200, 8, NoneParity, 1, []);
|
||||
if not Attrs then
|
||||
Check('termios читается', False)
|
||||
else
|
||||
begin
|
||||
Check('скорость встала (115200)',
|
||||
(T.c_cflag and CBAUD) = B115200, IntToStr(T.c_cflag and CBAUD));
|
||||
Check('символ 8 бит', (T.c_cflag and CSIZE) = CS8);
|
||||
Check('чётности нет', (T.c_cflag and PARENB) = 0);
|
||||
Check('один стоп-бит', (T.c_cflag and CSTOPB) = 0);
|
||||
Check('приём и CLOCAL подняты',
|
||||
(T.c_cflag and CREAD) <> 0, IntToStr(T.c_cflag));
|
||||
// ★Главная проверка всего стенда. Аппаратный поток обязан быть выключен,
|
||||
// пока его не просили: на кабеле без CTS включённый CRTSCTS вешает
|
||||
// передачу намертво, а ошибки при этом никакой. Именно это и делает
|
||||
// RTL-модуль на BSD/macOS, кладя скорость в c_cflag.
|
||||
Check('★аппаратный поток НЕ включился сам',
|
||||
(T.c_cflag and CRTSCTS) = 0, IntToStr(T.c_cflag and CRTSCTS));
|
||||
// ★И ещё жёстче: кроме битов скорости в c_cflag не должно быть НИЧЕГО,
|
||||
// кроме наших флагов. Ровно этим и ломается RTL-модуль на BSD/macOS: там
|
||||
// B-константа это число, и оно ложится в c_cflag посторонними битами.
|
||||
Check('★в c_cflag только наши флаги, скорость в него не попала',
|
||||
(T.c_cflag and (not CBAUD)) = SerCFlags(8, NoneParity, 1, []),
|
||||
Format('%x против %x', [T.c_cflag and (not CBAUD),
|
||||
SerCFlags(8, NoneParity, 1, [])]));
|
||||
Check('сырой режим: канонической обработки нет', (T.c_lflag and ICANON) = 0);
|
||||
Check('сырой режим: эха нет', (T.c_lflag and ECHO) = 0);
|
||||
Check('сырой режим: перевода строк на выходе нет', (T.c_oflag and OPOST) = 0);
|
||||
end;
|
||||
|
||||
// Позитивный контроль к предыдущей проверке: попросили — значит включился.
|
||||
SerSetParams(H, 9600, 8, NoneParity, 1, [RtsCtsFlowControl]);
|
||||
if Attrs then
|
||||
Check('аппаратный поток включается по просьбе',
|
||||
(T.c_cflag and CRTSCTS) <> 0);
|
||||
|
||||
SerSetParams(H, 4800, 7, EvenParity, 2, []);
|
||||
if Attrs then
|
||||
begin
|
||||
Check('скорость 4800', (T.c_cflag and CBAUD) = B4800);
|
||||
Check('два стоп-бита', (T.c_cflag and CSTOPB) <> 0);
|
||||
end;
|
||||
|
||||
// ★Размер символа и чётность обратным чтением НЕ проверяются: pty
|
||||
// восьмибитно-чистый, ядро молча заменяет CS7 на CS8 и снимает PARENB
|
||||
// (проверено отдельной пробой: ставим CS7|PARENB|PARODD — читаем CS8 без
|
||||
// PARENB). Поэтому сборка флагов вынесена в чистую SerCFlags, и проверяем
|
||||
// именно её — на живом порту в c_cflag уходит ровно это значение.
|
||||
Check('формат: 8N1', SerCFlags(8, NoneParity, 1, []) =
|
||||
Cardinal(CREAD or CLOCAL or CS8));
|
||||
Check('формат: 7 бит', (SerCFlags(7, NoneParity, 1, []) and CSIZE) = CS7);
|
||||
Check('формат: 6 бит', (SerCFlags(6, NoneParity, 1, []) and CSIZE) = CS6);
|
||||
Check('формат: 5 бит', (SerCFlags(5, NoneParity, 1, []) and CSIZE) = CS5);
|
||||
Check('формат: чётная чётность',
|
||||
(SerCFlags(8, EvenParity, 1, []) and (PARENB or PARODD)) = PARENB);
|
||||
Check('формат: нечётная чётность',
|
||||
(SerCFlags(8, OddParity, 1, []) and (PARENB or PARODD)) =
|
||||
Cardinal(PARENB or PARODD));
|
||||
Check('формат: два стоп-бита',
|
||||
(SerCFlags(8, NoneParity, 2, []) and CSTOPB) <> 0);
|
||||
Check('★формат: без просьбы аппаратного потока нет',
|
||||
(SerCFlags(8, NoneParity, 1, []) and CRTSCTS) = 0);
|
||||
Check('формат: по просьбе аппаратный поток есть',
|
||||
(SerCFlags(8, NoneParity, 1, [RtsCtsFlowControl]) and CRTSCTS) <> 0);
|
||||
|
||||
SerClose(H);
|
||||
fpClose(Master);
|
||||
end;
|
||||
|
||||
// ── C. Обмен ────────────────────────────────────────────────────────────────
|
||||
procedure TestIO;
|
||||
var
|
||||
H, Master: cint;
|
||||
Slave, Got: string;
|
||||
S: AnsiString;
|
||||
B: Byte;
|
||||
N: LongInt;
|
||||
T0, Dt: QWord;
|
||||
begin
|
||||
WriteLn('C. Обмен и таймаут');
|
||||
if not OpenPty(Master, Slave) then
|
||||
begin
|
||||
Check('псевдотерминал создан', False);
|
||||
Exit;
|
||||
end;
|
||||
H := SerOpen(Slave);
|
||||
SerSetParams(H, 115200, 8, NoneParity, 1, []);
|
||||
|
||||
S := 'FA00014200000;';
|
||||
Check('запись прошла целиком',
|
||||
SerWrite(H, S[1], Length(S)) = Length(S));
|
||||
Got := MasterReadStr(Master, 200);
|
||||
Check('на другом конце то же самое', Got = S, Got);
|
||||
|
||||
// ★Сырой режим на выходе: CR обязан дойти как CR. Если бы остался ONLCR,
|
||||
// терминал подменил бы его на CR+LF, и CAT-ответы приезжали бы битыми.
|
||||
S := #13;
|
||||
SerWrite(H, S[1], 1);
|
||||
Got := MasterReadStr(Master, 200);
|
||||
Check('★CR не превращается в CR+LF', Got = #13, IntToStr(Length(Got)));
|
||||
|
||||
MasterWrite(Master, 'Z');
|
||||
N := SerReadTimeout(H, B, 500);
|
||||
Check('чтение с таймаутом отдаёт байт', (N = 1) and (B = Ord('Z')),
|
||||
Format('n=%d b=%d', [N, B]));
|
||||
// Эхо выключено: то, что мы прочитали, не должно вернуться мастеру.
|
||||
Got := MasterReadStr(Master, 100);
|
||||
Check('★эха нет: принятое не возвращается отправителю', Got = '', Got);
|
||||
|
||||
T0 := GetTickCount64;
|
||||
N := SerReadTimeout(H, B, 150);
|
||||
Dt := GetTickCount64 - T0;
|
||||
Check('таймаут возвращает 0', N = 0, IntToStr(N));
|
||||
Check('таймаут выдерживает срок и не висит',
|
||||
(Dt >= 120) and (Dt < 900), Format('%d мс', [Dt]));
|
||||
|
||||
SerClose(H);
|
||||
fpClose(Master);
|
||||
end;
|
||||
|
||||
// ── D. Сквозной прогон: CAT поверх обёртки ─────────────────────────────────
|
||||
procedure TestCatThrough;
|
||||
// Байты на мастере → поток CATSerial → разбор в TCATEngine → ответ обратно.
|
||||
// Контекст радио пустой намеренно: команда ID отвечает константой и ни одного
|
||||
// колбэка не трогает — стенду нужен транспорт, а не радио (его проверяет
|
||||
// test/cat).
|
||||
var
|
||||
Master: cint;
|
||||
Slave, Got: string;
|
||||
Ctx: TCATContext;
|
||||
Eng: TCATEngine;
|
||||
Cfg: TCATSerialConfig;
|
||||
Port: TCATSerialPort;
|
||||
begin
|
||||
WriteLn('D. Сквозной прогон: CAT через обёртку');
|
||||
if not OpenPty(Master, Slave) then
|
||||
begin
|
||||
Check('псевдотерминал создан', False);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
FillChar(Ctx, SizeOf(Ctx), 0);
|
||||
Eng := TCATEngine.Create(Ctx);
|
||||
FillChar(Cfg, SizeOf(Cfg), 0);
|
||||
Cfg.Enabled := True;
|
||||
Cfg.PortName := Slave;
|
||||
Cfg.BaudRate := 9600;
|
||||
Cfg.DataBits := 8;
|
||||
Cfg.StopBits := 1;
|
||||
Cfg.Parity := cspNone;
|
||||
Port := TCATSerialPort.Create(Eng, Cfg);
|
||||
try
|
||||
Port.Start;
|
||||
Check('порт CAT поднялся', Port.Active, Port.LastError);
|
||||
MasterWrite(Master, 'ID;');
|
||||
Got := MasterReadStr(Master, 1000);
|
||||
Check('на команду пришёл ответ', Copy(Got, 1, 2) = 'ID', Got);
|
||||
Check('ответ закрыт точкой с запятой',
|
||||
(Length(Got) > 0) and (Got[Length(Got)] = ';'), Got);
|
||||
finally
|
||||
Port.Stop;
|
||||
Port.Free;
|
||||
Eng.Free;
|
||||
fpClose(Master);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Passed := 0;
|
||||
Failed := 0;
|
||||
WriteLn('=== Стенд последовательного порта (SerialPort.pas на pty) ===');
|
||||
TestOpen;
|
||||
TestParams;
|
||||
TestIO;
|
||||
TestCatThrough;
|
||||
WriteLn;
|
||||
WriteLn(Format('Итого: %d проверок, провалено %d', [Passed + Failed, Failed]));
|
||||
if Failed > 0 then Halt(1);
|
||||
end.
|
||||
Reference in New Issue
Block a user