cl-tty/backend/tests.lisp

(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 +---+")
      (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*)))))