From 05ba39fdada98186af748daee8724ad6fb5a7924 Mon Sep 17 00:00:00 2001 From: Vladimir Date: Mon, 24 Aug 2026 22:09:44 +0300 Subject: [PATCH] =?UTF-8?q?feat(serial):=20=D1=81=D0=B2=D0=BE=D1=8F=20?= =?UTF-8?q?=D0=BE=D0=B1=D1=91=D1=80=D1=82=D0=BA=D0=B0=20=D0=BF=D0=BE=D1=81?= =?UTF-8?q?=D0=BB=D0=B5=D0=B4=D0=BE=D0=B2=D0=B0=D1=82=D0=B5=D0=BB=D1=8C?= =?UTF-8?q?=D0=BD=D0=BE=D0=B3=D0=BE=20=D0=BF=D0=BE=D1=80=D1=82=D0=B0=20?= =?UTF-8?q?=E2=80=94=20macOS=20=D1=81=D0=BE=D0=B1=D0=B8=D1=80=D0=B0=D0=B5?= =?UTF-8?q?=D1=82=D1=81=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV --- CATSerial.pas | 73 ++---- CWKeyer.pas | 16 +- MainForm.pas | 8 +- SerialPort.pas | 420 ++++++++++++++++++++++++++++++ Settings.pas | 20 +- SettingsForm.pas | 10 +- test/platform/run.sh | 77 ++++-- test/platform/win_stub/Serial.pas | 54 ++++ test/serial/README.md | 40 +++ test/serial/run.sh | 18 ++ test/serial/serialtest.pas | 329 +++++++++++++++++++++++ 11 files changed, 943 insertions(+), 122 deletions(-) create mode 100644 SerialPort.pas create mode 100644 test/platform/win_stub/Serial.pas create mode 100644 test/serial/README.md create mode 100755 test/serial/run.sh create mode 100644 test/serial/serialtest.pas diff --git a/CATSerial.pas b/CATSerial.pas index 4385321..1ac7ea1 100644 --- a/CATSerial.pas +++ b/CATSerial.pas @@ -8,28 +8,23 @@ unit CATSerial; 3. Передаёт команду в TCATEngine.Parse() 4. Отправляет ответ обратно в порт - Платформы: - • Linux : /dev/ttyS0..3, /dev/ttyUSB0, etc. - • Windows: COM1..COM4 (имя порта вводится вручную) + Платформы (имя порта вводится вручную, подсказка — SerPortNameHint): + • Linux : /dev/ttyS0..3, /dev/ttyUSB0, /dev/ttyACM0 + • macOS : /dev/cu.usbserial-XXXX + • Windows: COM1..COM4 - Зависимости: CATEngine, Serial (FPC fcl-serial RTL unit) + Зависимости: CATEngine, SerialPort (наша обёртка; RTL-модуль Serial под macOS + не собирается вовсе — см. шапку SerialPort.pas). } {$IFDEF FPC} {$MODE Delphi} {$ENDIF} -{$IFDEF DARWIN} - {$DEFINE CAT_SERIAL_STUB} -{$ENDIF} - interface uses Classes, SysUtils, - {$IFNDEF CAT_SERIAL_STUB} - Serial, // FPC cross-platform serial unit - {$ENDIF} - {$IFDEF MSWINDOWS}Windows,{$ENDIF} + SerialPort, SyncObjs, CATEngine; @@ -50,10 +45,6 @@ type Andromeda: Boolean; // порт — передняя панель Andromeda/G2 (push ZZZI наружу) end; - {$IFDEF CAT_SERIAL_STUB} - TSerialHandle = PtrInt; - {$ENDIF} - TCATSerialPort = class; { TCATSerialThread — per-port listener thread } @@ -150,9 +141,6 @@ var ch: Byte; n: LongInt; begin - {$IFDEF CAT_SERIAL_STUB} - Exit; - {$ELSE} FHandle := FOwner.Handle; while not Terminated do begin n := SerReadTimeout(FHandle, ch, 50); @@ -161,7 +149,6 @@ begin if ch = Ord(';') then ProcessBuffer; end; end; - {$ENDIF} end; { ── TCATSerialPort ────────────────────────────────────────────────────────── } @@ -171,11 +158,7 @@ begin inherited Create; FEngine := AEngine; FConfig := ACfg; - {$IFDEF MSWINDOWS} - FHandle := INVALID_HANDLE_VALUE; - {$ELSE} - FHandle := -1; - {$ENDIF} + FHandle := SER_INVALID_HANDLE; FLock := TCriticalSection.Create; FActive := False; end; @@ -188,52 +171,34 @@ begin end; function TCATSerialPort.OpenPort: Boolean; - {$IFNDEF CAT_SERIAL_STUB} var h: TSerialHandle; par: TParityType; - {$ENDIF} begin Result := False; - {$IFDEF CAT_SERIAL_STUB} - FLastError := 'serial support not built on this platform'; - {$ELSE} h := SerOpen(FConfig.PortName); - {$IFDEF MSWINDOWS} - if h = TSerialHandle(INVALID_HANDLE_VALUE) then - {$ELSE} - if h < 0 then - {$ENDIF} + if not SerValid(h) then begin FLastError := 'не удалось открыть ' + FConfig.PortName; Exit; end; case FConfig.Parity of - cspNone: par := Serial.NoneParity; - cspOdd: par := Serial.OddParity; - cspEven: par := Serial.EvenParity; - else par := Serial.NoneParity; + cspOdd: par := OddParity; + cspEven: par := EvenParity; + else par := NoneParity; end; SerSetParams(h, FConfig.BaudRate, FConfig.DataBits, par, FConfig.StopBits, []); FHandle := h; FLastError := ''; Result := True; - {$ENDIF} end; procedure TCATSerialPort.ClosePort; begin - {$IFNDEF CAT_SERIAL_STUB} - {$IFDEF MSWINDOWS} - if FHandle <> INVALID_HANDLE_VALUE then SerClose(FHandle); - FHandle := INVALID_HANDLE_VALUE; - {$ELSE} - if FHandle >= 0 then SerClose(FHandle); - FHandle := -1; - {$ENDIF} - {$ENDIF} + if SerValid(FHandle) then SerClose(FHandle); + FHandle := SER_INVALID_HANDLE; end; procedure TCATSerialPort.Start; @@ -262,14 +227,7 @@ end; procedure TCATSerialPort.SendStr(const S: string); var buf: AnsiString; begin - {$IFDEF CAT_SERIAL_STUB} - Exit; - {$ELSE} - {$IFDEF MSWINDOWS} - if FHandle = INVALID_HANDLE_VALUE then Exit; - {$ELSE} - if FHandle < 0 then Exit; - {$ENDIF} + if not SerValid(FHandle) then Exit; FLock.Acquire; try buf := AnsiString(S); @@ -279,7 +237,6 @@ begin // ignore write errors (port may have been closed) end; FLock.Release; - {$ENDIF} end; { ── TCATSerialManager ─────────────────────────────────────────────────────── } diff --git a/CWKeyer.pas b/CWKeyer.pas index b37b502..e935309 100644 --- a/CWKeyer.pas +++ b/CWKeyer.pas @@ -39,7 +39,7 @@ unit CWKeyer; interface uses - Classes, SysUtils, SyncObjs, Math, Serial, CWMorse; + Classes, SysUtils, SyncObjs, Math, SerialPort, CWMorse; const CW_SIDETONE_RATE = 48000; // rate огибающей сайдтона (аудиотракт PC) @@ -912,7 +912,7 @@ end; constructor TCWKeyPort.Create; begin FLock := TCriticalSection.Create; - FHandle := 0; + FHandle := SER_INVALID_HANDLE; FreeOnTerminate := False; inherited Create(False); end; @@ -972,13 +972,13 @@ end; procedure TCWKeyPort.ClosePort; begin - if FHandle > 0 then + if SerValid(FHandle) then begin SerSetDTR(FHandle, False); SerSetRTS(FHandle, False); SerClose(FHandle); end; - FHandle := 0; + FHandle := SER_INVALID_HANDLE; end; function TCWKeyPort.OpenPort(const C: TCWKeyPortConfig): Boolean; @@ -986,9 +986,9 @@ begin Result := False; if C.Port = '' then Exit; FHandle := SerOpen(C.Port); - if FHandle <= 0 then + if not SerValid(FHandle) then begin - FHandle := 0; + FHandle := SER_INVALID_HANDLE; SetErr('cannot open ' + C.Port); Exit; end; @@ -1039,12 +1039,12 @@ begin if not C.Enabled then begin - if FHandle > 0 then begin Release; ClosePort; end; + if SerValid(FHandle) then begin Release; ClosePort; end; Sleep(100); Continue; end; - if FHandle <= 0 then + if not SerValid(FHandle) then begin // Переоткрытие раз в 2 с: адаптер могли воткнуть уже после старта. if GetTickCount64 < Retry then begin Sleep(100); Continue; end; diff --git a/MainForm.pas b/MainForm.pas index b3d20f9..9034e5f 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -40,7 +40,7 @@ uses PanZoomBar, PanafallPanel, PanDisplayPopup, PureSignalPopup, FlatPopupMenu, WidebandView, StatusBar, - PlatformUtils, + PlatformUtils, SerialPort, RadioModes, WinFirewall, BoardUtils, WisdomBuilder, UISync, @@ -1230,11 +1230,7 @@ begin FCATLastGlobal.CATSerialBaud[i] := 9600; FCATLastGlobal.CATSerialDataBits[i] := 8; FCATLastGlobal.CATSerialStopBits[i] := 1; - {$IFDEF MSWINDOWS} - FCATLastGlobal.CATSerialPort[i] := 'COM' + IntToStr(i + 1); - {$ELSE} - FCATLastGlobal.CATSerialPort[i] := '/dev/ttyS' + IntToStr(i); - {$ENDIF} + FCATLastGlobal.CATSerialPort[i] := SerDefaultPortName(i); end; FController.FSettings.LoadCATSettings(FCATLastGlobal); FLightTheme := FController.FSettings.LoadTheme; diff --git a/SerialPort.pas b/SerialPort.pas new file mode 100644 index 0000000..030da1c --- /dev/null +++ b/SerialPort.pas @@ -0,0 +1,420 @@ +unit SerialPort; + +{ + SerialPort.pas — последовательный порт: один API на все три платформы. + + ЗАЧЕМ СВОЙ. Модуль `Serial` из RTL собирается только для + [android, linux, netbsd, openbsd, win32, win64] — Darwin в списке нет + (rtl-extra/fpmake.pp), поэтому под macOS проект не собирался вовсе, а CAT и + телеграфный ключ приходилось глушить заглушкой. + + ★И скопировать чужой исходник было нельзя. `Serial.SerSetParams` кладёт + B-константу скорости прямо в c_cflag — идиома Linux, где это битовая маска. + На BSD и macOS `B115200` это просто ЧИСЛО 115200, и в c_cflag прилетает + $1C200, то есть CLOCAL | HUPCL | CCTS_OFLOW плюс мусор в поле CSIZE: + молча включается аппаратный CTS-flow, и передача встаёт, если железка не + держит CTS. Ошибки при этом никакой — порт «открылся». Поэтому скорость + ставим единственным переносимым способом: CFSetISpeed/CFSetOSpeed, а c_cflag + собираем с нуля. + + Устройство: + • Unix (Linux и macOS одним путём) — termios напрямую, без развилок по ОС: + разница между ними спрятана в константах RTL. Модемные линии — ioctl + TIOCM*, они есть и там, и там. + • Windows — тонкая переадресация в RTL `Serial` (там он собирается и работает). + + Имена и сигнатуры намеренно повторяют RTL-модуль: точки вызова (CATSerial, + CWKeyer) меняют только строку uses. ★Отличие ровно одно, и оно к лучшему: + неуспех SerOpen на ВСЕХ платформах даёт SER_INVALID_HANDLE (RTL возвращал 0 + на Windows и −1 на Unix, из-за чего вызывающие держали свои развилки). + Проверять результат следует через SerValid. +} + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +interface + +type +{$IFDEF WINDOWS} + TSerialHandle = THandle; +{$ELSE} + TSerialHandle = LongInt; +{$ENDIF} + + TParityType = (NoneParity, OddParity, EvenParity); + TSerialFlag = (RtsCtsFlowControl); + TSerialFlags = set of TSerialFlag; + +const + // На Windows THandle(-1) — это и есть INVALID_HANDLE_VALUE. + SER_INVALID_HANDLE = TSerialHandle(-1); + +{ Открыть порт. Имя — как его пишет система: + Linux /dev/ttyS0, /dev/ttyUSB0, /dev/ttyACM0 + macOS /dev/cu.usbserial-XXXX ★именно cu, а не tty: tty-устройство + блокируется на open до появления DCD + Windows COM1, \\.\COM12 для номеров больше девяти + Неуспех — SER_INVALID_HANDLE. } +function SerOpen(const DeviceName: string): TSerialHandle; +procedure SerClose(Handle: TSerialHandle); +{ Годен ли хендл (одна проверка вместо платформенных развилок у вызывающих). } +function SerValid(Handle: TSerialHandle): Boolean; + +procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt; + ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags); + +function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt; +function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt; +{ Ждать ОДИН байт не дольше TimeOutMs. Результат — сколько прочитано (0 или 1). } +function SerReadTimeout(Handle: TSerialHandle; var Buffer; + TimeOutMs: LongInt): LongInt; + +procedure SerSetDTR(Handle: TSerialHandle; State: Boolean); +procedure SerSetRTS(Handle: TSerialHandle; State: Boolean); +function SerGetCTS(Handle: TSerialHandle): Boolean; +function SerGetDSR(Handle: TSerialHandle): Boolean; +function SerGetCD(Handle: TSerialHandle): Boolean; +function SerGetRI(Handle: TSerialHandle): Boolean; + +{$IFNDEF WINDOWS} +{ Флаги c_cflag для заданного формата. Вынесено в интерфейс РАДИ СТЕНДА: + псевдотерминал хранит не всё, что ему ставят (CS7 и чётность он молча + заменяет на CS8 без чётности — pty восьмибитно-чистый), поэтому проверять + сборку флагов обратным чтением termios нельзя, а проверять надо. } +function SerCFlags(ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags): Cardinal; +{$ENDIF} + +{ Имя порта по умолчанию для настроек и подсказок в UI: у каждой системы своё, + и '/dev/ttyS0' на маке — заведомо неверная подсказка. Index 0..N. } +function SerDefaultPortName(Index: Integer): string; +{ Пример имени для подсказки под полем ввода. } +function SerPortNameHint: string; + +implementation + +uses + SysUtils +{$IFDEF WINDOWS} + , Serial // RTL: на Windows он есть и работает +{$ELSE} + , BaseUnix, termio, Unix +{$ENDIF}; + +{$IFDEF WINDOWS} +// ── Windows: переадресация в RTL ─────────────────────────────────────────── +// Своей реализации здесь не нужно: RTL-модуль под Windows собирается и в +// битовые поля termios не лезет — там свой DCB. Приводим только к нашим типам +// и к единому «неуспех = SER_INVALID_HANDLE». + +function RtlParity(P: TParityType): Serial.TParityType; +begin + case P of + OddParity: Result := Serial.OddParity; + EvenParity: Result := Serial.EvenParity; + else + Result := Serial.NoneParity; + end; +end; + +function RtlFlags(F: TSerialFlags): Serial.TSerialFlags; +begin + Result := []; + if RtsCtsFlowControl in F then Include(Result, Serial.RtsCtsFlowControl); +end; + +function SerOpen(const DeviceName: string): TSerialHandle; +begin + Result := Serial.SerOpen(DeviceName); + // ★RTL под Windows отдаёт 0 при неудаче, под Unix −1. Приводим к одному. + if Result = 0 then Result := SER_INVALID_HANDLE; +end; + +procedure SerClose(Handle: TSerialHandle); +begin + if SerValid(Handle) then Serial.SerClose(Handle); +end; + +procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt; + ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags); +begin + Serial.SerSetParams(Handle, BitsPerSec, ByteSize, RtlParity(Parity), + StopBits, RtlFlags(Flags)); +end; + +function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt; +begin + Result := Serial.SerRead(Handle, Buffer, Count); +end; + +function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt; +begin + Result := Serial.SerWrite(Handle, Buffer, Count); +end; + +function SerReadTimeout(Handle: TSerialHandle; var Buffer; + TimeOutMs: LongInt): LongInt; +begin + Result := Serial.SerReadTimeout(Handle, Buffer, TimeOutMs); +end; + +procedure SerSetDTR(Handle: TSerialHandle; State: Boolean); +begin + Serial.SerSetDTR(Handle, State); +end; + +procedure SerSetRTS(Handle: TSerialHandle; State: Boolean); +begin + Serial.SerSetRTS(Handle, State); +end; + +function SerGetCTS(Handle: TSerialHandle): Boolean; +begin + Result := Serial.SerGetCTS(Handle); +end; + +function SerGetDSR(Handle: TSerialHandle): Boolean; +begin + Result := Serial.SerGetDSR(Handle); +end; + +function SerGetCD(Handle: TSerialHandle): Boolean; +begin + Result := Serial.SerGetCD(Handle); +end; + +function SerGetRI(Handle: TSerialHandle): Boolean; +begin + Result := Serial.SerGetRI(Handle); +end; + +{$ELSE} +// ── Unix: termios напрямую, один путь для Linux и macOS ──────────────────── + +function BaudConst(BitsPerSec: LongInt): Cardinal; +// Скорость → константа termios. На Linux это битовая маска, на BSD/macOS — +// само число; обе прячутся за одним именем, поэтому развилки по ОС не нужно. +begin + case BitsPerSec of + 50: Result := B50; + 75: Result := B75; + 110: Result := B110; + 134: Result := B134; + 150: Result := B150; + 200: Result := B200; + 300: Result := B300; + 600: Result := B600; + 1200: Result := B1200; + 1800: Result := B1800; + 2400: Result := B2400; + 4800: Result := B4800; + 9600: Result := B9600; + 19200: Result := B19200; + 38400: Result := B38400; + 57600: Result := B57600; + 115200: Result := B115200; + 230400: Result := B230400; + else + Result := B9600; + end; +end; + +function SerCFlags(ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags): Cardinal; +// ★Только флаги — никаких скоростей (см. шапку модуля). CLOCAL = «модемных +// линий не ждём», без него open и read на кабеле без DCD ведут себя по-разному +// на разных системах. +begin + Result := CREAD or CLOCAL; + case ByteSize of + 5: Result := Result or CS5; + 6: Result := Result or CS6; + 7: Result := Result or CS7; + else + Result := Result or CS8; + end; + case Parity of + OddParity: Result := Result or PARENB or PARODD; + EvenParity: Result := Result or PARENB; + end; + if StopBits = 2 then Result := Result or CSTOPB; + // Аппаратный поток — ТОЛЬКО по явной просьбе. Случайно включённый CRTSCTS + // вешает передачу намертво на кабеле без CTS. + if RtsCtsFlowControl in Flags then Result := Result or CRTSCTS; +end; + +function SerOpen(const DeviceName: string): TSerialHandle; +var + Fl: LongInt; +begin + // ★O_NONBLOCK на открытии обязателен: часть USB-драйверов (и любое tty-, а не + // cu-устройство на macOS) висит в open до поднятия DCD. Сразу после открытия + // флаг снимаем — дальше нам нужны обычные блокирующие чтение и запись, а + // ожидание делает fpSelect в SerReadTimeout. + Result := fpOpen(DeviceName, O_RDWR or O_NOCTTY or O_NONBLOCK); + if Result < 0 then Exit(SER_INVALID_HANDLE); + Fl := fpFcntl(Result, F_GetFl, 0); + if Fl >= 0 then fpFcntl(Result, F_SetFl, Fl and (not O_NONBLOCK)); +end; + +procedure SerClose(Handle: TSerialHandle); +begin + if SerValid(Handle) then fpClose(Handle); +end; + +procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt; + ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags); +var + Tios: termios; + Speed: Cardinal; +begin + if not SerValid(Handle) then Exit; + FillChar(Tios, SizeOf(Tios), 0); + + Tios.c_cflag := SerCFlags(ByteSize, Parity, StopBits, Flags); + + // Сырой режим: ни канонической обработки строк, ни эха, ни трансляции + // символов на входе и выходе. CAT — двоичный поток с ';' в роли конца + // команды, любая «помощь» терминала его портит. + Tios.c_iflag := 0; + Tios.c_oflag := 0; + Tios.c_lflag := 0; + Tios.c_cc[VMIN] := 0; // read возвращает то, что есть, и не ждёт + Tios.c_cc[VTIME] := 0; + + Speed := BaudConst(BitsPerSec); + CFSetISpeed(Tios, Speed); + CFSetOSpeed(Tios, Speed); + + TCFlush(Handle, TCIOFLUSH); + TCSetAttr(Handle, TCSANOW, Tios); +end; + +function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt; +begin + if not SerValid(Handle) then Exit(0); + Result := fpRead(Handle, Buffer, Count); + if Result < 0 then Result := 0; +end; + +function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt; +begin + if not SerValid(Handle) then Exit(0); + Result := fpWrite(Handle, Buffer, Count); + if Result < 0 then Result := 0; +end; + +function SerReadTimeout(Handle: TSerialHandle; var Buffer; + TimeOutMs: LongInt): LongInt; +var + FDS: TFDSet; + TV: TimeVal; + N: LongInt; +begin + Result := 0; + if not SerValid(Handle) then Exit; + fpFD_Zero(FDS); + fpFD_Set(Handle, FDS); + TV.tv_sec := TimeOutMs div 1000; + TV.tv_usec := (TimeOutMs mod 1000) * 1000; + N := fpSelect(Handle + 1, @FDS, nil, nil, @TV); + if N <= 0 then Exit; // таймаут или ошибка — байта нет + Result := fpRead(Handle, Buffer, 1); + if Result < 0 then Result := 0; +end; + +procedure SetModemBit(Handle: TSerialHandle; Bit: Cardinal; State: Boolean); +var + Bits: Cardinal; +begin + if not SerValid(Handle) then Exit; + Bits := Bit; + if State then + fpIOCtl(Handle, TIOCMBIS, @Bits) + else + fpIOCtl(Handle, TIOCMBIC, @Bits); +end; + +function ModemBitSet(Handle: TSerialHandle; Bit: Cardinal): Boolean; +var + Bits: Cardinal; +begin + Result := False; + if not SerValid(Handle) then Exit; + Bits := 0; + if fpIOCtl(Handle, TIOCMGET, @Bits) < 0 then Exit; + Result := (Bits and Bit) <> 0; +end; + +procedure SerSetDTR(Handle: TSerialHandle; State: Boolean); +begin + SetModemBit(Handle, TIOCM_DTR, State); +end; + +procedure SerSetRTS(Handle: TSerialHandle; State: Boolean); +begin + SetModemBit(Handle, TIOCM_RTS, State); +end; + +function SerGetCTS(Handle: TSerialHandle): Boolean; +begin + Result := ModemBitSet(Handle, TIOCM_CTS); +end; + +function SerGetDSR(Handle: TSerialHandle): Boolean; +begin + Result := ModemBitSet(Handle, TIOCM_DSR); +end; + +function SerGetCD(Handle: TSerialHandle): Boolean; +begin + Result := ModemBitSet(Handle, TIOCM_CAR); +end; + +function SerGetRI(Handle: TSerialHandle): Boolean; +begin + Result := ModemBitSet(Handle, TIOCM_RNG); +end; + +{$ENDIF} + +// ── Общее для всех платформ ──────────────────────────────────────────────── + +function SerValid(Handle: TSerialHandle): Boolean; +begin + // Ноль сюда попадает от RTL под Windows (там это признак неудачи) и не может + // быть настоящим портом на Unix: дескриптор 0 занят стандартным вводом. + Result := (Handle <> SER_INVALID_HANDLE) and (Handle <> 0); +end; + +function SerDefaultPortName(Index: Integer): string; +begin +{$IF DEFINED(WINDOWS)} + Result := 'COM' + IntToStr(Index + 1); +{$ELSEIF DEFINED(DARWIN)} + // ★На маке имя порта зависит от переходника (/dev/cu.usbserial-A1B2C3), так + // что осмысленного умолчания не существует — пустая строка честнее наугад + // придуманной. Формат подсказывает SerPortNameHint в окне настроек. + Result := ''; +{$ELSE} + Result := '/dev/ttyS' + IntToStr(Index); +{$ENDIF} +end; + +function SerPortNameHint: string; +begin +{$IF DEFINED(WINDOWS)} + Result := 'COM3, \\.\COM12'; +{$ELSEIF DEFINED(DARWIN)} + Result := '/dev/cu.usbserial-XXXX'; +{$ELSE} + Result := '/dev/ttyUSB0, /dev/ttyS0'; +{$ENDIF} +end; + +end. diff --git a/Settings.pas b/Settings.pas index 2ee9ffe..7a9180c 100644 --- a/Settings.pas +++ b/Settings.pas @@ -7,7 +7,7 @@ unit Settings; {$mode objfpc}{$H+} interface uses SysUtils, Classes, Math, fpJSON, jsonparser, jsonscanner, PlatformUtils, - RadioModes; + SerialPort, RadioModes; const SETTINGS_FILE = 'hpsdr_settings.json'; @@ -1048,11 +1048,7 @@ begin // CAT defaults for i := 0 to 3 do begin G.CATSerialEnabled[i] := False; - {$IFDEF MSWINDOWS} - G.CATSerialPort[i] := 'COM' + IntToStr(i+1); - {$ELSE} - G.CATSerialPort[i] := '/dev/ttyS' + IntToStr(i); - {$ENDIF} + G.CATSerialPort[i] := SerDefaultPortName(i); G.CATSerialBaud[i] := 9600; G.CATSerialDataBits[i] := 8; G.CATSerialStopBits[i] := 1; @@ -1314,11 +1310,7 @@ begin // CAT serial settings for i := 0 to 3 do begin G.CATSerialEnabled[i] := JB(GObj,'cat_serial_en_'+IntToStr(i), False); - {$IFDEF MSWINDOWS} - G.CATSerialPort[i] := JS(GObj,'cat_serial_port_'+IntToStr(i), 'COM'+IntToStr(i+1)); - {$ELSE} - G.CATSerialPort[i] := JS(GObj,'cat_serial_port_'+IntToStr(i), '/dev/ttyS'+IntToStr(i)); - {$ENDIF} + G.CATSerialPort[i] := JS(GObj,'cat_serial_port_'+IntToStr(i), SerDefaultPortName(i)); G.CATSerialBaud[i] := JI(GObj,'cat_serial_baud_'+IntToStr(i), 9600); G.CATSerialDataBits[i] := JI(GObj,'cat_serial_dbits_'+IntToStr(i), 8); G.CATSerialStopBits[i] := JI(GObj,'cat_serial_sbits_'+IntToStr(i), 1); @@ -1658,11 +1650,7 @@ begin for i := 0 to 3 do begin G.CATSerialEnabled[i] := JB(O, 'ser_en_' +IntToStr(i), False); - {$IFDEF MSWINDOWS} - G.CATSerialPort[i] := JS(O, 'ser_port_' +IntToStr(i), 'COM'+IntToStr(i+1)); - {$ELSE} - G.CATSerialPort[i] := JS(O, 'ser_port_' +IntToStr(i), '/dev/ttyS'+IntToStr(i)); - {$ENDIF} + G.CATSerialPort[i] := JS(O, 'ser_port_' +IntToStr(i), SerDefaultPortName(i)); G.CATSerialBaud[i] := JI(O, 'ser_baud_' +IntToStr(i), 9600); G.CATSerialDataBits[i] := JI(O, 'ser_dbits_' +IntToStr(i), 8); G.CATSerialStopBits[i] := JI(O, 'ser_sbits_' +IntToStr(i), 1); diff --git a/SettingsForm.pas b/SettingsForm.pas index 3a3e4a9..5504c1a 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -30,7 +30,7 @@ uses FlatButton, FlatCheckBox, FlatComboBox, FlatEdit, FlatSpinEdit, FlatFloatSpinEdit, FlatRadioButton, FlatMemo, EqualizerControl, OverlayScrollBar, AudioOutput, AudioInput, AppTheme, Settings, - BoardUtils, DpiUtils; + BoardUtils, DpiUtils, SerialPort; const // Подвкладки страницы Transmit: Profile / EQ / Hardware / Display. @@ -2162,7 +2162,7 @@ begin FEdCWKeyPort.Font.Color := CLR_INPUT_TEXT; FEdCWKeyPort.Font.Size := 9; FEdCWKeyPort.OnExit := OnCWAnyChange; - MakeLbl(Grp, '/dev/ttyUSB0, COM3', PAD + 492, R1 + 7 * STEP + 5, 200); + MakeLbl(Grp, SerPortNameHint, PAD + 492, R1 + 7 * STEP + 5, 200); MakeLbl(Grp, 'Dot line', PAD, R1 + 8 * STEP + 5, 70); FCmbCWDotLine := MkCmbCW(Grp, PAD + 74, R1 + 8 * STEP, 90); @@ -4637,11 +4637,7 @@ begin Ed.Font.Size := 9; Ed.Tag := i; Ed.OnChange := OnCATSerialChange; - {$IFDEF MSWINDOWS} - Ed.Text := 'COM' + IntToStr(i + 1); - {$ELSE} - Ed.Text := '/dev/ttyS' + IntToStr(i); - {$ENDIF} + Ed.Text := SerDefaultPortName(i); FCATSerialPort[i] := Ed; MakeLbl(Grp, 'Baud rate:', PAD, R1 + 2 * STEP + 6, LW); diff --git a/test/platform/run.sh b/test/platform/run.sh index 64da918..fdde5ed 100755 --- a/test/platform/run.sh +++ b/test/platform/run.sh @@ -1,44 +1,67 @@ #!/bin/sh -# Проверка ветвей PlatformUtils под Windows и macOS БЕЗ этих платформ. +# Проверка платформенных ветвей БЕЗ самих платформ (Windows и macOS). # # Зачем. Кросс-RTL обычно не установлен, поэтому ветки {$IFDEF WINDOWS} и # {$IFDEF DARWIN} на Linux не компилируются ВООБЩЕ — ошибка в них всплывает -# только на сборочной машине, через полчаса после коммита. Так и вышло: unit +# только на сборочной машине, через полчаса после коммита. Так и вышло: модуль # Windows, добавленный ради QueryPerformanceCounter, перекрыл однопараметрический # SysUtils.GetEnvironmentVariable, и win64-сборка легла на трёх вызовах. # -# Как. Копию PlatformUtils.pas переписываем так, чтобы платформенные условия -# читались как наши собственные (-dSIMWIN / -dSIMMAC), и компилируем БЕЗ -# ЛИНКОВКИ (-Cn): системных функций на Linux нет, но синтаксис, типы и — главное — -# разрешение имён проверяются по-настоящему. Для Windows подкладывается -# заглушка unit Windows с теми же перекрывающими объявлениями (win_stub/). +# Как. Копии файлов переписываются так, чтобы платформенные условия читались как +# наши собственные (-dSIMWIN / -dSIMMAC), и компилируются БЕЗ ЛИНКОВКИ (-Cn): +# системных функций на Linux нет, но синтаксис, типы и — главное — разрешение +# имён проверяются по-настоящему. Для Windows подкладываются заглушки модулей +# Windows и Serial (win_stub/) с теми же объявлениями, что у настоящих. # -# Чего проверка НЕ делает: живых вызовов системных счётчиков. Их правильность +# Чего проверка НЕ делает: живых вызовов системных функций. Их правильность # доказывает только прогон на самой платформе. set -e cd "$(dirname "$0")" -SRC=../../PlatformUtils.pas +HERE=$(pwd) +ROOT=../.. +FILES="PlatformUtils.pas SerialPort.pas" WORK=$(mktemp -d) trap 'rm -rf "$WORK"' EXIT +FAILED=0 +COUNT=0 -# ── Windows ── -mkdir -p "$WORK/win" -cp win_stub/Windows.pas "$WORK/win/" -sed -e 's/{\$IFDEF WINDOWS}/{$IFDEF SIMWIN}/g' \ - -e 's/{\$IFNDEF WINDOWS}/{$IFNDEF SIMWIN}/g' "$SRC" > "$WORK/win/PlatformUtils.pas" -( cd "$WORK/win" && fpc -B -Mobjfpc -dHEADLESS -dSIMWIN -Fu. -FU. -Cn PlatformUtils.pas >"$WORK/win.log" 2>&1 ) \ - || { echo "WINDOWS-ветка НЕ компилируется:"; cat "$WORK/win.log"; exit 1; } -echo " ok PlatformUtils: ветка WINDOWS компилируется (заглушка unit Windows перекрывает SysUtils, как настоящий)" +sim_build() { # $1 = win|mac + MODE=$1 + DIR="$WORK/$MODE" + mkdir -p "$DIR" + if [ "$MODE" = win ]; then + cp win_stub/*.pas "$DIR/" + DEF=-dSIMWIN + else + DEF=-dSIMMAC + fi + for F in $FILES; do + if [ "$MODE" = win ]; then + sed -e 's/{\$IFDEF WINDOWS}/{$IFDEF SIMWIN}/g' \ + -e 's/{\$IFNDEF WINDOWS}/{$IFNDEF SIMWIN}/g' \ + -e 's/{\$IF DEFINED(WINDOWS)}/{$IF DEFINED(SIMWIN)}/g' \ + "$ROOT/$F" > "$DIR/$F" + else + sed -e 's/{\$IFDEF LINUX}/{$IFDEF SIMLINUX}/g' \ + -e 's/{\$IFDEF DARWIN}/{$IFDEF SIMMAC}/g' \ + -e 's/{\$ELSEIF DEFINED(DARWIN)}/{$ELSEIF DEFINED(SIMMAC)}/g' \ + -e 's/{\$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}/{$IF DEFINED(SIMMAC) AND NOT DEFINED(HEADLESS)}/g' \ + "$ROOT/$F" > "$DIR/$F" + fi + COUNT=$((COUNT + 1)) + if ( cd "$DIR" && fpc -B -Mobjfpc -dHEADLESS $DEF -Fu. -FU. -Cn "$F" >"$DIR/$F.log" 2>&1 ); then + echo " ok $F: ветка $MODE компилируется" + else + echo " FAIL $F: ветка $MODE НЕ компилируется" + cat "$DIR/$F.log" + FAILED=$((FAILED + 1)) + fi + done +} -# ── macOS ── -mkdir -p "$WORK/mac" -sed -e 's/{\$IFDEF LINUX}/{$IFDEF SIMLINUX}/g' \ - -e 's/{\$IFDEF DARWIN}/{$IFDEF SIMMAC}/g' \ - -e 's/{\$IF DEFINED(DARWIN) AND NOT DEFINED(HEADLESS)}/{$IF DEFINED(SIMMAC) AND NOT DEFINED(HEADLESS)}/g' \ - "$SRC" > "$WORK/mac/PlatformUtils.pas" -( cd "$WORK/mac" && fpc -B -Mobjfpc -dHEADLESS -dSIMMAC -Fu. -FU. -Cn PlatformUtils.pas >"$WORK/mac.log" 2>&1 ) \ - || { echo "DARWIN-ветка НЕ компилируется:"; cat "$WORK/mac.log"; exit 1; } -echo " ok PlatformUtils: ветка DARWIN компилируется (mach_absolute_time, без линковки)" +sim_build win +sim_build mac echo -echo "Итого: 2 проверки, провалено 0" +echo "Итого: $COUNT проверок, провалено $FAILED" +[ "$FAILED" -eq 0 ] diff --git a/test/platform/win_stub/Serial.pas b/test/platform/win_stub/Serial.pas new file mode 100644 index 0000000..572bc6d --- /dev/null +++ b/test/platform/win_stub/Serial.pas @@ -0,0 +1,54 @@ +unit Serial; + +{ + Заглушка RTL-модуля Serial для проверки WINDOWS-ветки SerialPort.pas на Linux. + Повторяет ровно ту часть API, которую наша обёртка переадресует под Windows, + включая типы: разъезд сигнатур должен ловиться здесь, а не на сборочной + машине. +} + +{$MODE Delphi} + +interface + +uses + SysUtils; + +type + TSerialHandle = THandle; + TParityType = (NoneParity, OddParity, EvenParity); + TSerialFlags = set of (RtsCtsFlowControl); + +function SerOpen(const DeviceName: string): TSerialHandle; +procedure SerClose(Handle: TSerialHandle); +procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt; + ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags); +function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt; +function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt; +function SerReadTimeout(Handle: TSerialHandle; var Buffer; mSec: LongInt): LongInt; +procedure SerSetDTR(Handle: TSerialHandle; State: Boolean); +procedure SerSetRTS(Handle: TSerialHandle; State: Boolean); +function SerGetCTS(Handle: TSerialHandle): Boolean; +function SerGetDSR(Handle: TSerialHandle): Boolean; +function SerGetCD(Handle: TSerialHandle): Boolean; +function SerGetRI(Handle: TSerialHandle): Boolean; + +implementation + +function SerOpen(const DeviceName: string): TSerialHandle; begin Result := 0; end; +procedure SerClose(Handle: TSerialHandle); begin end; +procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt; + ByteSize: Integer; Parity: TParityType; StopBits: Integer; + Flags: TSerialFlags); begin end; +function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt; begin Result := 0; end; +function SerWrite(Handle: TSerialHandle; const Buffer; Count: LongInt): LongInt; begin Result := 0; end; +function SerReadTimeout(Handle: TSerialHandle; var Buffer; mSec: LongInt): LongInt; begin Result := 0; end; +procedure SerSetDTR(Handle: TSerialHandle; State: Boolean); begin end; +procedure SerSetRTS(Handle: TSerialHandle; State: Boolean); begin end; +function SerGetCTS(Handle: TSerialHandle): Boolean; begin Result := False; end; +function SerGetDSR(Handle: TSerialHandle): Boolean; begin Result := False; end; +function SerGetCD(Handle: TSerialHandle): Boolean; begin Result := False; end; +function SerGetRI(Handle: TSerialHandle): Boolean; begin Result := False; end; + +end. diff --git a/test/serial/README.md b/test/serial/README.md new file mode 100644 index 0000000..2895f3a --- /dev/null +++ b/test/serial/README.md @@ -0,0 +1,40 @@ +# Стенд последовательного порта + +Проверяет обёртку `SerialPort.pas` на **псевдотерминале**: настоящего COM-порта +на сборочной машине нет, а проверить надо ровно то, на чём обжигается перенос — +как обёртка **настраивает** порт. + +``` +test/serial/run.sh +``` + +## Что проверяется + +* **Открытие**: несуществующий порт даёт `SER_INVALID_HANDLE` (а не ноль и не + случайное число), живой — годный хендл. +* **termios обратным чтением**: скорость, стоп-биты, `CREAD`/`CLOCAL`, сырой + режим (нет `ICANON`, `ECHO`, `OPOST`). +* ★**Аппаратный поток `CRTSCTS` не включается сам** — только по явной просьбе. + Это главная проверка стенда: на кабеле без CTS случайно включённый CRTSCTS + вешает передачу намертво, и никакой ошибки при этом нет. Ровно так ломается + RTL-модуль `Serial` на BSD и macOS — там B-константы это числа, а он кладёт + их в `c_cflag` (подробнее — в шапке `SerialPort.pas`). +* ★**В `c_cflag` нет ничего, кроме наших флагов** (маска `CBAUD` снимается) — + прямая ловушка на ту же ошибку. Негативный контроль: если в `SerSetParams` + дописать `or Cardinal(BitsPerSec)`, проверка падает с «1CAB0 против 8B0». +* **Формат** (размер символа, чётность, стоп-биты, флаг потока) — через чистую + `SerCFlags`. Обратным чтением его не проверить: pty восьмибитно-чистый, ядро + молча заменяет `CS7` на `CS8` и снимает `PARENB`. +* **Обмен**: запись и чтение в обе стороны, срок у `SerReadTimeout`, `CR` не + превращается в `CR+LF`, эха нет. +* **Сквозной прогон**: байты на мастере → поток `CATSerial` → `TCATEngine` → + ответ обратно (командой `ID`, она отвечает константой и радио не трогает). + +## Чего стенд НЕ проверяет + +Модемные линии `DTR`/`RTS`/`CTS`/`DSR`/`CD`/`RI`: ioctl `TIOCM*` на +псевдотерминале не работает. Это остаётся на живой порт с железкой — там же +проверяется и телеграфный ключ на `CWKeyer`. + +Компиляцию платформенных ветвей (Windows, macOS) проверяет соседний стенд +`test/platform`. diff --git a/test/serial/run.sh b/test/serial/run.sh new file mode 100755 index 0000000..89a528d --- /dev/null +++ b/test/serial/run.sh @@ -0,0 +1,18 @@ +#!/bin/sh +# Стенд обёртки последовательного порта: сборка и прогон на псевдотерминале. +# Флаги те же, что у демона и у стенда TCI (см. test/tci/run.sh): -Mobjfpc ради +# вложенных комментариев, -dHEADLESS чтобы PlatformUtils не тянул LCL, каталог +# .ppu свой и абсолютным путём, -B обязателен (fpc сверяет .ppu по времени с +# точностью до секунды). +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" +fpc -B -Mobjfpc -O2 -dHEADLESS \ + -Fu../.. -FU"$OUTUNITS" -k-L/usr/local/lib \ + -o"$OUT/serialtest" serialtest.pas +exec "$OUT/serialtest" "$@" diff --git a/test/serial/serialtest.pas b/test/serial/serialtest.pas new file mode 100644 index 0000000..52413d1 --- /dev/null +++ b/test/serial/serialtest.pas @@ -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.