From 36328a1cca54b243aa3bfe746b50733f5a624930 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sun, 26 Jul 2026 23:46:52 +0800 Subject: [PATCH] Phase 1: CI matrix, zero-warning compile, shuffled runner, autoloads Byte-compile warnings swept 57 -> 0 across all modules, tests, and doctest (docstring rewraps and quoting, defvar declarations for the reactive test variables, prefixed doctest counters, dead-binding removal, one impossible eq -> equal in a face-merge assertion) with behavior preserved. GitHub Actions workflow runs an Emacs 28.1/29.4/ 30.1 matrix: compile-all with warnings-as-errors, the 443-test suite, a genuinely shuffled-order rerun (tp-run-shuffled.el runs each test individually; ERT's member selector cannot reorder), and the 63 README doctests. Makefile gains WERROR, compile-all, and test-shuffled. Autoload cookies added for the four interactive commands and the define-tp/define-tps macros. package-lint: 0 findings (main file tp.el); draft MELPA recipe in docs/. Co-Authored-By: Claude Fable 5 --- .github/workflows/ci.yml | 44 ++++++++++++++++++++ Makefile | 22 ++++++++-- docs/melpa-recipe.el | 16 ++++++++ tp-core.el | 11 +++-- tp-doctest.el | 19 +++++---- tp-layer.el | 86 ++++++++++++++++++++++++++-------------- tp-ops.el | 6 ++- tp-reactive.el | 16 ++++---- tp-render.el | 3 +- tp-run-shuffled.el | 63 +++++++++++++++++++++++++++++ tp-tests.el | 34 ++++++++++++++-- 11 files changed, 264 insertions(+), 56 deletions(-) create mode 100644 .github/workflows/ci.yml create mode 100644 docs/melpa-recipe.el create mode 100644 tp-run-shuffled.el diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..fccc473 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,44 @@ +name: CI + +on: + push: + branches: [main, 'dev/**'] + pull_request: + branches: [main] + +jobs: + test: + runs-on: ubuntu-latest + strategy: + fail-fast: false + matrix: + emacs_version: ['28.1', '29.4', '30.1'] + steps: + - uses: actions/checkout@v4 + + - uses: purcell/setup-emacs@master + with: + version: ${{ matrix.emacs_version }} + + - name: Install dash from GNU ELPA + run: | + emacs -Q --batch --eval "(progn \ + (require 'package) \ + (setq package-user-dir (expand-file-name \".elpa\")) \ + (add-to-list 'package-archives '(\"gnu\" . \"https://elpa.gnu.org/packages/\")) \ + (package-initialize) \ + (package-refresh-contents) \ + (package-install 'dash))" + echo "LOAD_EXTRA=-L $(ls -d "$PWD"/.elpa/dash-*)" >> "$GITHUB_ENV" + + - name: Byte-compile (warnings are errors) + run: make compile-all WERROR=t LOAD_EXTRA="$LOAD_EXTRA" + + - name: ERT suite + run: make test LOAD_EXTRA="$LOAD_EXTRA" + + - name: ERT suite (shuffled order) + run: make test-shuffled LOAD_EXTRA="$LOAD_EXTRA" + + - name: README doctests + run: make doctest LOAD_EXTRA="$LOAD_EXTRA" diff --git a/Makefile b/Makefile index 504c462..8e9c9cf 100644 --- a/Makefile +++ b/Makefile @@ -2,32 +2,48 @@ # # Usage: # make test # run all ERT test suites +# make test-shuffled # run the suite in a random order (SHUFFLE_SEED=n reproduces) # make doctest # execute README examples against the code -# make compile # byte-compile all modules +# make compile # byte-compile the library modules +# make compile-all # byte-compile modules + tests + dev scripts # make clean # remove compiled files # +# WERROR=t turns byte-compile warnings into errors (used in CI). # If dash.el is not on the default load-path, point LOAD_EXTRA at it: # make test LOAD_EXTRA="-L ~/.emacs.d/elpa/dash-20240510.1327" EMACS ?= emacs LOAD_EXTRA ?= +WERROR ?= nil LOADPATH = -L . $(LOAD_EXTRA) SRC = tp-core.el tp-reactive.el tp-layer.el tp-ops.el tp-search.el \ tp-render.el tp-stack.el tp-palette.el tp-builtins.el tp.el TESTS = $(wildcard *-tests.el) +DEV = tp-doctest.el tp-run-shuffled.el -.PHONY: test doctest compile clean +.PHONY: test test-shuffled doctest compile compile-all clean test: $(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \ -f ert-run-tests-batch-and-exit +test-shuffled: + $(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \ + -l tp-run-shuffled.el + doctest: $(EMACS) -Q --batch $(LOADPATH) -l tp-doctest.el compile: clean - $(EMACS) -Q --batch $(LOADPATH) -f batch-byte-compile $(SRC) + $(EMACS) -Q --batch $(LOADPATH) \ + --eval "(setq byte-compile-error-on-warn $(WERROR))" \ + -f batch-byte-compile $(SRC) + +compile-all: clean + $(EMACS) -Q --batch $(LOADPATH) \ + --eval "(setq byte-compile-error-on-warn $(WERROR))" \ + -f batch-byte-compile $(SRC) $(TESTS) $(DEV) clean: rm -f *.elc diff --git a/docs/melpa-recipe.el b/docs/melpa-recipe.el new file mode 100644 index 0000000..c3049a5 --- /dev/null +++ b/docs/melpa-recipe.el @@ -0,0 +1,16 @@ +;;; melpa-recipe.el --- draft MELPA recipe for tp -*- lexical-binding: t -*- + +;; Draft recipe for a future MELPA submission (not yet submitted). +;; The package ships the nine library modules plus the tp.el umbrella; +;; test suites, doctests, and dev scripts are excluded. +;; +;; Verified locally with: package-lint (0 findings, main file tp.el) +;; and a multi-Emacs CI matrix (28.1 / 29.4 / 30.1). + +(tp :fetcher github + :repo "Kinneyzhang/tp" + :files ("tp.el" "tp-core.el" "tp-reactive.el" "tp-layer.el" + "tp-ops.el" "tp-search.el" "tp-render.el" "tp-stack.el" + "tp-palette.el" "tp-builtins.el")) + +;;; melpa-recipe.el ends here diff --git a/tp-core.el b/tp-core.el index 8f46d8c..3b5647d 100644 --- a/tp-core.el +++ b/tp-core.el @@ -68,7 +68,8 @@ If nil, debug messages are only logged to the *tp-debug* buffer." ;; Misc yank-handler auto-composed evaporate face-alias) "List of built-in Emacs text property names. -These property names are reserved and cannot be used as layer names in `define-tp'. +These property names are reserved and cannot be used as layer names +in `define-tp'. An error is signaled at macro expansion time (when the `define-tp' form is evaluated) if a reserved name is used, preventing the layer definition from being created.") @@ -95,6 +96,7 @@ FORMAT-STRING and ARGS are passed to `format'." (when tp-debug-echo (message "[tp] %s" msg))))) +;;;###autoload (defun tp-debug-clear () "Clear the *tp-debug* buffer." (interactive) @@ -102,6 +104,7 @@ FORMAT-STRING and ARGS are passed to `format'." (with-current-buffer buf (erase-buffer)))) +;;;###autoload (defun tp-debug-show () "Show the *tp-debug* buffer." (interactive) @@ -455,7 +458,8 @@ Example: (tp--merge-duplicate-keys \\='(face bold face (:foreground \"red\"))) => (face ((:foreground \"red\") bold)) - (tp--merge-duplicate-keys \\='(face (:background \"blue\") face (:foreground \"red\"))) + (tp--merge-duplicate-keys + \\='(face (:background \"blue\") face (:foreground \"red\"))) => (face (:background \"blue\" :foreground \"red\")) (tp--merge-duplicate-keys \\='(prop1 a prop2 b prop1 c)) @@ -555,7 +559,8 @@ Returns a list of reactive symbols found." (defun tp--extract-reactive-value (val reactive-var) "Extract only the parts of VAL that use REACTIVE-VAR. -If VAL is a plist, recursively extract only the key-value pairs containing REACTIVE-VAR. +If VAL is a plist, recursively extract only the key-value pairs +containing REACTIVE-VAR. If VAL directly contains REACTIVE-VAR, return VAL as-is. REACTIVE-VAR should be the $-prefixed symbol (e.g., $my-color)." (cond diff --git a/tp-doctest.el b/tp-doctest.el index b30dc2a..8189784 100644 --- a/tp-doctest.el +++ b/tp-doctest.el @@ -23,16 +23,17 @@ (require 'tp) (tp-layer-reset) -(defvar fails 0) -(defvar total 0) +(defvar tp-doctest--fails 0) +(defvar tp-doctest--total 0) (defmacro chk (label expected &rest body) `(let* ((exp ,expected) (got (condition-case err (progn ,@body) (error (list :ERROR err))))) - (setq total (1+ total)) + (setq tp-doctest--total (1+ tp-doctest--total)) (if (equal got exp) (princ (format "PASS %s\n" ,label)) - (setq fails (1+ fails)) - (princ (format "FAIL %s\n expected: %S\n got: %S\n" ,label exp got))))) + (setq tp-doctest--fails (1+ tp-doctest--fails)) + (princ (format "FAIL %s\n expected: %S\n got: %S\n" + ,label exp got))))) (defmacro chk-str (label expected &rest body) "Compare prin1 form (covers propertized strings)." `(chk ,label ,expected (prin1-to-string (progn ,@body)))) @@ -195,6 +196,7 @@ (list (substring-no-properties my-string) (nreverse positions)))) ;; ---- Layer definitions ---- +(defvar my-color) (chk "L-format3" '((:foreground "blue") "status: active") (progn (tp-layer-reset) @@ -456,6 +458,8 @@ '("error" :props (face (:foreground $error-color)) :data ((error-color . "red")))) (tp-layer-props 'status-indicators-success))) +(defvar fg-color) +(defvar bg-color) (chk "RC-batch" '(:foreground "red" :background "blue") (progn (tp-layer-reset) @@ -484,6 +488,7 @@ (list before (tp-at 1 'face)))))) ;; ---- Theme example (as in the docs) ---- +(declare-function switch-to-light-theme "tp-doctest") (defvar theme-fg "white") (defvar theme-bg "black") (defvar theme-accent "cyan") @@ -548,7 +553,7 @@ (list (tp-forward-do #'upcase 'marker nil str 3) (substring-no-properties str)))) -(princ (format "\nTOTAL: %d FAILS: %d\n" total fails)) -(when (> fails 0) (kill-emacs 1)) +(princ (format "\nTOTAL: %d FAILS: %d\n" tp-doctest--total tp-doctest--fails)) +(when (> tp-doctest--fails 0) (kill-emacs 1)) ;;; tp-doctest.el ends here diff --git a/tp-layer.el b/tp-layer.el index 07f7d70..7f0bc2e 100644 --- a/tp-layer.el +++ b/tp-layer.el @@ -86,7 +86,7 @@ The error message names the full cycle, e.g. \"a -> b -> a\"." (defun tp--expand-layer-to-props-list (layer-name str start) "Expand LAYER-NAME to a list of property keys it contributes. If LAYER-NAME is a layer defined in `tp-layer-alist', returns a list -of the property keys that the layer adds, plus 'tp-name. +of the property keys that the layer adds, plus `tp-name'. STR and START are used to get the argument value for parameterized layers. For non-layer symbols, returns a list containing just that symbol." (if (tp--is-layer-name-p layer-name) @@ -167,13 +167,13 @@ Returns the face value that the layer adds, or nil if no face contribution." (defun tp--parse-define-layer-args (args) "Parse ARGS for tp--define-layer-internal function. Returns plist with keys :props, :data, :watch, :compute, :transform. -- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH] [:compute COMPUTE] [:transform FN]" - (let (props data watch compute transform has-keywords) +- Keyword arguments: :props PLIST [:data DATA] [:watch WATCH] + [:compute COMPUTE] [:transform FN]" + (let (props data watch compute transform) (cond ;; Check for keyword arguments format ((and (keywordp (car args)) (memq (car args) '(:props :data :watch :compute :transform))) - (setq has-keywords t) ;; Parse keyword arguments (let ((rest args)) (while rest @@ -203,11 +203,14 @@ Format 1 - Direct plist (no :watch/:compute/:data/:transform support): (tp--define-layer-internal \\='layer-name \\='(display \"🌑\" face (:height 1.0))) -Format 2 - With :props, :data, :watch, :compute, and/or :transform (Vue 3 style reactivity): +Format 2 - With :props, :data, :watch, :compute, and/or :transform +\(Vue 3 style reactivity): (tp--define-layer-internal \\='layer-name - ;; props: $-prefixed symbols are reactive variables; auto-defined if not bound + ;; props: $-prefixed symbols are reactive variables; + ;; auto-defined if not bound :props \\='(face (:foreground $my-color) help-echo $full-name) - ;; data: additional reactive variables not used in props; auto-defined if not bound + ;; data: additional reactive variables not used in props; + ;; auto-defined if not bound :data \\='((first-name . \"John\") (last-name . \"Doe\")) ;; compute: list of (VAR-NAME FUNCTION) - compute reactive variable values :compute \\='((full-name (lambda () (concat first-name \" \" last-name)))) @@ -234,7 +237,8 @@ Reactive Variables: :transform - A function that receives the tp-text value and returns a transformed string. Useful for formatting numbers, dates, or other values - before display. Example: (lambda (text) (format \"$%.2f\" (string-to-number text))) + before display. + Example: (lambda (text) (format \"$%.2f\" (string-to-number text))) Note: When using :watch, :compute, or :data, you MUST use :props to specify the text properties explicitly. @@ -306,6 +310,7 @@ The layer is stored in `tp-layer-alist'." (tp--layer-refresh name) (assoc name tp-layer-alist))))) +;;;###autoload (defmacro define-tp (name arglist &rest body) "Define a text property layer named NAME. @@ -319,7 +324,8 @@ Format 2 - Parameterized simple (single argument, simple body): (define-tp tp-space (pixel) \\=`(display (space :width (,pixel)))) -Format 3 - Non-parameterized with reactive features (requires $-prefixed variables): +Format 3 - Non-parameterized with reactive features +\(requires $-prefixed variables): (define-tp my-layer () :props \\='(face (:foreground $my-color)) :data \\='((my-color . \"red\")) @@ -339,7 +345,8 @@ ARGLIST must be either: BODY is either: - A single property list expression (simple format) - Keyword arguments starting with :props, :data, :compute, :watch, or :transform - (reactive format - only for non-parameterized layers with $-prefixed variables) + (reactive format - only for non-parameterized layers with $-prefixed + variables) In simple format, exactly one body form is accepted; supplying more than one signals an error at macro-expansion time instead of silently @@ -389,8 +396,10 @@ complete list of reserved names." (defun tp--define-layer-unified (name arglist body) "Define a layer NAME with ARGLIST and BODY using unified structure. For non-parameterized layers, ARGLIST is nil and BODY is the evaluated plist. -For parameterized layers, ARGLIST contains one symbol and BODY is the unevaluated form. -Stores the layer in `tp-layer-alist' with format: (LAYER-NAME ARGLIST BODY-FORM). +For parameterized layers, ARGLIST contains one symbol and BODY is the +unevaluated form. +Stores the layer in `tp-layer-alist' with format: +\(LAYER-NAME ARGLIST BODY-FORM). For non-parameterized layers, if BODY contains reactive symbols ($-prefixed), delegates to `tp--define-layer-internal' for proper reactive handling." @@ -417,7 +426,8 @@ delegates to `tp--define-layer-internal' for proper reactive handling." (defun tp--layer-group-element-format (element) "Determine the format type of ELEMENT. -Returns 'symbol, 'format-1, 'format-2, 'format-3, 'format-4, or nil if invalid." +Returns `symbol', `format-1', `format-2', `format-3', `format-4', or +nil if invalid." (cond ;; Symbol - reference to existing layer ((symbolp element) 'symbol) @@ -452,9 +462,11 @@ Returns 'symbol, 'format-1, 'format-2, 'format-3, 'format-4, or nil if invalid." (t nil))) (defun tp--parse-layer-group-element (group-name element idx) - "Parse a layer group element and return (layer-name . properties) or extended form. + "Parse a layer group element and return (layer-name . properties) +or extended form. GROUP-NAME is the name of the layer group. -ELEMENT is the element to parse (can be anonymous plist, cons-cell, or :props form). +ELEMENT is the element to parse (can be anonymous plist, cons-cell, +or :props form). IDX is the index for anonymous elements. Returns a cons cell (LAYER-NAME . PROPERTIES) or a symbol if ELEMENT @@ -634,7 +646,8 @@ ELEMENTS is the list of layer definitions." (defun tp--define-layer-group-unified (name arglist body-form) "Define a parameterized layer group NAME with ARGLIST and BODY-FORM. -Stores the group in `tp-layer-groups' with format: (GROUP-NAME ARGLIST BODY-FORM). +Stores the group in `tp-layer-groups' with format: +\(GROUP-NAME ARGLIST BODY-FORM). Layers generated by a previous non-parameterized definition of NAME are undefined, since a parameterized group generates none." (dolist (stale (cdr (assq name tp--group-generated-layers))) @@ -647,10 +660,12 @@ are undefined, since a parameterized group generates none." (push (cons name entry) tp-layer-groups))) (assoc name tp-layer-groups)) +;;;###autoload (defmacro define-tps (name arglist &rest body) "Define a text property group named NAME. -This macro defines a group of text properties (layers) that can be used together. +This macro defines a group of text properties (layers) that can be +used together. It follows the same format as `define-tp' for consistency. ARGLIST must be either: @@ -686,7 +701,8 @@ Format 4 - Named layer with :props keyword (named as NAME-suffix): Format 5 - Named layer with :props, :data, :watch, and/or :compute: \\='(\"reactive\" :props (face (:foreground $my-color)) :data ((my-color . \"red\")) - :watch ((my-color (lambda (new old layer) (message \"Changed!\"))))) + :watch ((my-color (lambda (new old layer) + (message \"Changed!\"))))) Note: NAME cannot be a built-in Emacs text property name like `face', `display', `invisible', etc. See `tp--builtin-text-properties' for the @@ -715,8 +731,10 @@ complete list of reserved names." (defun tp--set-layer-props (layer-name properties) "Set PROPERTIES for layer LAYER-NAME in `tp-layer-alist'. If the layer already exists, updates its properties; otherwise creates it. -Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with reactive layers. -This is an internal function used by layer definition macros and reactive updates." +Stores as (LAYER-NAME . PROPERTIES) for backward compatibility with +reactive layers. +This is an internal function used by layer definition macros and +reactive updates." (if (assoc layer-name tp-layer-alist) (setf (cdr (assoc layer-name tp-layer-alist)) properties) (push (cons layer-name properties) tp-layer-alist))) @@ -731,12 +749,15 @@ This is an internal function used by group definition macros." (defun tp-layer-props (layer-name &optional include-tp-name) "Return properties for layer LAYER-NAME from `tp-layer-alist'. -If INCLUDE-TP-NAME is non-nil, appends 'tp-name property to identify the layer. -Also includes tp-name automatically if the layer has reactive dependencies registered. +If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify +the layer. +Also includes tp-name automatically if the layer has reactive +dependencies registered. Handles two storage formats: 1. Old format (from tp--set-layer-props): (LAYER-NAME . PLIST) - flat plist 2. Unified format (from define-tp): (LAYER-NAME ARGLIST BODY-FORM) -For parameterized layers (ARGLIST non-nil), returns nil - use `tp-layer-props-with-arg'. +For parameterized layers (ARGLIST non-nil), returns nil - use +`tp-layer-props-with-arg'. Recursively expands any nested layer names in the returned plist. Signals an error naming the cycle if layer references are cyclic. The returned plist is a fresh copy: mutating it does not affect the @@ -794,7 +815,8 @@ where ARGLIST is a non-nil list of argument symbols." (defun tp-layer-props-with-arg (layer-name arg &optional include-tp-name) "Return properties for parameterized layer LAYER-NAME with ARG. Evaluates the body form with the argument bound to the parameter. -If INCLUDE-TP-NAME is non-nil, appends 'tp-name property to identify the layer. +If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify +the layer. Recursively expands any nested layer names in the returned plist. $-prefixed reactive symbols in the body are resolved to the current values of their variables at evaluation time; they do not create @@ -994,7 +1016,8 @@ Returns the expanded plist." (defun tp--resolve-props (props) "Resolve PROPS to a property list with layer metadata. PROPS can be: -- A symbol (layer name from `tp-layer-alist' or group name from `tp-layer-groups') +- A symbol (layer name from `tp-layer-alist' or group name from + `tp-layer-groups') - A two-element list (LAYER-NAME ARG) where LAYER-NAME is a defined layer and ARG is either `t' for non-parameterized layers or the argument value for parameterized layers @@ -1018,8 +1041,10 @@ If PROPS is a plist with layer names at any position: If PROPS is a plist: - If it contains reactive variables ($...), generates a UUID for `tp-name', - registers reactive dependencies, and returns the resolved props with `tp-name'. - If the plist already has a `tp-name', uses that instead of generating a new one. + registers reactive dependencies, and returns the resolved props + with `tp-name'. + If the plist already has a `tp-name', uses that instead of + generating a new one. - If no reactive variables, returns props as-is (no tp-name added). Returns nil if PROPS is a symbol but no matching layer/group is found. @@ -1157,13 +1182,15 @@ For group names, includes `tp-layers' property with the full layer stack." (t nil))) (defun tp--ensure-props (plist) - "Ensure PLIST is a property list, resolving layer names and handling reactive vars. + "Ensure PLIST is a property list, resolving layer names and +handling reactive vars. If PLIST is a symbol, resolve it via `tp--resolve-props'. If PLIST is a plist, also process it via `tp--resolve-props' to handle anonymous reactive layers. If resolution fails, return PLIST unchanged (for backward compatibility)." (or (tp--resolve-props plist) plist)) +;;;###autoload (defun tp-layer-reset () "Reset all layer definitions. Clears both `tp-layer-alist' and `tp-layer-groups'. @@ -1204,7 +1231,8 @@ untouched." Used by layer stack functions that need tp-name for identification. LAYER-SPEC can be: -- A symbol (non-parameterized layer name from define-tp or tp--define-layer-internal) +- A symbol (non-parameterized layer name from define-tp or + tp--define-layer-internal) - A list (LAYER-NAME ARG) for parameterized layers from define-tp - A plist for inline layer definition - A list (NAME &rest PLIST) for named inline layer" diff --git a/tp-ops.el b/tp-ops.el index bd0513c..4a0d3d0 100644 --- a/tp-ops.el +++ b/tp-ops.el @@ -48,7 +48,8 @@ Supports multiple calling conventions: 3. String region: (START END PROPS STRING) 4. Entire string with plist: (STRING PROP VAL ...) 5. Entire string with layer: (STRING LAYER-NAME ARG) -6. Entire string with layer and extra props: (STRING LAYER-NAME ARG PROP VAL ...)" +6. Entire string with layer and extra props: + (STRING LAYER-NAME ARG PROP VAL ...)" (let (object start finish props) (cond ;; First arg is a string - apply to entire string @@ -219,7 +220,8 @@ Returns: For buffers, (START . END) cons. For strings, the result string." (defun tp-reset (start-or-string &optional end-or-prop props-or-val &rest rest) "Completely replace all text properties with PROPS. Like `tp-set' but replaces ALL existing properties. -For tp-text, embedded text properties are preserved (props override if there's a conflict). +For tp-text, embedded text properties are preserved (props override +if there's a conflict). **String Modification Behavior:** - Entire string form (tp-reset STRING ...): Returns a NEW propertized string diff --git a/tp-reactive.el b/tp-reactive.el index 6d865e8..10c40de 100644 --- a/tp-reactive.el +++ b/tp-reactive.el @@ -153,10 +153,10 @@ WHERE indicates where the variable was set: - a buffer for `setq-local' Updates all layers that depend on this variable. -Only 'set' operations trigger updates because: -- 'let'/'unlet': Temporary bindings that will be restored, no need to update UI -- 'makunbound': Variable is being undefined, not a value change -- 'defvaralias': Aliasing, the actual value change will trigger a separate 'set' +Only `set' operations trigger updates because: +- `let'/`unlet': Temporary bindings that will be restored, no need to update UI +- `makunbound': Variable is being undefined, not a value change +- `defvaralias': Aliasing, the actual value change will trigger a separate `set' When `tp--batch-update-active' is non-nil, buffer updates are deferred until the batch completes. Layer definitions are still updated immediately. @@ -335,9 +335,10 @@ Also adds variable watchers so changes to data vars trigger computed updates." (defun tp--ensure-reactive-variables (var-symbols) "Ensure all VAR-SYMBOLS are defined as global variables. VAR-SYMBOLS can be a list of symbols or cons cells (SYMBOL . INITIAL-VALUE). -If a variable is not bound, define it with the initial value (nil if not specified). -If a variable has an explicit initial value (cons cell), always update it to allow -re-definition to change initial values." +If a variable is not bound, define it with the initial value (nil if +not specified). +If a variable has an explicit initial value (cons cell), always update +it to allow re-definition to change initial values." (dolist (sym var-symbols) (let* ((is-cons (and (consp sym) (not (tp--reactive-symbol-p sym)))) (var-sym (cond @@ -353,6 +354,7 @@ re-definition to change initial values." (unless (boundp var-sym) (set var-sym initial-val)))))) +;;;###autoload (defun tp-reactive-reset () "Reset all reactive text property watchers and dependencies." (interactive) diff --git a/tp-render.el b/tp-render.el index 96c7c1f..bf5659d 100644 --- a/tp-render.el +++ b/tp-render.el @@ -353,7 +353,8 @@ the reactive variable and the `tp-text' property - keeps the raw text. If tp-text is a string different from current text, replace the text. When PRESERVE-PROPS is non-nil, existing text properties are preserved on the replaced text (used by tp-set and tp-add). -MERGE-MODE is retained for backward compatibility but no longer affects behavior. +MERGE-MODE is retained for backward compatibility but no longer +affects behavior. All modes now preserve embedded text properties from tp-text, with props taking precedence over embedded props when there's a conflict. Returns (PROPS NEW-END NEW-OBJECT) where PROPS is the updated props, diff --git a/tp-run-shuffled.el b/tp-run-shuffled.el new file mode 100644 index 0000000..c761abc --- /dev/null +++ b/tp-run-shuffled.el @@ -0,0 +1,63 @@ +;;; tp-run-shuffled.el --- run the ERT suite in a shuffled order -*- lexical-binding: t -*- + +;; Copyright (C) 2024-2026 Geekinney + +;; Author: Geekinney (kinneyzhang666@gmail.com) + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 3 of +;; the License, or (at your option) any later version. + +;;; Commentary: + +;; Development script (not part of the installed package): runs every +;; loaded ERT test individually in a shuffled order to catch +;; inter-test state leaks that the fixed definition order hides. +;; +;; ERT's `member' selector does NOT control execution order (tests +;; always run in definition order), so this script loops over the +;; shuffled names and runs each test on its own. +;; +;; Usage (after loading tp and all *-tests.el files): +;; emacs -Q --batch -L . -l tp.el -l tp-tests.el ... -l tp-run-shuffled.el +;; or: make test-shuffled +;; +;; The shuffle seed is printed; reproduce a failing order with +;; SHUFFLE_SEED= make test-shuffled + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defun tp-run-shuffled--permute (list state) + "Return LIST deterministically permuted from integer seed STATE." + (let* ((v (vconcat list)) + (n (length v))) + (dotimes (i (1- n)) + ;; Simple LCG so a printed seed reproduces the exact order. + (setq state (mod (+ (* state 1103515245) 12345) 2147483648)) + (let* ((j (+ i (mod state (- n i)))) + (tmp (aref v i))) + (aset v i (aref v j)) + (aset v j tmp))) + (append v nil))) + +(let* ((names (mapcar #'ert-test-name (ert-select-tests t t))) + (seed (let ((env (getenv "SHUFFLE_SEED"))) + (if (and env (not (string-empty-p env))) + (string-to-number env) + (progn (random t) (abs (random 1000000)))))) + (shuffled (tp-run-shuffled--permute names seed)) + (unexpected 0)) + (message "tp: running %d tests in shuffled order (SHUFFLE_SEED=%d)" + (length shuffled) seed) + (dolist (name shuffled) + (let ((stats (ert-run-tests-batch name))) + (cl-incf unexpected (ert-stats-completed-unexpected stats)))) + (message "tp: shuffled run complete: %d tests, %d unexpected (seed %d)" + (length shuffled) unexpected seed) + (kill-emacs (if (zerop unexpected) 0 1))) + +;;; tp-run-shuffled.el ends here diff --git a/tp-tests.el b/tp-tests.el index a021dee..f4c84ba 100644 --- a/tp-tests.el +++ b/tp-tests.el @@ -34,6 +34,32 @@ leak between tests regardless of how BODY exits." ,@body) (tp-layer-reset))) +;; Reactive test variables set with `setq' inside tests. They must be +;; dynamically bound (variable watchers depend on it), so plain +;; `defvar' declarations are used. +(defvar tp-test-first-name nil "Test variable for computed properties.") +(defvar tp-test-last-name nil "Test variable for computed properties.") +(defvar tp-test-full-name nil "Test variable for computed properties.") +(defvar tp-test-dc-color nil "Test variable for data+compute layer.") +(defvar tp-test-dc-first nil "Test variable for data+compute layer.") +(defvar tp-test-dc-last nil "Test variable for data+compute layer.") +(defvar tp-test-dc-full-name nil "Test variable for data+compute layer.") +(defvar tp-test-init-color nil "Test variable for initial values.") +(defvar tp-test-init-name nil "Test variable for initial values.") +(defvar tp-test-init-other nil "Test variable for initial values.") +(defvar tp-test-global-color nil "Test variable for global updates.") +(defvar tp-test-redef-color nil "Test variable for layer re-definition.") +(defvar tp-test-watch-var nil "Test variable for watch callbacks.") +(defvar tp-test-compute-src nil "Test variable for compute source.") +(defvar tp-test-compute-out nil "Test variable for compute output.") +(defvar tp-test-group-color nil "Test variable for layer groups.") +(defvar tp-test-name-part1 nil "Test variable for tp-text updates.") +(defvar tp-test-name-part2 nil "Test variable for tp-text updates.") +(defvar tp-test-batch-color nil "Test variable for batch updates.") +(defvar tp-test-fg nil "Test variable for batch foreground.") +(defvar tp-test-bg nil "Test variable for batch background.") +(defvar tp-test-amount nil "Test variable for transform updates.") + ;;; ============================================================ ;;; Basic Text Property Functions Tests ;;; ============================================================ @@ -863,7 +889,7 @@ nothing and returns the available count." (tp-set 12 17 '(marker t) str) (let ((result nil)) (tp--search-do - (lambda (match obj) + (lambda (match _obj) (push (car match) result)) 'marker nil str) (should (= (length result) 2)) @@ -878,7 +904,7 @@ nothing and returns the available count." (tp-set 13 18 '(marker t)) (let ((result nil)) (tp--search-do - (lambda (match obj) + (lambda (match _obj) (push (car match) result)) 'marker nil nil 1 18) (should (= (length result) 2)) @@ -955,7 +981,7 @@ nothing and returns the available count." (tp-set 5 8 '(marker t)) (tp-set 9 12 '(marker t)) (let ((positions nil)) - (tp-search-map (lambda (txt start end idx) + (tp-search-map (lambda (_txt start end idx) (push (list start end idx) positions) (format "[%d]" idx)) 'marker nil nil 1 12) @@ -3212,7 +3238,7 @@ text content but different properties, the properties should be updated." ;; Should contain both the plist and symbol (should (member 'bold (if (listp face-val) face-val (list face-val)))) ;; Should have foreground red - (should (or (eq face-val '(:foreground "red")) + (should (or (equal face-val '(:foreground "red")) (and (listp face-val) (cl-some (lambda (f) (and (listp f)