From ca2f02dcdf4e4d32859ddf3824ade8be6e480d72 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sun, 26 Jul 2026 21:18:44 +0800 Subject: [PATCH] Add tp-doctest.el: README examples as executable tests 63 assertions reproduce README code blocks and compare against the exact documented outputs; make doctest runs them in batch and exits non-zero on any mismatch, so docs and code cannot silently drift again. Wired into the Makefile and mentioned in both READMEs. Co-Authored-By: Claude Fable 5 --- CHANGELOG.md | 5 +- Makefile | 6 +- README.md | 6 +- README_CN.md | 3 +- tp-doctest.el | 554 ++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 569 insertions(+), 5 deletions(-) create mode 100644 tp-doctest.el diff --git a/CHANGELOG.md b/CHANGELOG.md index d903d10..8747395 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -183,7 +183,10 @@ Test infrastructure: - `tp-member`: like `tp-at`, but distinguishes "property present with value nil" from "property absent" (plist-member-style result). -- `Makefile` with `test` / `compile` / `clean` targets. +- `Makefile` with `test` / `doctest` / `compile` / `clean` targets. +- `tp-doctest.el`: executable documentation tests — 63 assertions + reproducing README examples and comparing against their exact + documented outputs (`make doctest`). - Per-module regression test suites: `tp-core-tests.el`, `tp-ops-tests.el`, `tp-builtins-tests.el`, `tp-layer-tests.el`, `tp-stack-tests.el`, `tp-search-tests.el`, `tp-render-tests.el` — diff --git a/Makefile b/Makefile index 954d84b..504c462 100644 --- a/Makefile +++ b/Makefile @@ -2,6 +2,7 @@ # # Usage: # make test # run all ERT test suites +# make doctest # execute README examples against the code # make compile # byte-compile all modules # make clean # remove compiled files # @@ -16,12 +17,15 @@ 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) -.PHONY: test compile clean +.PHONY: test doctest compile clean test: $(EMACS) -Q --batch $(LOADPATH) -l tp.el $(patsubst %,-l %,$(TESTS)) \ -f ert-run-tests-batch-and-exit +doctest: + $(EMACS) -Q --batch $(LOADPATH) -l tp-doctest.el + compile: clean $(EMACS) -Q --batch $(LOADPATH) -f batch-byte-compile $(SRC) diff --git a/README.md b/README.md index 13a4259..61f96a9 100644 --- a/README.md +++ b/README.md @@ -377,8 +377,10 @@ The modules and their roles: | `tp-palette.el` | Light/dark color palette data | | `tp-builtins.el` | Built-in layers, palette gallery, display-buffer helpers | -A `Makefile` is included: `make test` runs all ERT suites, `make compile` -byte-compiles the modules, and `make clean` removes compiled files. +A `Makefile` is included: `make test` runs all ERT suites, `make doctest` +executes the README examples against the code (`tp-doctest.el`), +`make compile` byte-compiles the modules, and `make clean` removes +compiled files. --- diff --git a/README_CN.md b/README_CN.md index 7f40035..6dbecc6 100644 --- a/README_CN.md +++ b/README_CN.md @@ -376,7 +376,8 @@ | `tp-palette.el` | 亮色/暗色调色板数据 | | `tp-builtins.el` | 内置属性层、调色板画廊、display-buffer 辅助工具 | -项目附带 `Makefile`：`make test` 运行所有 ERT 测试套件，`make compile` +项目附带 `Makefile`：`make test` 运行所有 ERT 测试套件，`make doctest` +将 README 示例作为可执行测试运行（`tp-doctest.el`），`make compile` 字节编译各模块，`make clean` 清除编译产物。 --- diff --git a/tp-doctest.el b/tp-doctest.el new file mode 100644 index 0000000..b30dc2a --- /dev/null +++ b/tp-doctest.el @@ -0,0 +1,554 @@ +;;; tp-doctest.el --- executable README examples -*- 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: + +;; Executable documentation tests: each assertion reproduces an example +;; from README.md / README_CN.md (the code blocks are identical across +;; the two files) and compares the result against the exact output the +;; docs claim. Run with `make doctest'; the batch process exits +;; non-zero if any assertion fails. When changing a README example, +;; update the matching assertion here in the same commit. + +;;; Code: + +(require 'tp) +(tp-layer-reset) + +(defvar fails 0) +(defvar 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)) + (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))))) +(defmacro chk-str (label expected &rest body) + "Compare prin1 form (covers propertized strings)." + `(chk ,label ,expected (prin1-to-string (progn ,@body)))) + +;; ---- Quick Start ---- +(chk-str "QS-set" "#(\"hello\" 0 5 (face bold))" (tp-set "hello" 'face 'bold)) +(chk "QS-layer" 'spotlight + (progn + (define-tp spotlight () '(face (:background "yellow"))) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 6 'spotlight) + (tp-layer-top 1 6)))) +(defvar accent-color "red") +(chk "QS-reactive" '(:foreground "blue") + (progn + (define-tp accent () + :props '(face (:foreground $accent-color))) + (with-temp-buffer + (insert "Hello") + (tp-push-layer 1 6 'accent) + (setq accent-color "blue") + (tp-at 1 'face)))) + +;; ---- Features ---- +(chk "F-getstyle" '((0 5 wave)) + (let ((str (copy-sequence "Hello World"))) + (tp-set 0 5 '(face (:underline (:color "green" :style wave))) str) + (tp-get str 'face :underline :style))) +(chk "F-getmulti" '((0 5 (:color "green" :style wave))) + (let ((str (copy-sequence "Hello World"))) + (tp-set 0 5 '(face (:underline (:color "green" :style wave))) str) + (tp-get str 'face :underline '(:color :style)))) +(chk "F-dupface" '((:foreground "red") (:background "green") bold) + (tp-at 0 'face (tp-set "emacs" + 'face 'bold + 'face '(:background "green") + 'face '(:foreground "red")))) +(chk "F-override" '(:foreground "yellow") + (tp-at 0 'face (tp-set "emacs" + 'face '(:foreground "red") + 'face '(:foreground "yellow")))) +(chk "F-search" '((0 5 t) (12 17 t)) + (let ((my-string (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-search my-string 'marker))) +(chk "F-searchmap" "HELLO world HELLO" + (let ((my-string (copy-sequence "hello world hello"))) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-search-map #'upcase 'marker nil my-string) + (substring-no-properties my-string))) +(chk "F-teaser-fullname" '(help-echo "John Doe" face (:foreground "purple") tp-name full-name-layer) + (progn + (define-tp full-name-layer () + :props '(help-echo $full-name face (:foreground $name-color)) + :data '((first-name . "John") (last-name . "Doe") (name-color . "purple")) + :compute '((full-name (lambda () (concat first-name " " last-name)))) + :watch '((first-name (lambda (new old layer) + (message "Name changed from %s to %s" old new))))) + (tp-layer-props 'full-name-layer))) + +;; ---- tp-set my-style ---- +(chk-str "S-mystyle" "#(\" \" 0 1 (face (:foreground \"blue\") tp-name my-style))" + (progn + (define-tp my-style () + :props '(face (:foreground $my-color)) + :data '((my-color . "blue"))) + (tp-set " " 'my-style))) + +;; ---- tp-member ---- +(chk "M-member-str" '((face nil) nil) + (let ((str (copy-sequence "Hello"))) + (tp-set 0 5 '(face nil) str) + (list (tp-member 0 'face str) + (tp-member 0 'display str)))) +(chk "M-member-buf" '(face bold) + (with-temp-buffer + (insert "Hello") + (tp-set 1 6 '(face bold)) + (tp-member 1 'face))) + +;; ---- tp-remove nested ---- +(chk "R-remove-nested" '(:color "blue") + (let ((original (propertize "Hello" 'face '(:underline (:style wave :color "blue"))))) + (let ((result (tp-remove original 'face :underline '(:style)))) + (tp-at 0 '(face :underline) result)))) + +;; ---- tp-forward / tp-backward ---- +(chk "N-fwd-t" 7 + (with-temp-buffer + (insert "Hello World Test") + (tp-set 7 12 '(marker t)) + (goto-char 1) + (let ((match (tp-forward 'marker t))) + (when match (prop-match-beginning match))))) +(chk "N-fwd-nil" '(1 7) + (with-temp-buffer + (insert "Hello World Test") + (tp-set 7 12 '(marker t)) + (goto-char 1) + (let ((match (tp-forward 'marker))) + (list (prop-match-beginning match) (prop-match-end match))))) +(chk "N-bwd-t" '(7 12) + (with-temp-buffer + (insert "Hello World Test") + (tp-set 7 12 '(marker t)) + (goto-char (point-max)) + (let ((match (tp-backward 'marker t))) + (list (prop-match-beginning match) (prop-match-end match))))) +(chk "N-fwd-heading" 'heading + (with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(type heading)) + (goto-char 1) + (let ((match (tp-forward 'type 'heading))) + (when match (prop-match-value match))))) +(chk "N-fwd-string" '((0 5 t) (12 17 t)) + (let ((my-string (copy-sequence "Hello World Hello"))) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-forward 'marker nil my-string 2))) + +;; ---- tp-forward-do / tp-search-map examples ---- +(chk "DO-fdo" "hello world HELLO" + (let ((my-string (copy-sequence "hello world hello"))) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-forward-do #'upcase 'marker nil my-string 2) + (substring-no-properties my-string))) +(chk "DO-bdo" "HELLO world hello" + (let ((my-string (copy-sequence "hello world hello"))) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-backward-do #'upcase 'marker nil my-string 2) + (substring-no-properties my-string))) +(chk "DO-fdo-pos" '("hello world HELLO" (12 17)) + (let ((my-string (copy-sequence "hello world hello")) + (match-info nil)) + (tp-set 0 5 '(marker t) my-string) + (tp-set 12 17 '(marker t) my-string) + (tp-forward-do + (lambda (text start end) + (setq match-info (list start end)) + (upcase text)) + 'marker nil my-string 2) + (list (substring-no-properties my-string) match-info))) +(chk "SM-idx" '("AAA BBB CCC" ((0 0 3) (1 4 7) (2 8 11))) + (let ((my-string (copy-sequence "aaa bbb ccc")) + (positions nil)) + (tp-set 0 3 '(marker t) my-string) + (tp-set 4 7 '(marker t) my-string) + (tp-set 8 11 '(marker t) my-string) + (tp-search-map + (lambda (text start end idx) + (push (list idx start end) positions) + (upcase text)) + 'marker nil my-string) + (list (substring-no-properties my-string) (nreverse positions)))) + +;; ---- Layer definitions ---- +(chk "L-format3" '((:foreground "blue") "status: active") + (progn + (tp-layer-reset) + (define-tp my-reactive-layer () + :props '(face (:foreground $my-color) help-echo $status-note) + :data '((my-color . "red") (status . "active")) + :compute '((status-note (lambda () (concat "status: " status)))) + :watch '((my-color (lambda (new old layer) (message "Color changed!")))) + :transform (lambda (text) (upcase text))) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'my-reactive-layer) + (setq my-color "blue") + (list (tp-at 1 'face) (tp-at 1 'help-echo))))) +(chk "L-statuscolors" 3 + (progn + (tp-layer-reset) + (define-tp highlight () + '(face (:background "yellow" :foreground "black"))) + (define-tp error () + '(face (:background "red" :foreground "white"))) + (define-tp info () + '(face (:background "blue" :foreground "white"))) + (define-tps status-colors () + 'highlight 'error 'info) + (length (tp-group-props 'status-colors)))) +(chk "L-moon" '(display "🌕") + (progn + (tp-layer-reset) + (define-tps moon-phases () + '("new" . (display "🌑")) + '("waxing-crescent" . (display "🌒")) + '("first-quarter" . (display "🌓")) + '("full" . (display "🌕"))) + (tp-layer-props 'moon-phases-full))) +(chk-str "L-paramgroup" + "#(\"emacs\" 0 5 (face (:foreground \"orange\") tp-name tp-test-l1 tp-layers ((face (:foreground \"red\") tp-name tp-test-l2) (face (:background \"green\") tp-name tp-test-l3))))" + (progn + (tp-layer-reset) + (define-tp tp-test-l1 (color) + `(face (:foreground ,color))) + (define-tp tp-test-l2 (color) + `(face (:foreground ,color))) + (define-tp tp-test-l3 () + '(face (:background "green"))) + (define-tps tp-test-group1 (color) + `(tp-test-l1 ,color) + '(tp-test-l2 "red") + 'tp-test-l3) + (tp-set "emacs" 'tp-test-group1 "orange"))) +(chk "L-props" '((face bold help-echo "tip") + (face bold help-echo "tip" tp-name my-layer)) + (progn + (tp-layer-reset) + (define-tp my-layer () + '(face bold help-echo "tip")) + (list (tp-layer-props 'my-layer) + (tp-layer-props 'my-layer t)))) +(chk "L-groupprops" 2 + (progn + (tp-layer-reset) + (define-tp layer1 () '(face bold)) + (define-tp layer2 () '(face italic)) + (define-tps my-group () + 'layer1 'layer2) + (length (tp-group-props 'my-group)))) +(chk "L-undeflayer" nil + (progn + (tp-layer-reset) + (define-tp temp-layer () '(face bold)) + (tp-undefine-layer 'temp-layer) + (tp-layer-props 'temp-layer))) +(chk "L-undefgroup" nil + (progn + (tp-layer-reset) + (define-tp l1 () '(face bold)) + (define-tps my-group () + 'l1) + (tp-undefine-group 'my-group) + (assoc 'my-group tp-layer-groups))) +(chk "L-reset" '(nil nil) + (progn + (define-tp test-layer () '(face bold)) + (tp-layer-reset) + (list tp-layer-alist tp-layer-groups))) +(defvar my-reactive-color "red") +(chk "L-reactivereset" '(face (:foreground "red")) + (progn + (tp-layer-reset) + (define-tp reactive-layer () + :props '(face (:foreground $my-reactive-color))) + (tp-reactive-reset) + (tp-layer-props 'reactive-layer))) + +;; ---- tp-put-layer / tp-push-layer ---- +(chk "P-base" 'base + (progn + (tp-layer-reset) + (define-tp base () '(face default)) + (define-tp highlight () '(face (:background "yellow"))) + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 'base 0) + (tp-at 1 'tp-name)))) +(chk "P-idx1" 2 + (progn + (tp-layer-reset) + (define-tp base () '(face default)) + (define-tp highlight () '(face (:background "yellow"))) + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 'base 0) + (tp-put-layer 1 10 'highlight 1) + (tp-layer-count 1 10)))) +(chk "P-bottom" 'base + (progn + (tp-layer-reset) + (define-tp base () '(face default)) + (define-tp info () '(face (:foreground "blue"))) + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 'base 0) + (tp-put-layer 1 10 'info -1) + (tp-layer-top 1 10)))) +(chk "P-inline" '(bold "tip") + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 '(face bold help-echo "tip") 0) + (list (tp-at 1 'face) (tp-at 1 'help-echo)))) +(chk "P-names" '(bold (layer-a layer-b)) + (progn + (tp-layer-reset) + (define-tp layer-a () '(face bold)) + (define-tp layer-b () '(face italic)) + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 '(layer-a layer-b) 0) + (list (tp-at 1 'face) (tp-layer-list 1 10))))) +(chk "P-param" '(:foreground "red") + (progn + (tp-layer-reset) + (define-tp tp-color (color) + `(face (:foreground ,color))) + (with-temp-buffer + (insert "Hello World") + (tp-put-layer 1 10 '(tp-color "red") 0) + (tp-at 1 'face)))) +(chk "P-stack" '(:face (:background "yellow") :top highlight :layers (highlight base) :hidden 1) + (progn + (tp-layer-reset) + (define-tp base () '(face default)) + (define-tp highlight () '(face (:background "yellow"))) + (with-temp-buffer + (insert "Hello World") + (tp-push-layer 1 10 'base) + (tp-push-layer 1 10 'highlight) + (list :face (tp-at 1 'face) + :top (tp-layer-top 1 10) + :layers (tp-layer-list 1 10) + :hidden (length (tp-at 1 'tp-layers)))))) + +;; ---- Utilities ---- +(chk "U-intervals" '((0 5 (face bold)) (5 6 nil) (6 11 (face italic))) + (with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(face bold)) + (tp-set 7 12 '(face italic)) + (tp-intervals 1 12))) +(chk "U-intervalsmap" '((0 5 bold) (5 6 nil) (6 11 italic)) + (with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(face bold)) + (tp-set 7 12 '(face italic)) + (tp-intervals-map + (lambda (start end props belows) + (ignore belows) + (list start end (plist-get props 'face))) + 1 12))) +(chk "U-plist" '(help-echo "Tip" face italic) + (with-temp-buffer + (insert "Hello World") + (tp-set 1 6 '(face bold help-echo "Tip")) + (tp-set 7 12 '(face italic)) + (tp-plist 1 12))) +(chk "U-emptyp" '(t nil) + (let* ((str "text") + (new (tp-set str 'face 'bold))) + (list (tp-empty-p str) (tp-empty-p new)))) +(chk "U-emptyp2" t (tp-empty-p "plain text")) +(chk-str "U-popbuffer" "#(\"Important\" 0 9 (face (:foreground \"red\" :weight bold)))" + (progn + (tp-pop-to-buffer "*tp-demo*" + (insert (tp-set "Important" 'face '(:foreground "red" :weight bold)) + " message\n")) + (with-current-buffer "*tp-demo*" + (buffer-substring 1 10)))) +(chk "U-parsecolor1" "red" (tp-parse-color "red")) +(chk "U-parsecolor2" t + (and (member (tp-parse-color '("white" . "black")) '("white" "black")) t)) + +;; ---- Practical examples ---- +(chk "X-taskstatus" 3 + (progn + (tp-layer-reset) + (define-tp status-todo () '(face (:foreground "gray"))) + (define-tp status-progress () '(face (:foreground "yellow"))) + (define-tp status-done () '(face (:foreground "green"))) + (define-tps task-status () 'status-todo 'status-progress 'status-done) + (length (tp-group-props 'task-status)))) +(chk "X-temphl" '(face (:background "yellow")) + (progn + (tp-layer-reset) + (define-tp temp-highlight () + '(face (:background "yellow"))) + (tp-layer-props 'temp-highlight))) +(chk "X-synhl" 'code-error + (progn + (tp-layer-reset) + (define-tp code-base () + '(face font-lock-keyword-face)) + (define-tp code-error () + '(face (:underline (:color "red" :style wave)) + help-echo "Syntax error")) + (define-tp code-debug () + '(face (:background "dark blue"))) + (with-temp-buffer + (insert (make-string 100 ?x)) + (tp-push-layer 1 100 'code-base) + (tp-push-layer 50 60 'code-error) + (tp-layer-top 50 60)))) + +;; ---- Reactive chapter ---- +(defvar status-color nil) +(chk "RC-watch" '("Layer monitored-layer: color changed from nil to red" + "Layer monitored-layer: color changed from red to green") + (let ((msgs nil)) + (tp-layer-reset) + (cl-letf* (((symbol-function 'message) + (lambda (fmt &rest args) + (when fmt (push (apply #'format fmt args) msgs)) + nil))) + (define-tp monitored-layer () + :props '(face (:foreground $status-color)) + :watch '((status-color + (lambda (new-val old-val layer-name) + (message "Layer %s: color changed from %s to %s" + layer-name old-val new-val))))) + (setq status-color "red") + (setq status-color "green")) + (nreverse msgs))) +(chk "RC-groups" '(face (:foreground "green") tp-name status-indicators-success) + (progn + (tp-layer-reset) + (define-tps status-indicators () + '("success" :props (face (:foreground $success-color)) + :data ((success-color . "green"))) + '("warning" :props (face (:foreground $warning-color)) + :data ((warning-color . "orange"))) + '("error" :props (face (:foreground $error-color)) + :data ((error-color . "red")))) + (tp-layer-props 'status-indicators-success))) +(chk "RC-batch" '(:foreground "red" :background "blue") + (progn + (tp-layer-reset) + (define-tp themed-text () + :props '(face (:foreground $fg-color :background $bg-color)) + :data '((fg-color . "white") (bg-color . "black"))) + (with-temp-buffer + (insert "Hello World") + (tp-set 1 12 'themed-text) + (setq fg-color "yellow") + (setq bg-color "navy") + (tp-with-batch-updates + (setq fg-color "red") + (setq bg-color "blue")) + (tp-at 1 'face)))) +(defvar my-face-color "blue") +(chk "RC-anon" '((:foreground "blue") (:foreground "red")) + (progn + (tp-layer-reset) + (setq my-face-color "blue") + (with-temp-buffer + (insert "Hello World") + (tp-set 1 10 '(face (:foreground $my-face-color))) + (let ((before (tp-at 1 'face))) + (setq my-face-color "red") + (list before (tp-at 1 'face)))))) + +;; ---- Theme example (as in the docs) ---- +(defvar theme-fg "white") +(defvar theme-bg "black") +(defvar theme-accent "cyan") +(chk "RC-theme" '(:before ((:foreground "cyan" :weight bold) + (:foreground "white" :background "black")) + :after ((:foreground "blue" :weight bold) + (:foreground "black" :background "white"))) + (progn + (tp-layer-reset) + (setq theme-fg "white" theme-bg "black" theme-accent "cyan") + (define-tp code-text () + :props '(face (:foreground $theme-fg :background $theme-bg))) + (define-tp code-keyword () + :props '(face (:foreground $theme-accent :weight bold))) + (defun switch-to-light-theme () + (interactive) + (setq theme-fg "black") + (setq theme-bg "white") + (setq theme-accent "blue")) + (defun switch-to-dark-theme () + (interactive) + (setq theme-fg "white") + (setq theme-bg "black") + (setq theme-accent "cyan")) + (with-temp-buffer + (insert "(defun greet () (let (x) x))") + (tp-set (point-min) (point-max) 'code-text) + (tp-match-set '("defun" "defvar" "let" "if" "when") 'code-keyword) + (let ((before (list (tp-at 2 'face) (tp-at 10 'face)))) + (switch-to-light-theme) + (list :before before + :after (list (tp-at 2 'face) (tp-at 10 'face))))))) + +;; ---- Regexp and string-form examples ---- +(tp-layer-reset) +(chk "X-buffer-return" '(1 . 10) + (let ((my-buffer (generate-new-buffer "*test*"))) + (with-current-buffer my-buffer (insert "Hello World")) + (prog1 (tp-set 1 10 '(face italic) my-buffer) + (kill-buffer my-buffer)))) +(chk-str "X-regexp-case-fold" "#(\"Hello WORLD\" 0 5 (face bold) 6 11 (face bold))" + (tp-regexp-set "[A-Z]+" '(face bold) "Hello WORLD")) +(chk-str "X-regexp-multi" "#(\"abc 123 XYZ\" 0 3 (face bold) 4 7 (face bold) 8 11 (face bold))" + (tp-regexp-set '("[0-9]+" "[A-Z]+") '(face bold) "abc 123 XYZ")) +(chk "X-regexp-reset-new-string" '((face italic) (help-echo "original")) + (let ((str (copy-sequence "abc 123 def"))) + (tp-set 4 7 '(help-echo "original") str) + (let ((result (tp-regexp-reset "[0-9]+" '(face italic) str))) + (list (tp-at 4 result) (tp-at 4 str))))) +(chk "X-regexp-add-new-string" '((face italic help-echo "number") (help-echo "number")) + (let ((str (copy-sequence "abc 123 def"))) + (tp-set 4 7 '(help-echo "number") str) + (let ((result (tp-regexp-add "[0-9]+" '(face italic) str))) + (list (tp-at 4 result) (tp-at 4 str))))) +(chk "X-match-per-pattern-order" '((7 . 12) (1 . 6) (14 . 19)) + (with-temp-buffer + (insert "Hello world, Hello again") + (tp-match-set '("world" "Hello") '(face bold)))) +(chk "X-do-shortfall-all-or-nothing" '(1 "hello world") + (let ((str (copy-sequence "hello world"))) + (tp-set 0 5 '(marker t) str) + (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)) + +;;; tp-doctest.el ends here