(defpackage :cl-tty-backend-test (:use :cl :fiveam :cl-tty.backend) (:export #:run-tests)) (in-package :cl-tty-backend-test) (def-suite backend-suite :description "Backend protocol tests") (in-suite backend-suite) ;; ── Helpers ───────────────────────────────────────────────────── (defun make-capturing-backend () "Create a simple-backend that writes to a string stream." (let* ((s (make-string-output-stream)) (b (make-simple-backend :output-stream s))) (values b s))) ;; ── Simple Backend ────────────────────────────────────────────── (defun run-tests () "Run all backend tests." (let ((result (run 'backend-suite))) (fiveam:explain! result) (uiop:quit 0))) (test simple-backend-lifecycle "simple-backend can be created and shut down" (let ((b (make-simple-backend))) (is (typep b 'simple-backend)) (initialize-backend b) (is-false (capable-p b :truecolor) "simple backend has no truecolor") (shutdown-backend b))) (test simple-backend-draw-text "simple-backend renders text at position, ignoring style" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-text b 0 0 "hello" :red nil :bold t :italic t) (shutdown-backend b) (is (string= (get-output-stream-string s) "hello") "draw-text should output the string ignoring style"))) (test simple-backend-draw-border "simple-backend draws ASCII border with +-| characters" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-border b 0 0 5 3 :style :single) (shutdown-backend b) (let ((out (get-output-stream-string s))) (is (search "-----" out) "top edge should have 5 dashes") (is (search "| |" out) "middle row should have pipe sides")))) (test simple-backend-draw-rounded "simple-backend falls back to straight edges for rounded style" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-border b 0 0 5 3 :style :rounded) (shutdown-backend b) (let ((out (get-output-stream-string s))) ;; Rounded falls back to ASCII — identical output to single (is (search "-----" out) "rounded style produces same dashes as single")))) (test simple-backend-draw-link "simple-backend renders link as plain text" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-link b 0 0 "click me" "http://example.com") (shutdown-backend b) (is (string= (get-output-stream-string s) "click me") "simple-backend ignores URL, outputs text only"))) (test simple-backend-draw-ellipsis "simple-backend renders ... for ellipsis" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-ellipsis b 0 0 5) (shutdown-backend b) (is (string= (get-output-stream-string s) "...") "ellipsis should output 3 dots"))) ;; ── Backend Capabilities ─────────────────────────────────────── (test capable-p-known-features "capable-p returns nil for all features on simple-backend" (let ((b (make-simple-backend))) (initialize-backend b) (dolist (f '(:truecolor :osc8 :sync :mouse :bracketed-paste :kitty-keyboard :sixel :cursor-style)) (is-false (capable-p b f) (format nil "~s should not be supported on simple-backend" f))) (shutdown-backend b))) ;; ── Backend Size ─────────────────────────────────────────────── (test backend-size-returns-integers "backend-size returns two integer values" (let ((b (make-simple-backend))) (initialize-backend b) (multiple-value-bind (cols lines) (backend-size b) (is (integerp cols)) (is (integerp lines)) (is (>= cols 10)) (is (>= lines 3))) (shutdown-backend b))) ;; ── Backend Protocol: Defaults and No-ops ────────────────────── (test default-methods-are-no-ops "Default backend methods don't error" (let ((b (make-simple-backend))) (initialize-backend b) (is (null (multiple-value-list (cursor-hide b)))) (is (null (multiple-value-list (cursor-show b)))) (is (null (multiple-value-list (cursor-style b :block)))) (is (null (multiple-value-list (begin-sync b)))) (is (null (multiple-value-list (end-sync b)))) (shutdown-backend b))) (test sync-is-noop-on-simple "begin-sync and end-sync produce no output on simple-backend" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (begin-sync b) (draw-text b 0 0 "in sync" nil nil) (end-sync b) (shutdown-backend b) (is (string= (get-output-stream-string s) "in sync") "no sync escape sequences should appear"))) ;; ── Draw-rect ────────────────────────────────────────────────── (test draw-rect-fills-area-correctly "draw-rect with background writes nothing to output (simple-backend no-op)" (multiple-value-bind (b s) (make-capturing-backend) (initialize-backend b) (draw-rect b 0 0 5 3 :bg :red) (shutdown-backend b) (is (string= (get-output-stream-string s) "") "draw-rect is a no-op on simple-backend"))) ;; ── Detection ────────────────────────────────────────────────── (test detection-returns-backend-instance "detect-backend returns a valid backend instance" (let ((be (cl-tty.backend:detect-backend))) (is (typep be 'cl-tty.backend:backend)))) (test detection-caches-result "detect-backend caches the result in *detected-backend*" (let ((*detected-backend* nil)) (cl-tty.backend:detect-backend) (is-true (not (null cl-tty.backend::*detected-backend*)))))