Expand test-behavioral.ss to ~85 tests across 10 phases
ober
6f155b5fd12ea8db68767c5292ae732d1ca9dd7b
--- a/lib/jerboa-emacs/qt/app.sls +++ b/lib/jerboa-emacs/qt/app.sls @@ -2535,7 +2535,18 @@ (lambda () (qt-terminal-destroy! term))) (hash-remove! *terminal-widget-map* buf)))) term-bufs)) - 'ok)))))) + 'ok)) + (cons + 'test-clear-buffer! + (lambda () + (let* ([fr (app-state-frame app)] + [ed (qt-current-editor fr)]) + (when ed (qt-plain-text-edit-set-text! ed "")) + 'ok))) + (cons + 'test-window-idx + (lambda () + (qt-frame-current-idx (app-state-frame app)))))))) (schedule-periodic! 'treesitter-reparse 150 --- a/src/jerboa-emacs/qt/app.ss +++ b/src/jerboa-emacs/qt/app.ss @@ -1935,7 +1935,18 @@ (lambda () (qt-terminal-destroy! term))) (hash-remove! *terminal-widget-map* buf)))) term-bufs)) - 'ok)))))) + 'ok)) + ;; Set current editor text directly (bypasses undo — for test isolation) + (cons 'test-clear-buffer! + (lambda () + (let* ((fr (app-state-frame app)) + (ed (qt-current-editor fr))) + (when ed (qt-plain-text-edit-set-text! ed "")) + 'ok))) + ;; Current window index (0-based, matches test-window-buffers/texts order) + (cons 'test-window-idx + (lambda () + (qt-frame-current-idx (app-state-frame app)))))))) ;; Tree-sitter debounced re-highlight — re-parse when buffer content changes. ;; Tracks last-known text length per buffer to detect modifications. (schedule-periodic! 'treesitter-reparse 150 --- a/tests/test-behavioral.ss +++ b/tests/test-behavioral.ss @@ -1,26 +1,23 @@ ;;; -*- Gerbil -*- -;;; Deterministic behavioral regression suite for jemacs-qt. +;;; tests/test-behavioral.ss — comprehensive behavioral regression suite ;;; -;;; Connects to a running jemacs-qt REPL and runs named test cases that -;;; verify editor behavior (typing, window splitting, terminal focus, etc.) -;;; deterministically — unlike the stress test which drives random operations. +;;; Simulates hours of real Emacs usage: editing, navigation, kill ring, window +;;; management, terminal integration, undo/redo, multi-buffer sessions, prefix +;;; key robustness, and stress/durability patterns. ;;; -;;; Designed to catch regressions like: -;;; - C-x 2 typing into terminal instead of splitting -;;; - Typing after split going to wrong window -;;; - Key prefix state leaking between operations +;;; Each test group mirrors a class of activity a real user would perform. +;;; Tests are deterministic (no randomness), isolated (full reset between tests), +;;; and headless (Xvfb — does not interrupt interactive use). ;;; ;;; Usage: -;;; make test-behavioral (headless, auto-launches editor) -;;; scheme --libdirs lib:... --script tests/test-behavioral.ss --port 9999 -;;; -;;; Requires a running jemacs-qt with --repl <port>. -;;; Port is auto-detected from ~/.jerboa-repl-port if not given. +;;; make test-behavioral (auto-launches jemacs-qt headless) +;;; scheme --libdirs lib:... --script tests/test-behavioral.ss --port N +;;; scheme --libdirs lib:... --script tests/test-behavioral.ss --port N --verbose (import (jerboa prelude)) ;;;============================================================================ -;;; Compat: thread-sleep! (same trick as stress-test.ss) +;;; Compat: thread-sleep! ;;;============================================================================ (def chez:make-time-for-sleep @@ -38,12 +35,31 @@ (def *repl-port* #f) (def *verbose* #f) -(def *pass-count* 0) -(def *fail-count* 0) -(def *current-test* "#<none>") ;;;============================================================================ -;;; TCP / REPL connection (same s-expression protocol as stress-test.ss) +;;; Test counters +;;;============================================================================ + +(def *total-pass* 0) +(def *total-fail* 0) +(def *phase-name* "") +(def *phase-pass* 0) +(def *phase-fail* 0) + +(def (start-phase! name) + (set! *phase-name* name) + (set! *phase-pass* 0) + (set! *phase-fail* 0) + (displayln "") + (displayln "=== " name " ===")) + +(def (end-phase!) + (set! *total-pass* (+ *total-pass* *phase-pass*)) + (set! *total-fail* (+ *total-fail* *phase-fail*)) + (displayln " -> " *phase-pass* " pass, " *phase-fail* " fail")) + +;;;============================================================================ +;;; REPL connection (s-expression protocol, same as stress-test.ss) ;;;============================================================================ (def *nc-stdin* #f) @@ -58,27 +74,21 @@ (def (read-repl-port-file) (let ((path (str (getenv "HOME") "/.jerboa-repl-port"))) (if (file-exists? path) - (with-catch - (lambda (e) #f) + (with-catch (lambda (e) #f) (lambda () (let ((content (read-file-string path))) (let ((idx (string-contains content "="))) - (and idx - (string->number - (string-trim - (substring content (+ idx 1) - (string-length content))))))))) + (and idx (string->number (string-trim + (substring content (+ idx 1) (string-length content))))))))) #f))) (def (connect! port) (let-values (((stdin stdout stderr pid) - (open-process-ports - (str "nc 127.0.0.1 " port) - 'block (native-transcoder)))) + (open-process-ports (str "nc 127.0.0.1 " port) + 'block (native-transcoder)))) (set! *nc-stdin* stdin) (set! *nc-stdout* stdout) (set! *nc-stderr* stderr)) - ;; Wait for REPL banner + "jerboa> " prompt then drain (thread-sleep! 0.4) (drain-input!)) @@ -93,376 +103,1312 @@ (set! *nc-stderr* #f)) (def (drain-input!) - (with-catch - (lambda (e) #f) + (with-catch (lambda (e) #f) (lambda () - (let loop ((count 0)) - (when (and (< count 8192) (char-ready? *nc-stdout*)) + (let loop ((n 0)) + (when (and (< n 8192) (char-ready? *nc-stdout*)) (read-char *nc-stdout*) - (loop (+ count 1))))))) - -;;;============================================================================ -;;; REPL communication (s-expression protocol) -;;;============================================================================ + (loop (+ n 1))))))) (def (send-eval! expr-str) - (when *verbose* (displayln "SEND: " expr-str)) + (when *verbose* (displayln " > " expr-str)) (let ((id (next-req-id!)) - (expr-literal (with-output-to-string (lambda () (write expr-str))))) - (display (str "(" id " eval " expr-literal ")") *nc-stdin*) + (lit (with-output-to-string (lambda () (write expr-str))))) + (display (str "(" id " eval " lit ")") *nc-stdin*) (newline *nc-stdin*) (flush-output-port *nc-stdin*) - (read-sexpr-response!))) + (let ((resp (read-sexpr-response!))) + (when *verbose* (displayln " < " resp)) + resp))) (def (read-sexpr-response!) - ;; Wait up to 8 seconds (80 × 100ms) - (let wait-loop ((waited 0)) + (let wait ((n 0)) (cond ((char-ready? *nc-stdout*) (let ((line (get-line *nc-stdout*))) (if (eof-object? line) - (begin - (displayln "BEHAVIORAL: connection lost to jemacs-qt!") - (disconnect!) - (exit 1)) + (begin (displayln "CONNECTION LOST") (disconnect!) (exit 1)) line))) - ((> waited 80) - (displayln "BEHAVIORAL: timeout waiting for REPL response") - "") - (else - (thread-sleep! 0.1) - (wait-loop (+ waited 1)))))) - -(def (jeval! expr-str) - "Evaluate EXPR-STR in the editor REPL. Returns parsed result value or #f on error." - (let ((raw (send-eval! expr-str))) - (when *verbose* (displayln "RECV: " raw)) - (with-catch - (lambda (e) #f) - (lambda () - (let* ((sexp (with-input-from-string raw read)) - ;; Response shape: (N :ok (:value "VAL" :stdout "OUT")) - ;; or (N :error "MSG") - (status (and (pair? sexp) (list-ref sexp 1)))) - (cond - ((eq? status ':ok) - (let* ((payload (list-ref sexp 2)) - (val-str (and (pair? payload) (list-ref payload 1)))) - ;; val-str is a string representation of the result - val-str)) - ((eq? status ':error) - (when *verbose* - (displayln "JEVAL ERROR: " (list-ref sexp 2))) - #f) - (else #f))))))) - -(def (jeval-bool! expr-str) - "Evaluate expr in editor, return #t if result is '#t' string." - (string=? "#t" (or (jeval! expr-str) ""))) - -(def (jeval-number! expr-str) - "Evaluate expr in editor, return result as number or #f." - (let ((r (jeval! expr-str))) - (and r (string->number r)))) - -(def (jeval-string! expr-str) - "Evaluate expr in editor, return result with outer quotes stripped, or empty string." - (let ((r (jeval! expr-str))) - (if (and r (> (string-length r) 1) - (char=? (string-ref r 0) #\")) - ;; Strip surrounding quotes (this is the printed representation) + ((> n 100) (displayln "TIMEOUT") "") + (else (thread-sleep! 0.1) (wait (+ n 1)))))) + +;;;============================================================================ +;;; REPL helpers +;;;============================================================================ + +(def (jeval! expr) + "Evaluate EXPR in jemacs REPL. Returns raw :value string or #f on error." + (with-catch (lambda (e) #f) + (lambda () + (let* ((raw (send-eval! expr)) + (sexp (with-input-from-string raw read)) + (status (list-ref sexp 1))) + (if (eq? status ':ok) + (list-ref (list-ref sexp 2) 1) + (begin + (when *verbose* + (displayln " JEVAL-ERR: " (list-ref sexp 2))) + #f)))))) + +(def (jeval-bool! e) (string=? "#t" (or (jeval! e) ""))) +(def (jeval-num! e) (let ((r (jeval! e))) (and r (string->number r)))) +(def (jeval-str! e) + (let ((r (jeval! e))) + (if (and r (>= (string-length r) 2) (char=? #\" (string-ref r 0))) (substring r 1 (- (string-length r) 1)) (or r "")))) +(def (jeval-list! e) + (let ((r (jeval! e))) + (if r + (with-catch (lambda (_) '()) + (lambda () (with-input-from-string r read))) + '()))) ;;;============================================================================ ;;; Test framework ;;;============================================================================ -(def (test-pass! name) - (set! *pass-count* (+ *pass-count* 1)) - (displayln " PASS: " name)) +(def (write-to-string v) + (with-output-to-string (lambda () (write v)))) + +(def (run-test! name thunk) + (display (str " [" name "] ")) + (with-catch + (lambda (e) + (set! *phase-fail* (+ *phase-fail* 1)) + (displayln "FAIL: " + (with-output-to-string (lambda () (display-exception e))))) + (lambda () + (thunk) + (set! *phase-pass* (+ *phase-pass* 1)) + (displayln "pass")))) + +;; Assertions: signal error (caught by run-test!) on failure +(defrule (assert! pred msg) + (unless pred (error 'assert! msg))) + +(defrule (assert-eq! msg a b) + (let ((av a) (bv b)) + (unless (equal? av bv) + (error 'assert-eq! (str msg ": expected " (write-to-string av) " got " (write-to-string bv)))))) + +(defrule (assert-ne! msg a b) + (let ((av a) (bv b)) + (when (equal? av bv) + (error 'assert-ne! (str msg ": unexpectedly equal " (write-to-string av)))))) + +(defrule (assert-gt! msg lo actual) + (let ((l lo) (a actual)) + (unless (and a (> a l)) + (error 'assert-gt! (str msg ": expected > " l " got " (write-to-string a)))))) + +(defrule (assert-ge! msg lo actual) + (let ((l lo) (a actual)) + (unless (and a (>= a l)) + (error 'assert-ge! (str msg ": expected >= " l " got " (write-to-string a)))))) + +(defrule (assert-has! msg text sub) + (let ((t text) (s sub)) + (unless (and (string? t) (string? s) (string-contains t s)) + (error 'assert-has! (str msg ": " (write-to-string t) " does not contain " (write-to-string s)))))) + +(defrule (assert-lacks! msg text sub) + (let ((t text) (s sub)) + (when (and (string? t) (string? s) (string-contains t s)) + (error 'assert-lacks! (str msg ": " (write-to-string t) " unexpectedly contains " (write-to-string s)))))) + +;;;============================================================================ +;;; Editor helpers +;;;============================================================================ + +(def (send-keys! . keys) + "Send all KEYS in a single REPL call (batch)." + (let ((args (apply string-append (map (lambda (k) (str " " (write-to-string k))) keys)))) + (jeval! (str "(send-keys!" args ")")))) + +(def (repeat-keys! n . keys) + "Send KEYS repeated N times in a single REPL call." + (let* ((all (apply append (map (lambda (_) keys) (iota n)))) + (args (apply string-append (map (lambda (k) (str " " (write-to-string k))) all)))) + (jeval! (str "(send-keys!" args ")")))) + +(def (exec! cmd) (jeval! (str "(execute-command! *app* '" (symbol->string cmd) ")"))) +(def (wait! ms) (thread-sleep! (/ ms 1000.0))) + +(def (reset!) (jeval! "(test-reset!)") (wait! 50)) +(def (clear-buf!) (jeval! "(test-clear-buffer!)")) +(def (cur-text) (jeval-str! "(buffer-text)")) +(def (cur-buf-name) (jeval-str! "(current-buffer-name)")) +(def (cur-pos) (jeval-num! "(buffer-cursor-pos)")) +(def (win-count) (or (jeval-num! "(test-window-count)") 0)) +(def (win-idx) (or (jeval-num! "(test-window-idx)") 0)) +(def (win-texts) (jeval-list! "(test-window-texts)")) +(def (win-bufs) (jeval-list! "(test-window-buffers)")) +(def (prefix-active?) (jeval-bool! "(test-prefix-active?)")) +(def (term-running?) (jeval-bool! "(test-terminal-running?)")) + +(def (setup!) + "Full reset: collapse windows, clear terminals, switch to scratch, clear text." + (reset!) + (exec! 'scratch-buffer) + (wait! 30) + (clear-buf!)) + +(def (term-setup!) + "Reset then open a terminal and wait for shell to spawn." + (reset!) + (exec! 'scratch-buffer) + (exec! 'term) + (wait! 400)) + +;;;============================================================================ +;;; Phase 1 — Basic Text Editing +;;; Types text, edits characters, confirms buffer content. +;;;============================================================================ + +(def (run-phase-1!) + (start-phase! "Phase 1: Basic Text Editing") -(def (test-fail! name reason) - (set! *fail-count* (+ *fail-count* 1)) - (displayln " FAIL: " name " — " reason)) + (run-test! "type-single-char" + (lambda () + (setup!) + (send-keys! "Z") + (assert-has! "char appears" (cur-text) "Z"))) -(defrule (assert-true! msg expr) - (if expr - (test-pass! msg) - (test-fail! msg (str "expected true, got false")))) + (run-test! "type-word" + (lambda () + (setup!) + (send-keys! "hello") + (assert-has! "word appears" (cur-text) "hello"))) -(defrule (assert-false! msg expr) - (if (not expr) - (test-pass! msg) - (test-fail! msg (str "expected false, got true")))) + (run-test! "type-long-sentence" + (lambda () + (setup!) + (send-keys! "The quick brown fox jumps over the lazy dog") + (let ((t (cur-text))) + (assert-has! "sentence start" t "quick brown") + (assert-has! "sentence end" t "lazy dog")))) -(defrule (assert-eq! msg expected actual) - (let ((e expected) (a actual)) - (if (equal? e a) - (test-pass! msg) - (test-fail! msg (str "expected " e " got " a))))) + (run-test! "type-numbers" + (lambda () + (setup!) + (send-keys! "1234567890") + (assert-has! "numbers appear" (cur-text) "1234567890"))) -(defrule (assert-contains! msg haystack needle) - (let ((h haystack) (n needle)) - (if (and (string? h) (string? n) (string-contains h n)) - (test-pass! msg) - (test-fail! msg (str (write-to-string h) " does not contain " (write-to-string n)))))) + (run-test! "type-two-words-with-space" + (lambda () + (setup!) + (send-keys! "hello world") + (assert-has! "both words" (cur-text) "hello world"))) -(defrule (assert-not-contains! msg haystack needle) - (let ((h haystack) (n needle)) - (if (not (and (string? h) (string? n) (string-contains h n))) - (test-pass! msg) - (test-fail! msg (str (write-to-string h) " unexpectedly contains " (write-to-string n)))))) + (run-test! "backspace-removes-char" + (lambda () + (setup!) + (send-keys! "abcX") + (send-keys! "DEL") + (let ((t (cur-text))) + (assert-has! "prefix remains" t "abc") + (assert-lacks! "X removed" t "X")))) + + (run-test! "backspace-multiple" + (lambda () + (setup!) + (send-keys! "hello") + (send-keys! "DEL" "DEL" "DEL") + (let ((t (cur-text))) + (assert-has! "he remains" t "he") + (assert-lacks! "llo removed" t "llo")))) + + (run-test! "delete-char-at-start" + (lambda () + (setup!) + (send-keys! "Xhello") + (exec! 'beginning-of-buffer) + (exec! 'delete-char) + (let ((t (cur-text))) + (assert-has! "hello remains" t "hello") + (assert-lacks! "X removed" t "X")))) + + (run-test! "kill-line-clears-line" + (lambda () + (setup!) + (send-keys! "killedtext") + (exec! 'beginning-of-line) + (exec! 'kill-line) + (assert-lacks! "text removed" (cur-text) "killedtext"))) + + (run-test! "kill-line-yank-roundtrip" + (lambda () + (setup!) + (send-keys! "preserved") + (exec! 'beginning-of-line) + (exec! 'kill-line) + (exec! 'yank) + (assert-has! "text restored by yank" (cur-text) "preserved"))) + + (run-test! "type-newline-creates-two-lines" + (lambda () + (setup!) + (send-keys! "line1") + (send-keys! "RET") + (send-keys! "line2") + (let ((t (cur-text))) + (assert-has! "line1 present" t "line1") + (assert-has! "line2 present" t "line2")))) + + (run-test! "type-at-end-of-line" + (lambda () + (setup!) + (send-keys! "hello") + (exec! 'end-of-line) + (send-keys! "!") + (assert-has! "exclamation appended" (cur-text) "hello!"))) -(def (write-to-string val) - (with-output-to-string (lambda () (write val)))) + (run-test! "type-at-beginning-of-line" + (lambda () + (setup!) + (send-keys! "world") + (exec! 'beginning-of-line) + (send-keys! "hello ") + (assert-has! "hello prepended" (cur-text) "hello world"))) + + (run-test! "backspace-on-empty-no-crash" + (lambda () + (setup!) + (send-keys! "DEL" "DEL" "DEL" "DEL" "DEL") + #t)) ; just no crash + + (run-test! "large-insert-100-chars" + (lambda () + (setup!) + (send-keys! (make-string 100 #\A)) + (let ((t (cur-text))) + (assert-ge! "100 chars in buffer" 100 (string-length t)) + (assert-has! "A chars present" t "AAAAAAAAAA")))) + + (run-test! "type-after-kill-type-again" + (lambda () + (setup!) + (send-keys! "first") + (exec! 'beginning-of-line) + (exec! 'kill-line) + (send-keys! "second") + (let ((t (cur-text))) + (assert-has! "second present" t "second") + (assert-lacks! "first gone" t "first")))) + + (run-test! "kill-whole-line" + (lambda () + (setup!) + (send-keys! "deleteme") + (send-keys! "RET") + (send-keys! "keepme") + (exec! 'beginning-of-buffer) + (exec! 'kill-whole-line) + (let ((t (cur-text))) + (assert-lacks! "first line gone" t "deleteme") + (assert-has! "second line kept" t "keepme")))) + + (end-phase!)) ;;;============================================================================ -;;; Editor convenience wrappers +;;; Phase 2 — Navigation and Cursor Position +;;; Moves the cursor and verifies position changes. ;;;============================================================================ -(def (reset!) - "Reset the editor to a clean single-window state." - (jeval! "(test-reset!)") - (thread-sleep! 0.1)) +(def (run-phase-2!) + (start-phase! "Phase 2: Navigation and Cursor") -(def (send-keys! . keys) - "Send keys to the current editor window." - (for-each - (lambda (k) - (jeval! (str "(send-keys! " (write-to-string k) ")"))) - keys)) + (run-test! "forward-char-advances-cursor" + (lambda () + (setup!) + (send-keys! "abcde") + (exec! 'beginning-of-buffer) + (let ((pos-before (cur-pos))) + (exec! 'forward-char) + (let ((pos-after (cur-pos))) + (assert-gt! "cursor moved right" pos-before pos-after))))) + + (run-test! "backward-char-retreats-cursor" + (lambda () + (setup!) + (send-keys! "abcde") + (let ((pos-before (cur-pos))) + (exec! 'backward-char) + (let ((pos-after (cur-pos))) + (assert-gt! "cursor moved left" pos-after pos-before))))) + + (run-test! "beginning-of-line-goes-to-zero" + (lambda () + (setup!) + (send-keys! "hello") + (exec! 'beginning-of-line) + (assert-eq! "cursor at col 0" 0 (cur-pos)))) -(def (exec! cmd) - "Execute a named jemacs command." - (jeval! (str "(execute-command! *app* '" cmd ")"))) + (run-test! "end-of-line-goes-to-end" + (lambda () + (setup!) + (send-keys! "hello") + (exec! 'beginning-of-line) + (exec! 'end-of-line) + (assert-eq! "cursor at end" 5 (cur-pos)))) -(def (current-buffer-text) - "Get text of the currently focused editor window." - (jeval-string! "(buffer-text)")) + (run-test! "beginning-of-buffer-goes-to-start" + (lambda () + (setup!) + (send-keys! "line1") + (send-keys! "RET") + (send-keys! "line2") + (exec! 'beginning-of-buffer) + (assert-eq! "cursor at position 0" 0 (cur-pos)))) + + (run-test! "end-of-buffer-goes-to-end" + (lambda () + (setup!) + (send-keys! "hello") + (exec! 'beginning-of-buffer) + (exec! 'end-of-buffer) + (assert-ge! "cursor at or near end" 5 (cur-pos)))) -(def (current-buffer-name) - (jeval-string! "(current-buffer-name)")) + (run-test! "forward-word-jumps-word" + (lambda () + (setup!) + (send-keys! "foo bar") + (exec! 'beginning-of-buffer) + (let ((start-pos (cur-pos))) + (exec! 'forward-word) + (assert-gt! "cursor jumped past foo" start-pos (cur-pos))))) + + (run-test! "backward-word-jumps-word" + (lambda () + (setup!) + (send-keys! "foo bar") + (let ((end-pos (cur-pos))) + (exec! 'backward-word) + (assert-gt! "cursor jumped back" (cur-pos) end-pos)))) -(def (window-count) - (or (jeval-number! "(test-window-count)") 0)) + (run-test! "next-line-moves-down" + (lambda () + (setup!) + (send-keys! "aaa") + (send-keys! "RET") + (send-keys! "bbb") + (exec! 'beginning-of-buffer) + (exec! 'next-line) + (assert-gt! "cursor past first line" 3 (cur-pos)))) + + (run-test! "previous-line-moves-up" + (lambda () + (setup!) + (send-keys! "aaa") + (send-keys! "RET") + (send-keys! "bbb") + (let ((end-pos (cur-pos))) + (exec! 'previous-line) + (assert-gt! "cursor moved up" (cur-pos) end-pos)))) + + (run-test! "cursor-position-after-typing" + (lambda () + (setup!) + (send-keys! "hello") + (assert-eq! "cursor at 5 after typing 5 chars" 5 (cur-pos)))) -(def (window-buffers) - "Return list of buffer names across all windows." - (let ((r (jeval! "(test-window-buffers)"))) - (or (with-catch (lambda (e) '()) - (lambda () (with-input-from-string (or r "()") read))) - '()))) + (run-test! "forward-char-10-times" + (lambda () + (setup!) + (send-keys! "abcdefghij") + (exec! 'beginning-of-buffer) + (repeat-keys! 5 "C-f") + (assert-eq! "cursor at 5 after 5 C-f" 5 (cur-pos)))) -(def (window-texts) - "Return list of editor texts across all windows." - (let ((r (jeval! "(test-window-texts)"))) - (or (with-catch (lambda (e) '()) - (lambda () (with-input-from-string (or r "()") read))) - '()))) + (end-phase!)) -(def (prefix-active?) - (jeval-bool! "(test-prefix-active?)")) +;;;============================================================================ +;;; Phase 3 — Kill Ring and Clipboard +;;; Tests kill/yank operations and the kill ring. +;;;============================================================================ + +(def (run-phase-3!) + (start-phase! "Phase 3: Kill Ring") + + (run-test! "kill-line-yank-preserves-text" + (lambda () + (setup!) + (send-keys! "killring1") + (exec! 'beginning-of-line) + (exec! 'kill-line) + (exec! 'yank) + (assert-has! "text restored" (cur-text) "killring1"))) + + (run-test! "kill-word-yank" + (lambda () + (setup!) + (send-keys! "target rest") + (exec! 'beginning-of-buffer) + (exec! 'kill-word) + (let ((t (cur-text))) + (assert-lacks! "target gone" t "target")))) + + (run-test! "backward-kill-word" + (lambda () + (setup!) + (send-keys! "hello gone") + (exec! 'backward-kill-word) + (let ((t (cur-text))) + (assert-has! "hello remains" t "hello") + (assert-lacks! "gone removed" t "gone")))) + + (run-test! "select-all-kill-region" + (lambda () + (setup!) + (send-keys! "allgone") + (exec! 'select-all) + (exec! 'kill-region) + (assert-lacks! "all text gone" (cur-text) "allgone"))) -(def (terminal-running?) - (jeval-bool! "(test-terminal-running?)")) + (run-test! "copy-region-then-yank" + (lambda () + (setup!) + (send-keys! "copytext") + (exec! 'beginning-of-buffer) + (exec! 'set-mark-command) + (exec! 'end-of-buffer) + (exec! 'kill-ring-save) ; M-w equivalent + (exec! 'end-of-buffer) + (exec! 'yank) + (assert-has! "copied text yanked" (cur-text) "copytext"))) + + (run-test! "double-yank-duplicates" + (lambda () + (setup!) + (send-keys! "dupe") + (exec! 'beginning-of-line) + (exec! 'kill-line) + (exec! 'yank) + (exec! 'yank) + (assert-has! "dupe appears" (cur-text) "dupe"))) + + (run-test! "kill-ring-survives-buffer-switch" + (lambda () + (setup!) + (send-keys! "crossbuf") + (exec! 'beginning-of-line) + (exec! 'kill-line) + ;; Switch to a new buffer + (exec! 'new-empty-buffer) + (wait! 50) + (exec! 'yank) + (assert-has! "killed text in new buffer" (cur-text) "crossbuf"))) + + (run-test! "kill-sexp-removes-sexp" + (lambda () + (setup!) + (send-keys! "(remove-me) keep") + (exec! 'beginning-of-buffer) + (exec! 'kill-sexp) + (let ((t (cur-text))) + (assert-lacks! "sexp removed" t "(remove-me)") + (assert-has! "keep remains" t "keep")))) + + (run-test! "kill-line-multiple-lines" + (lambda () + (setup!) + (send-keys! "line1") + (send-keys! "RET") + (send-keys! "line2") + (send-keys! "RET") + (send-keys! "line3") + (exec! 'beginning-of-buffer) + (exec! 'kill-line) + (let ((t (cur-text))) + (assert-lacks! "line1 gone" t "line1") + (assert-has! "line2 remains" t "line2") + (assert-has! "line3 remains" t "line3")))) + + (end-phase!)) ;;;============================================================================ -;;; Test suite +;;; Phase 4 — Window Management +;;; Split, delete, cycle, and verify window counts + typing isolation. ;;;============================================================================ -;;; ------------------------------------------------------------------ -;;; Test 1: Self-insert typing reaches current editor -;;; ------------------------------------------------------------------ +(def (run-phase-4!) + (start-phase! "Phase 4: Window Management") -(def (test-self-insert!) - (displayln "--- test-self-insert ---") - (reset!) - ;; Clear any existing text by moving to scratch - (exec! 'scratch-buffer) - (thread-sleep! 0.1) - ;; Send a distinctive marker string - (send-keys! "hello") - (thread-sleep! 0.1) - (let ((text (current-buffer-text))) - (assert-contains! "typed text appears in buffer" text "hello"))) - -;;; ------------------------------------------------------------------ -;;; Test 2: C-x 2 splits the window (doesn't type "x2" in buffer) -;;; ------------------------------------------------------------------ - -(def (test-cx2-splits-not-types!) - (displayln "--- test-cx2-splits-not-types ---") - (reset!) - (exec! 'scratch-buffer) - (thread-sleep! 0.1) - ;; Note starting window count (should be 1) - (let ((before (window-count))) - ;; Send C-x 2 via the key sequence (not execute-command!, to test the actual key routing) - (send-keys! "C-x" "2") - (thread-sleep! 0.1) - (let ((after (window-count)) - (text (current-buffer-text))) - (assert-eq! "window count increased by 1" (+ before 1) after) - (assert-not-contains! "C-x 2 did not type 'x' in buffer" text "x") - (assert-not-contains! "C-x 2 did not type '2' in buffer" text "2")))) - -;;; ------------------------------------------------------------------ -;;; Test 3: C-x 3 splits vertically (doesn't type) -;;; ------------------------------------------------------------------ - -(def (test-cx3-splits-not-types!) - (displayln "--- test-cx3-splits-not-types ---") - (reset!) - (exec! 'scratch-buffer) - (thread-sleep! 0.1) - (let ((before (window-count))) - (send-keys! "C-x" "3") - (thread-sleep! 0.1) - (let ((after (window-count)) - (text (current-buffer-text))) - (assert-eq! "window count increased by 1" (+ before 1) after) - (assert-not-contains! "C-x 3 did not type '3' in buffer" text "3")))) - -;;; ------------------------------------------------------------------ -;;; Test 4: After C-x 2, prefix key state is cleared -;;; ------------------------------------------------------------------ - -(def (test-prefix-cleared-after-split!) - (displayln "--- test-prefix-cleared-after-split ---") - (reset!) - (send-keys! "C-x" "2") - (thread-sleep! 0.1) - (assert-false! "prefix state cleared after C-x 2" (prefix-active?))) + (run-test! "cx2-increases-window-count" + (lambda () + (setup!) + (let ((before (win-count))) + (send-keys! "C-x" "2") + (assert-eq! "2 windows after C-x 2" (+ before 1) (win-count))))) -;;; ------------------------------------------------------------------ -;;; Test 5: Typing in each window goes to that window only -;;; Regression: after C-x 2 + C-x o, typing went to top terminal -;;; ------------------------------------------------------------------ + (run-test! "cx3-increases-window-count" + (lambda () + (setup!) + (let ((before (win-count))) + (send-keys! "C-x" "3") + (assert-eq! "2 windows after C-x 3" (+ before 1) (win-count))))) -(def (test-split-typing-isolation!) - (displayln "--- test-split-typing-isolation ---") - (reset!) - ;; Start with fresh scratch buffer, clear it - (exec! 'scratch-buffer) - (thread-sleep! 0.1) - ;; Type a marker in window 0 - (send-keys! "WIN0") - (thread-sleep! 0.1) - ;; Split to get window 1 - (exec! 'split-window) - (thread-sleep! 0.1) - ;; Switch to window 1 - (exec! 'other-window) - (thread-sleep! 0.1) - ;; Type a different marker in window 1 - (send-keys! "WIN1") - (thread-sleep! 0.1) - (let ((texts (window-texts))) - (when (>= (length texts) 2) - ;; Both windows show the same buffer (scratch), so both have both markers. - ;; Key test: current window (win 1) text has WIN1, and we didn't accidentally - ;; type in win 0's editor (which would create duplication we can detect). - (let ((cur-text (current-buffer-text))) - (assert-contains! "typed text visible in current window" cur-text "WIN1"))))) - -;;; ------------------------------------------------------------------ -;;; Test 6: C-x 2 from terminal splits (not types); terminal split focus fix -;;; ------------------------------------------------------------------ - -(def (test-terminal-cx2-splits!) - (displayln "--- test-terminal-cx2-splits ---") - (reset!) - ;; Open a terminal - (exec! 'term) - (thread-sleep! 0.3) ;; let shell spawn - (assert-true! "terminal buffer is active" (terminal-running?)) - (let ((before (window-count))) - ;; C-x 2 should split, NOT type x2 into terminal - (send-keys! "C-x" "2") - (thread-sleep! 0.2) - (let ((after (window-count))) - (assert-eq! "C-x 2 in terminal splits window" (+ before 1) after)) - (assert-false! "prefix cleared after C-x 2 from terminal" (prefix-active?)))) - -;;; ------------------------------------------------------------------ -;;; Test 7: After C-x 2 from terminal, typing in new window goes to new window -;;; This is the exact bug that was reported: lower window's keystrokes -;;; were going to the top terminal widget. -;;; ------------------------------------------------------------------ - -(def (test-new-window-after-terminal-split-types-correctly!) - (displayln "--- test-new-window-after-terminal-split-types-correctly ---") - (reset!) - ;; Open terminal in window 0 - (exec! 'term) - (thread-sleep! 0.3) - ;; Split to create window 1 (lower) - (send-keys! "C-x" "2") - (thread-sleep! 0.2) - ;; Focus is now in the new window (window 1, non-terminal) - ;; Verify we are NOT in a terminal - (assert-false! "new lower window is not a terminal" (terminal-running?)) - ;; Type a distinctive marker - (send-keys! "NEWWIN") - (thread-sleep! 0.1) - ;; The current buffer's text must contain our marker - (let ((text (current-buffer-text))) - (assert-contains! "typing in new window goes to new window editor" text "NEWWIN"))) - -;;; ------------------------------------------------------------------ -;;; Test 8: C-x o switches window focus -;;; ------------------------------------------------------------------ - -(def (test-other-window-switches-focus!) - (displayln "--- test-other-window-switches-focus ---") - (reset!) - (exec! 'scratch-buffer) - (thread-sleep! 0.1) - (exec! 'split-window) - (thread-sleep! 0.1) - (let ((name-before (current-buffer-name))) - (exec! 'other-window) - (thread-sleep! 0.1) - ;; After split + other-window, we're in a different position. - ;; The key invariant: the current window index changed. - ;; We verify by checking window-count is still 2 (not accidentally closed). - (assert-eq! "still 2 windows after other-window" 2 (window-count)))) - -;;; ------------------------------------------------------------------ -;;; Test 9: C-x 1 deletes other windows -;;; ------------------------------------------------------------------ - -(def (test-cx1-deletes-other-windows!) - (displayln "--- test-cx1-deletes-other-windows ---") - (reset!) - (exec! 'split-window) - (thread-sleep! 0.1) - (assert-eq! "2 windows before C-x 1" 2 (window-count)) - (send-keys! "C-x" "1")