tp/tests/tp-tests.el

;;; tp-tests.el --- Public TP facade tests -*- lexical-binding: t; -*-

;; Copyright (C) 2024-2026 Geekinney
;; SPDX-License-Identifier: GPL-3.0-or-later

;;; Commentary:

;; Focused end-to-end tests for the stateless public property facade.  Retained
;; and reactive behavior is covered by tp-surface-tests and tp-binding-tests.

;;; Code:

(require 'ert)
(require 'tp)

(defmacro tp-test-with-temp-buffer (&rest body)
  "Run BODY in a temporary buffer with isolated declaration recipes."
  (declare (indent 0) (debug t))
  `(unwind-protect
       (with-temp-buffer
         (tp-layer-reset)
         ,@body)
     (tp-layer-reset)))

(ert-deftest tp-test-set-get-and-member-preserve-presence ()
  "Set/get APIs preserve explicit nil separately from absence."
  (tp-test-with-temp-buffer
    (insert "hello")
    (should (equal (tp-set 1 6 '(face bold help-echo nil)) '(1 . 6)))
    (should (eq (tp-at 2 'face) 'bold))
    (should (equal (tp-member 2 'help-echo) '(help-echo nil)))
    (should-not (tp-member 2 'mouse-face))
    (should (equal (tp-get 1 6 'help-echo) '((1 6 nil))))))

(ert-deftest tp-test-set-string-whole-object-is-nondestructive ()
  "Whole-string mutation returns a copy and leaves its input untouched."
  (let* ((source (copy-sequence "hello"))
         (result (tp-set source 'face 'bold 'help-echo "tip")))
    (should-not (eq source result))
    (should-not (text-properties-at 0 source))
    (should (eq (get-text-property 0 'face result) 'bold))
    (should (equal (get-text-property 0 'help-echo result) "tip"))))

(ert-deftest tp-test-set-string-range-mutates-in-place ()
  "Explicit string ranges retain the historical in-place contract."
  (let ((text (copy-sequence "hello")))
    (should (eq (tp-set 1 4 '(face italic) text) text))
    (should-not (get-text-property 0 'face text))
    (should (eq (get-text-property 1 'face text) 'italic))
    (should-not (get-text-property 4 'face text))))

(ert-deftest tp-test-reset-replaces-only-the-requested-range ()
  "Reset removes prior properties inside its range and nowhere else."
  (tp-test-with-temp-buffer
    (insert "abcdef")
    (put-text-property 1 7 'help-echo "host")
    (tp-reset 2 5 '(face bold))
    (should (equal (get-text-property 1 'help-echo) "host"))
    (should-not (get-text-property 2 'help-echo))
    (should (eq (get-text-property 2 'face) 'bold))
    (should (equal (get-text-property 5 'help-echo) "host"))))

(ert-deftest tp-test-add-composes-face-and-nested-plists ()
  "Add uses the shared native property merge policy."
  (let* ((source (propertize "x" 'face 'bold
                             'display '(:width 1 :height 2)))
         (result (tp-add source
                         'face 'italic
                         'display '(:width 3))))
    (should (equal (get-text-property 0 'face result) '(italic bold)))
    (should
     (equal (get-text-property 0 'display result)
            '(:width 3 :height 2)))))

(ert-deftest tp-test-remove-top-level-and-nested-properties ()
  "Remove handles top-level, sub-property, and nested paths."
  (let* ((source (propertize
                  "x" 'face '(:foreground "red"
                               :underline (:style wave :color "blue"))
                  'help-echo "tip"))
         (no-help (tp-remove source 'help-echo))
         (no-underline-style
          (tp-remove source 'face :underline '(:style))))
    (should-not (get-text-property 0 'help-echo no-help))
    (should
     (equal (get-text-property 0 'face no-underline-style)
            '(:foreground "red" :underline (:color "blue"))))))

(ert-deftest tp-test-clear-defaults-to-target-bounds ()
  "Clear removes every property while preserving text."
  (let ((text (propertize "hello" 'face 'bold)))
    (tp-clear nil nil text)
    (should (equal text "hello"))
    (should-not (text-properties-at 0 text))))

(ert-deftest tp-test-native-recipe-application-is-one-shot ()
  "Applying a named recipe creates no object, binding, anchor, or mount."
  (tp-test-with-temp-buffer
    (define-tp tp-test-warning (color)
      `(face (:foreground ,color) help-echo "warning"))
    (insert "warning")
    (let ((before (tp-reactive-counters)))
      (tp-set 1 8 '(tp-test-warning "orange"))
      (should (equal (get-text-property 1 'face)
                     '(:foreground "orange")))
      (should (equal (tp-reactive-counters) before)))))

(ert-deftest tp-test-match-and-regexp-use-the-same-direct-core ()
  "Literal and regexp application share recipe projection semantics."
  (tp-test-with-temp-buffer
    (define-tp tp-test-hit () '(face bold))
    (insert "one two one")
    (should (equal (tp-match-set "one" 'tp-test-hit)
                   '((1 . 4) (9 . 12))))
    (should (equal (tp-regexp-add "t.o" '(help-echo "two"))
                   '((5 . 8))))
    (should (eq (get-text-property 1 'face) 'bold))
    (should (equal (get-text-property 5 'help-echo) "two"))))

(ert-deftest tp-test-property-navigation-keeps-string-buffer-parity ()
  "Forward and backward search report equivalent string/buffer matches."
  (let ((text (tp-set "abcd" 'face 'bold)))
    (with-temp-buffer
      (insert text)
      (goto-char (point-min))
      (let ((buffer-match (tp-forward 'face 'bold)))
        (should (= (prop-match-beginning buffer-match) 1))
        (should (= (prop-match-end buffer-match) 5))
        (should (eq (prop-match-value buffer-match) 'bold)))
      (should (equal (tp-forward 'face 'bold text) '((0 4 bold))))
      (goto-char (point-max))
      (let ((buffer-match (tp-backward 'face 'bold)))
        (should (= (prop-match-beginning buffer-match) 1))
        (should (= (prop-match-end buffer-match) 5))
        (should (eq (prop-match-value buffer-match) 'bold))))))

(provide 'tp-tests)
;;; tp-tests.el ends here