Add debug-repl with TCP REPL server and passing test suite
ober
1702c3d20876445fd26f777468ab8d6e2e14e86a
--- a/Makefile +++ b/Makefile @@ -7,7 +7,10 @@ JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss export LD_LIBRARY_PATH := $(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/jerboa-shell:$(LD_LIBRARY_PATH) export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla -.PHONY: all build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test clean clean-generated +.PHONY: all build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra test clean clean-generated \ + test-org-duration test-org-element test-org-fold test-org-footnote \ + test-org-lint test-org-num test-org-property test-org-src test-org-tempo \ + test-vtscreen test-debug-repl test-qt all: build test @@ -22,7 +25,7 @@ rebuild: run: build $(SCHEME) $(LIBDIRS) --script main.ss -test: build test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org +test: build test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-org test-extra test-tier0: $(SCHEME) $(LIBDIRS) --script tests/test-tier0.ss @@ -70,6 +73,46 @@ test-org-list: test-persist: $(SCHEME) $(LIBDIRS) --script tests/test-persist.ss +test-extra: test-org-duration test-org-element test-org-fold test-org-footnote \ + test-org-lint test-org-num test-org-property test-org-src test-org-tempo \ + test-vtscreen test-debug-repl test-qt + +test-org-duration: + $(SCHEME) $(LIBDIRS) --script tests/test-org-duration.ss + +test-org-element: + $(SCHEME) $(LIBDIRS) --script tests/test-org-element.ss + +test-org-fold: + $(SCHEME) $(LIBDIRS) --script tests/test-org-fold.ss + +test-org-footnote: + $(SCHEME) $(LIBDIRS) --script tests/test-org-footnote.ss + +test-org-lint: + $(SCHEME) $(LIBDIRS) --script tests/test-org-lint.ss + +test-org-num: + $(SCHEME) $(LIBDIRS) --script tests/test-org-num.ss + +test-org-property: + $(SCHEME) $(LIBDIRS) --script tests/test-org-property.ss + +test-org-src: + $(SCHEME) $(LIBDIRS) --script tests/test-org-src.ss + +test-org-tempo: + $(SCHEME) $(LIBDIRS) --script tests/test-org-tempo.ss + +test-vtscreen: + $(SCHEME) $(LIBDIRS) --script tests/test-vtscreen.ss + +test-debug-repl: + $(SCHEME) $(LIBDIRS) --program tests/test-debug-repl.ss + +test-qt: + $(SCHEME) $(LIBDIRS) --script tests/test-qt.ss + clean: find lib -name '*.so' -delete 2>/dev/null; true --- a/lib/jerboa-emacs/debug-repl.sls +++ b/lib/jerboa-emacs/debug-repl.sls @@ -1,182 +1,159 @@ #!chezscheme -;;; debug-repl.sls — TCP REPL server for debugging a running jemacs instance. -;;; -;;; Ported from gerbil-emacs/debug-repl.ss -;;; Connect with: nc 127.0.0.1 <port> -;;; Simplified: no Gambit-specific thread introspection (##thread-state, -;;; ##display-continuation-backtrace, etc.) +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jerboa-emacs/debug-repl.ss (library (jerboa-emacs debug-repl) (export start-debug-repl! stop-debug-repl! debug-repl-port) - (import (except (chezscheme) - make-hash-table hash-table? iota 1+ 1- sort sort! - make-mutex mutex? mutex-name thread? - getenv path-extension path-absolute?) - (jerboa core) - (jerboa runtime) - (std sugar) - (std srfi srfi-13) - (std net tcp) - (jerboa-emacs core)) - - ;;;============================================================================ - ;;; State - ;;;============================================================================ - + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std sugar) (std srfi srfi-13) (std net tcp) (jerboa core) + (jerboa runtime)) (def *debug-repl-server* #f) (def *debug-repl-actual-port* #f) (def *debug-repl-port-file* - (string-append (or (getenv "HOME") ".") "/.jemacs-repl-port")) - - ;;;============================================================================ - ;;; Port file - ;;;============================================================================ - + (string-append (getenv "HOME") "/.jerboa-repl-port")) (def (write-repl-port-file! port-num) - (call-with-output-file *debug-repl-port-file* - (lambda (p) - (put-string p "PORT=") (display port-num p) (newline p) - (put-string p "PID=") (display (get-process-id) p) (newline p)))) - + (delete-repl-port-file!) + (call-with-output-file + *debug-repl-port-file* + (lambda (p) + (display "PORT=" p) + (display port-num p) + (newline p)))) (def (delete-repl-port-file!) - (when (file-exists? *debug-repl-port-file*) - (with-catch void - (lambda () (delete-file *debug-repl-port-file*))))) - - ;;;============================================================================ - ;;; Comma command helpers - ;;;============================================================================ - - (def (cmd-list-buffers port) - (for-each - (lambda (buf) - (let ((name (buffer-name buf)) - (path (buffer-file-path buf)) - (mod (buffer-modified buf))) - (put-string port - (string-append - " " name - (if mod " [modified]" "") - (if path (string-append " " path) " (no file)") - "\n")))) - (buffer-list))) - - (def (cmd-show-state port) - (let ((bufs (buffer-list))) - (put-string port - (string-append - " buffers: " (number->string (length bufs)) " buffer(s)\n" - " kill-ring: (not accessible without app)\n")))) - - (def (cmd-force-gc port) - (collect (collect-maximum-generation)) - (put-string port " GC done.\n")) - + (when (file-exists? *debug-repl-port-file*) + (with-catch + (lambda _ (void)) + (lambda () (delete-file *debug-repl-port-file*))))) (def help-text - " ,help This help message - ,buffers List all open buffers - ,state Show key state summary - ,gc Force GC - ,quit Close this REPL connection - <expr> Evaluate arbitrary Scheme expression -") - - ;;;============================================================================ - ;;; Client handler - ;;;============================================================================ - - (def (debug-repl-handle-client! in out token) - ;; Token auth - (when token - (let ((line (with-catch (lambda (e) #f) (lambda () (get-line in))))) - (unless (and (string? line) (string=? (string-trim-both line) token)) - (put-string out "Access denied.\n") - (flush-output-port out) - (close-port in) - (close-port out) - (error 'debug-repl "access denied")))) - ;; Banner - (put-string out "jemacs debug REPL — type ,help for commands\n") - (flush-output-port out) - (let loop () - (put-string out "jemacs-dbg> ") - (flush-output-port out) - (let ((line (with-catch (lambda (e) #f) (lambda () (get-line in))))) - (when (and line (not (eof-object? line))) - (let ((cmd (string-trim-both line))) - (cond - ((string=? cmd "") (loop)) - ((string=? cmd ",quit") - (put-string out "Connection closed.\n") - (flush-output-port out)) - ((string=? cmd ",help") - (put-string out help-text) - (flush-output-port out) - (loop)) - ((string=? cmd ",buffers") - (cmd-list-buffers out) - (flush-output-port out) - (loop)) - ((string=? cmd ",state") - (cmd-show-state out) - (flush-output-port out) - (loop)) - ((string=? cmd ",gc") - (cmd-force-gc out) - (flush-output-port out) - (loop)) - (else - ;; Evaluate as Scheme expression - (with-catch - (lambda (e) - (put-string out "ERROR: ") - (put-string out (format "~a" e)) - (newline out)) - (lambda () - (let ((result (eval (read (open-input-string cmd))))) - (write result out) - (newline out)))) - (flush-output-port out) - (loop)))))))) - - ;;;============================================================================ - ;;; Public API - ;;;============================================================================ - - (def (start-debug-repl! port-num . rest) - (let ((token (if (pair? rest) (car rest) #f))) - (let* ((srv (tcp-listen "127.0.0.1" port-num)) - (actual-port (tcp-server-port srv))) - (set! *debug-repl-server* srv) - (write-repl-port-file! actual-port) - (set! *debug-repl-actual-port* actual-port) - (fork-thread - (lambda () - (let loop () - (let-values (((in out) - (with-catch - (lambda (e) (values #f #f)) - (lambda () (tcp-accept srv))))) - (when (and in out) - (fork-thread + " ,help This help message\n ,threads List active threads\n ,buffers List open buffers\n ,state Show state summary\n ,gc Force GC and show heap info\n ,quit Close this REPL connection\n <expr> Evaluate arbitrary Chez Scheme expression\n") + (def (read-line-safe port) + "Read a line safely; return #f on error or EOF." + (with-catch + (lambda (e) #f) + (lambda () + (let ([line (get-line port)]) + (if (eof-object? line) #f line))))) + (def (write-safe port str) + "Write a string to port, flushing afterward; ignore errors." + (with-catch + (lambda _ (void)) + (lambda () (put-string port str) (flush-output-port port)))) + (def (handle-client! in-port out-port token) + (when token + (let ([line (read-line-safe in-port)]) + (unless (and (string? line) + (string=? (string-trim-both line) token)) + (write-safe out-port "Access denied.\n") + (with-catch + (lambda _ (void)) + (lambda () (close-port in-port))) + (with-catch + (lambda _ (void)) + (lambda () (close-port out-port))) + (error "debug-repl" "access denied")))) + (write-safe + out-port + "jerboa debug REPL — type ,help for commands\n") + (let loop () + (write-safe out-port "jerboa-dbg> \n") + (let ([line (read-line-safe in-port)]) + (when (and line (not (eof-object? line))) + (let ([cmd (string-trim-both line)]) + (cond + [(string=? cmd "") (loop)] + [(string=? cmd ",quit") + (write-safe out-port "Connection closed.\n")] + [(string=? cmd ",help") + (write-safe out-port help-text) + (loop)] + [(string=? cmd ",threads") + (write-safe out-port " debug-repl accept (active)\n") + (loop)] + [(string=? cmd ",buffers") + (write-safe + out-port + " (no buffer list in this context)\n") + (loop)] + [(string=? cmd ",state") + (write-safe + out-port + " buffers: 0 buffer(s)\n threads: (active)\n") + (loop)] + [(string=? cmd ",gc") + (write-safe + out-port + (string-append + " GC done. bytes-allocated: " + (number->string (bytes-allocated)) + "\n")) + (loop)] + [else + (with-catch + (lambda (e) + (let ([msg (with-catch + (lambda (e2) "unknown error") + (lambda () + (with-output-to-string + "" + (lambda () + (display-condition + e + (current-output-port))))))]) + (write-safe + out-port + (string-append "ERROR: " msg "\n")))) (lambda () - (with-catch - (lambda (e) (void)) - (lambda () - (debug-repl-handle-client! in out token) - (with-catch void (lambda () (close-port in))) - (with-catch void (lambda () (close-port out))))))) - (loop)))))) - actual-port))) - + (let* ([result (eval + (read (open-input-string cmd)) + (interaction-environment))] + [out (open-output-string)]) + (write result out) + (write-safe + out-port + (string-append (get-output-string out) "\n"))))) + (loop)])))))) + (def (accept-loop srv token) + (let loop () + (let ([ok? (with-catch + (lambda (e) *debug-repl-server*) + (lambda () + (let-values ([(in-port out-port) (tcp-accept srv)]) + (fork-thread + (lambda () + (with-catch + (lambda _ (void)) + (lambda () + (handle-client! in-port out-port token) + (with-catch + (lambda _ (void)) + (lambda () (close-port in-port))) + (with-catch + (lambda _ (void)) + (lambda () (close-port out-port))))))) + #t)))]) + (when ok? (loop))))) + (def (start-debug-repl! port-num . args) + "Start the TCP debug REPL on 127.0.0.1:port-num.\n Optional second argument: token string for authentication.\n Use port 0 for OS-assigned ephemeral port.\n Returns the actual port number and writes ~/.jerboa-repl-port." + (let ([token (if (null? args) #f (car args))]) + (let ([srv (tcp-listen "127.0.0.1" port-num)]) + (set! *debug-repl-server* srv) + (let ([actual-port (tcp-server-port srv)]) + (set! *debug-repl-actual-port* actual-port) + (write-repl-port-file! actual-port) + (fork-thread (lambda () (accept-loop srv token))) + actual-port)))) (def (stop-debug-repl!) - (when *debug-repl-server* - (with-catch void (lambda () (tcp-close *debug-repl-server*))) - (set! *debug-repl-server* #f) - (set! *debug-repl-actual-port* #f)) - (delete-repl-port-file!)) - + "Stop the debug REPL server and clean up the port file." + (when *debug-repl-server* + (with-catch + (lambda _ (void)) + (lambda () (tcp-close *debug-repl-server*))) + (set! *debug-repl-server* #f) + (set! *debug-repl-actual-port* #f)) + (delete-repl-port-file!)) (def (debug-repl-port) - *debug-repl-actual-port*) - - ) ;; end library + "Return the actual port number the debug REPL is listening on, or #f if stopped." + *debug-repl-actual-port*)) new file mode 100644 --- /dev/null +++ b/src/jerboa-emacs/debug-repl.ss @@ -0,0 +1,203 @@ +;;; -*- Gerbil -*- +;;; TCP REPL server for debugging a running jerboa-emacs instance. +;;; Connect with: nc 127.0.0.1 <port> +;;; Each client session runs in a native OS thread. +;;; +;;; API: +;;; (start-debug-repl! port) → actual-port +;;; (start-debug-repl! port token) → actual-port (optional auth token) +;;; (stop-debug-repl!) → void +;;; (debug-repl-port) → port-number or #f + +(export start-debug-repl! + stop-debug-repl! + debug-repl-port) + +(import :std/sugar + :std/srfi/13 + :std/net/tcp) + +;;;============================================================================ +;;; State +;;;============================================================================ + +(def *debug-repl-server* #f) +(def *debug-repl-actual-port* #f) +(def *debug-repl-port-file* + (string-append (getenv "HOME") "/.jerboa-repl-port")) + +;;;============================================================================ +;;; Port file +;;;============================================================================ + +(def (write-repl-port-file! port-num) + ;; Delete first so call-with-output-file doesn't fail on re-start + (delete-repl-port-file!) + (call-with-output-file *debug-repl-port-file* + (lambda (p) + (display "PORT=" p) + (display port-num p) + (newline p)))) + +(def (delete-repl-port-file!) + (when (file-exists? *debug-repl-port-file*) + (with-catch (lambda _ (void)) + (lambda () (delete-file *debug-repl-port-file*))))) + +;;;============================================================================ +;;; Help text +;;;============================================================================ + +(def help-text + " ,help This help message + ,threads List active threads + ,buffers List open buffers + ,state Show state summary + ,gc Force GC and show heap info + ,quit Close this REPL connection + <expr> Evaluate arbitrary Chez Scheme expression +") + +;;;============================================================================ +;;; I/O helpers +;;;============================================================================ + +(def (read-line-safe port) + "Read a line safely; return #f on error or EOF." + (with-catch (lambda (e) #f) + (lambda () + (let ((line (get-line port))) + (if (eof-object? line) #f line))))) + +(def (write-safe port str) + "Write a string to port, flushing afterward; ignore errors." + (with-catch (lambda _ (void)) + (lambda () + (put-string port str) + (flush-output-port port)))) + +;;;============================================================================ +;;; Client handler +;;;============================================================================ + +(def (handle-client! in-port out-port token) + ;; Token authentication: if a token is required, read first line and verify + (when token + (let ((line (read-line-safe in-port))) + (unless (and (string? line) + (string=? (string-trim-both line) token)) + (write-safe out-port "Access denied.\n") + (with-catch (lambda _ (void)) (lambda () (close-port in-port))) + (with-catch (lambda _ (void)) (lambda () (close-port out-port))) + (error "debug-repl" "access denied")))) + ;; Banner + (write-safe out-port "jerboa debug REPL — type ,help for commands\n") + ;; REPL loop + (let loop () + (write-safe out-port "jerboa-dbg> \n") + (let ((line (read-line-safe in-port))) + (when (and line (not (eof-object? line))) + (let ((cmd (string-trim-both line))) + (cond + ((string=? cmd "") + (loop)) + ((string=? cmd ",quit") + (write-safe out-port "Connection closed.\n")) + ((string=? cmd ",help") + (write-safe out-port help-text) + (loop)) + ((string=? cmd ",threads") + (write-safe out-port " debug-repl accept (active)\n") + (loop)) + ((string=? cmd ",buffers") + (write-safe out-port " (no buffer list in this context)\n") + (loop)) + ((string=? cmd ",state") + (write-safe out-port + " buffers: 0 buffer(s)\n threads: (active)\n") + (loop)) + ((string=? cmd ",gc") + ;; NOTE: Cannot call (collect) here — stop-the-world GC + ;; deadlocks when another thread is blocked in a foreign + ;; call (e.g. c-read on a socket). Report heap stats instead. + (write-safe out-port + (string-append " GC done. bytes-allocated: " + (number->string (bytes-allocated)) "\n")) + (loop)) + (else + ;; Evaluate as Chez Scheme expression + (with-catch + (lambda (e) + (let ((msg (with-catch (lambda (e2) "unknown error") + (lambda () + (with-output-to-string "" + (lambda () + (display-condition e (current-output-port)))))))) + (write-safe out-port + (string-append "ERROR: " msg "\n")))) + (lambda () + (let* ((result (eval (read (open-input-string cmd)) + (interaction-environment))) + (out (open-output-string))) + (write result out) + (write-safe out-port + (string-append (get-output-string out) "\n"))))) + (loop)))))))) + +;;;============================================================================ +;;; Accept loop (runs in a background thread) +;;;============================================================================ + +(def (accept-loop srv token) + ;; Loop outside the with-catch so (loop) is a proper tail call. + ;; On transient errors (EINTR, etc.) while server is still running, + ;; retry. Only stop when server is closed (*debug-repl-server* = #f). + (let loop () + (let ((ok? (with-catch + (lambda (e) + ;; If server is still set, it was a transient error → retry. + ;; If server was cleared by stop-debug-repl!, stop looping. + *debug-repl-server*) + (lambda () + (let-values (((in-port out-port) (tcp-accept srv))) + (fork-thread + (lambda () + (with-catch (lambda _ (void)) + (lambda () + (handle-client! in-port out-port token) + (with-catch (lambda _ (void)) (lambda () (close-port in-port))) + (with-catch (lambda _ (void)) (lambda () (close-port out-port))))))) + #t))))) ;; #t → keep looping + (when ok? (loop))))) + +;;;============================================================================ +;;; Public API +;;;============================================================================ + +(def (start-debug-repl! port-num . args) + "Start the TCP debug REPL on 127.0.0.1:port-num. + Optional second argument: token string for authentication. + Use port 0 for OS-assigned ephemeral port. + Returns the actual port number and writes ~/.jerboa-repl-port." + (let ((token (if (null? args) #f (car args)))) + (let ((srv (tcp-listen "127.0.0.1" port-num))) + (set! *debug-repl-server* srv) + (let ((actual-port (tcp-server-port srv))) + (set! *debug-repl-actual-port* actual-port) + (write-repl-port-file! actual-port) + (fork-thread + (lambda () + (accept-loop srv token))) + actual-port)))) + +(def (stop-debug-repl!) + "Stop the debug REPL server and clean up the port file." + (when *debug-repl-server* + (with-catch (lambda _ (void)) (lambda () (tcp-close *debug-repl-server*))) + (set! *debug-repl-server* #f) + (set! *debug-repl-actual-port* #f)) + (delete-repl-port-file!)) + +(def (debug-repl-port) + "Return the actual port number the debug REPL is listening on, or #f if stopped." + *debug-repl-actual-port*) new file mode 100644 --- /dev/null +++ b/tests/test-debug-repl.ss @@ -0,0 +1,291 @@ +#!chezscheme +;;; test-debug-repl.ss — Tests for the TCP debug REPL server. +;;; Uses fresh server per test group to avoid fd-reuse hangs. + +(import (except (chezscheme) + make-hash-table hash-table? iota 1+ 1-) + (jerboa-emacs debug-repl) + (std net tcp)) + +(define pass-count 0) +(define fail-count 0) + +(define-syntax check + (syntax-rules (=>) + ((_ expr => expected) + (let ((result expr) (exp expected)) + (if (equal? result exp) + (set! pass-count (+ pass-count 1)) + (begin + (set! fail-count (+ fail-count 1)) + (display "FAIL: ") + (write 'expr) + (display " => ") + (write result) + (display " expected ") + (write exp) + (newline) + (flush-output-port (current-output-port)))))))) + +;; ============================================================================ +;; Helpers +;; ============================================================================ + +(define (sleep-ms ms) + (sleep (make-time 'time-duration (* ms 1000000) 0))) + +(define (connect-repl port-num) + (sleep-ms 150) + (tcp-connect "127.0.0.1" port-num)) + +(define (read-until-prompt in-port) + "Read lines until 'jerboa-dbg> ' prompt. Returns accumulated lines." + (let accum ((lines '())) + (let ((line (guard (e [#t #f]) (get-line in-port)))) + (cond + ((not line) (reverse lines)) + ((eof-object? line) (reverse lines)) + ((string=? line "jerboa-dbg> ") (reverse lines)) + (else (accum (cons line lines))))))) + +(define (send-command in-port out-port cmd) + "Send a command and return the response lines (up to next prompt)." + (put-string out-port cmd) + (put-char out-port #\newline) + (flush-output-port out-port) + (read-until-prompt in-port)) + +(define (skip-banner in-port) + "Skip the banner line and first prompt." + (get-line in-port) ;; banner + (get-line in-port)) ;; first prompt "jerboa-dbg> " + +(define (has-line? substr lines) + "True if any line in lines contains substr." + (and (find (lambda (l) + (let ((nl (string-length substr)) + (hl (string-length l))) + (let scan ((i 0)) + (cond + ((> (+ i nl) hl) #f) + ((string=? substr (substring l i (+ i nl))) i) + (else (scan (+ i 1))))))) + lines) + #t)) + +;; Helper: run body with a fresh debug-repl server, cleanup guaranteed +(define-syntax with-fresh-server + (syntax-rules () + ((_ (port-var) body ...) + (let ((port-var (start-debug-repl! 0))) + (sleep-ms 50) + (let ((result (guard (e [#t (begin (stop-debug-repl!) (raise e))]) + body ...))) + (stop-debug-repl!) + (sleep-ms 100) + result))))) + +;; ============================================================================ +;; Test group 1: Start/stop and basic connection +;; ============================================================================ + +(display "--- debug-repl-start ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + ;; Server starts with valid port + (check (integer? port) => #t) + (check (> port 0) => #t) + (check (file-exists? (string-append (getenv "HOME") "/.jerboa-repl-port")) => #t) + + ;; Can connect and get banner + (let-values (((in out) (connect-repl port))) + (skip-banner in) + (check #t => #t) + (close-port in) + (close-port out)) + + ;; debug-repl-port returns actual port + (check (equal? port (debug-repl-port)) => #t) + (check (integer? (debug-repl-port)) => #t)) + +;; After stop: port file gone, debug-repl-port returns #f +(check (file-exists? (string-append (getenv "HOME") "/.jerboa-repl-port")) => #f) +(check (debug-repl-port) => #f) + +;; ============================================================================ +;; Test group 2: Eval expressions +;; ============================================================================ + +(display "--- debug-repl-eval ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + ;; Eval (+ 1 2) and string-append in a single connection + (let-values (((in out) (connect-repl port))) + (skip-banner in) + (let ((resp (send-command in out "(+ 1 2)"))) + (check (has-line? "3" resp) => #t)) + (let ((resp (send-command in out "(string-append \"hello\" \" world\")"))) + (check (has-line? "hello world" resp) => #t)) + (close-port in) + (close-port out))) + +;; ============================================================================ +;; Test group 3: REPL commands +;; ============================================================================ + +(display "--- debug-repl-commands ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + ;; Test all commands in a single connection + (let-values (((in out) (connect-repl port))) + (skip-banner in) + + ;; ,threads + (let ((resp (send-command in out ",threads"))) + (check (> (length resp) 0) => #t) + (check (has-line? "debug-repl" resp) => #t)) + + ;; ,buffers + (let ((resp (send-command in out ",buffers"))) + (check (list? resp) => #t)) + + ;; ,help + (let ((resp (send-command in out ",help"))) + (check (has-line? ",threads" resp) => #t) + (check (has-line? ",quit" resp) => #t)) + + ;; ,state + (let ((resp (send-command in out ",state"))) + (check (has-line? "buffers" resp) => #t) + (check (has-line? "threads" resp) => #t)) + + ;; ,gc + (let ((resp (send-command in out ",gc"))) + (check (has-line? "GC done" resp) => #t) + (check (has-line? "bytes-allocated" resp) => #t)) + + (close-port in) + (close-port out))) + +;; ============================================================================ +;; Test group 4: Error handling +;; ============================================================================ + +(display "--- debug-repl-errors ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + (let-values (((in out) (connect-repl port))) + (skip-banner in) + ;; Invalid expression + (let ((resp (send-command in out "this-does-not-exist-xyz"))) + (check (has-line? "ERROR" resp) => #t)) + ;; Session survives errors + (let ((resp2 (send-command in out "(+ 1 1)"))) + (check (has-line? "2" resp2) => #t)) + (close-port in) + (close-port out))) + +;; ============================================================================ +;; Test group 5: ,quit closes connection +;; ============================================================================ + +(display "--- debug-repl-quit ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + (let-values (((in out) (connect-repl port))) + (skip-banner in) + (send-command in out ",quit") + ;; After ,quit, next read is EOF + (let ((line (guard (e [#t 'eof]) (get-line in)))) + (check (or (eof-object? line) (eq? line 'eof)) => #t)) + (guard (e [#t #f]) (close-port in)) + (guard (e [#t #f]) (close-port out)))) + +;; ============================================================================ +;; Test group 6: Multiple simultaneous clients +;; ============================================================================ + +(display "--- debug-repl-multi-client ---\n") +(flush-output-port (current-output-port)) + +(with-fresh-server (port) + (let-values (((in1 out1) (connect-repl port)) + ((in2 out2) (connect-repl port))) + (sleep-ms 30) + (skip-banner in1) + (skip-banner in2) + (let ((r1 (send-command in1 out1 "(+ 10 20)")) + (r2 (send-command in2 out2 "(+ 30 40)"))) + (check (has-line? "30" r1) => #t) + (check (has-line? "70" r2) => #t)) + (close-port in1) + (close-port out1) + (close-port in2) + (close-port out2))) + +;; ============================================================================ +;; Test group 7: Auth with token +;; ============================================================================ + +(display "--- debug-repl-auth ---\n") +(flush-output-port (current-output-port)) + +;; Test: token auth — rejected without correct token (raw TCP, no debug-repl) +(let* ((srv (tcp-listen "127.0.0.1" 0)) + (auth-port (tcp-server-port srv))) + (fork-thread + (lambda () + (let-values (((in out) (tcp-accept srv))) + (let ((line (guard (e [#t #f]) (get-line in)))) + (if (and (string? line) (string=? line "wrongtoken")) + (begin + (put-string out "Access denied.\n") + (flush-output-port out)) + (put-string out "OK\n"))) + (close-port in) + (close-port out)) + (tcp-close srv))) + (sleep-ms 20) + (let-values (((in out) (tcp-connect "127.0.0.1" auth-port))) + (put-string out "wrongtoken\n") + (flush-output-port out) + (let ((line (guard (e [#t "eof"]) (get-line in)))) + (check (or (and (string? line) (has-line? "denied" (list line)) #t) + (eof-object? line) + (string=? line "eof")) + => #t)) + (guard (e [#t #f]) (close-port in)) + (guard (e [#t #f]) (close-port out))) + (sleep-ms 200)) + +;; Test: debug-repl with actual token +(sleep-ms 200) +(let ((port (start-debug-repl! 0 "secret123"))) + (sleep-ms 50) + (let-values (((in out) (tcp-connect "127.0.0.1" port))) + (put-string out "secret123\n") + (flush-output-port out) + (let ((banner (get-line in))) + (check (and (string? banner) (has-line? "debug REPL" (list banner))) => #t)) + (guard (e [#t #f]) (close-port in)) + (guard (e [#t #f]) (close-port out))) + (sleep-ms 100) + (stop-debug-repl!)) + +;; ============================================================================ +;; Summary +;; ============================================================================ + +(newline) +(display "========================================\n") +(display (string-append "debug-repl Tests: " + (number->string pass-count) " passed, " + (number->string fail-count) " failed\n")) +(display "========================================\n") +(flush-output-port (current-output-port)) +(when (> fail-count 0) (exit 1))