905d3523ac
Expose one-shot string and buffer styling plus reactive range watches over the same schema, mutation, binding, and retained surface core. Verification: 712 ERT tests; 92 doctests; shuffled seed 20260806; compile-all WERROR=t.
96 lines
3.9 KiB
EmacsLisp
96 lines
3.9 KiB
EmacsLisp
;;; tp-convenience-tests.el --- Tests for TP convenience APIs -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2026 Geekinney
|
|
|
|
;;; Commentary:
|
|
|
|
;; Contract tests for one-shot and reactive text-property conveniences.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'tp)
|
|
|
|
(ert-deftest tp-convenience-test-propertize-uses-style-projection ()
|
|
"Propertizing projects native declarations without mutating the input."
|
|
(let* ((callback (lambda (_window _object _position) "help"))
|
|
(source "Hello")
|
|
(result
|
|
(tp-propertize
|
|
source
|
|
(list 'face '(:foreground "red" :weight bold)
|
|
'help-echo callback 'keymap nil))))
|
|
(should (equal source "Hello"))
|
|
(should-not (text-properties-at 0 source))
|
|
(should (equal (get-text-property 0 'face result)
|
|
'(:foreground "red" :weight bold)))
|
|
(should (eq (get-text-property 0 'help-echo result) callback))
|
|
(should (plist-member (text-properties-at 0 result) 'keymap))
|
|
(should-not (get-text-property 0 'keymap result))))
|
|
|
|
(ert-deftest tp-convenience-test-apply-mutates-only-the-requested-range ()
|
|
"Applying declarations preserves text and properties outside the range."
|
|
(with-temp-buffer
|
|
(insert "abcdef")
|
|
(put-text-property 1 7 'category 'host)
|
|
(should (equal (tp-apply (current-buffer) 2 5 '(face italic)) '(2 . 5)))
|
|
(should (equal (buffer-string) "abcdef"))
|
|
(should-not (get-text-property 1 'face))
|
|
(should (eq (get-text-property 2 'face) 'italic))
|
|
(should-not (get-text-property 5 'face))
|
|
(should (eq (get-text-property 3 'category) 'host))))
|
|
|
|
(ert-deftest tp-convenience-test-apply-rejects-invalid-targets-and-ranges ()
|
|
"Applying never falls back from an invalid target to the current buffer."
|
|
(with-temp-buffer
|
|
(insert "safe")
|
|
(should-error (tp-apply " *missing-tp-buffer*" 1 2 '(face bold))
|
|
:type 'tp-unsupported-buffer)
|
|
(should-error (tp-apply (current-buffer) 4 2 '(face bold))
|
|
:type 'args-out-of-range)
|
|
(should (equal (buffer-string) "safe"))
|
|
(should-not (text-properties-at 0 (buffer-string)))))
|
|
|
|
(ert-deftest tp-convenience-test-watch-reacts-and-restores-host-properties ()
|
|
"Watching a range updates properties through one retained surface."
|
|
(with-temp-buffer
|
|
(insert "Status")
|
|
(put-text-property 1 7 'help-echo "host")
|
|
(let* ((connected (tp-signal-create nil))
|
|
(surface
|
|
(tp-watch
|
|
(current-buffer) 1 7
|
|
(lambda ()
|
|
(if (tp-signal-read connected)
|
|
'(face (:foreground "green") help-echo "Connected")
|
|
'(face (:foreground "red") help-echo "Disconnected"))))))
|
|
(should (equal (buffer-string) "Status"))
|
|
(should (equal (get-text-property 2 'face)
|
|
'(:foreground "red")))
|
|
(should (equal (get-text-property 2 'help-echo) "Disconnected"))
|
|
(tp-signal-set connected t)
|
|
(should (equal (get-text-property 2 'face)
|
|
'(:foreground "green")))
|
|
(should (equal (get-text-property 2 'help-echo) "Connected"))
|
|
(should (= (tp-surface-revision surface) 2))
|
|
(tp-surface-unmount surface)
|
|
(should-not (get-text-property 2 'face))
|
|
(should (equal (get-text-property 2 'help-echo) "host")))))
|
|
|
|
(ert-deftest tp-convenience-test-failed-watch-releases-its-range-anchor ()
|
|
"A failed first watch publication leaves no live marker-backed anchor."
|
|
(with-temp-buffer
|
|
(insert "host")
|
|
(let ((original (symbol-function 'tp-range-anchor-create))
|
|
anchor)
|
|
(cl-letf (((symbol-function 'tp-range-anchor-create)
|
|
(lambda (&rest arguments)
|
|
(setq anchor (apply original arguments)))))
|
|
(should-error
|
|
(tp-watch (current-buffer) 1 5
|
|
(lambda () (error "Initial compute failed")))))
|
|
(should-not (tp-range-anchor-live-p anchor)))))
|
|
|
|
(provide 'tp-convenience-tests)
|
|
;;; tp-convenience-tests.el ends here
|