diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f705a8e..12bd287 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,11 +1,15 @@ name: CI -on: [push, pull_request] +on: + push: + branches: + - main + pull_request: {} jobs: ci: runs-on: ubuntu-latest strategy: matrix: - emacs_version: [26, 27, "master"] + emacs_version: [26, 27, 28, 29] steps: - name: Checkout uses: actions/checkout@v2 @@ -13,4 +17,4 @@ jobs: env: VERSION: ${{ matrix.emacs_version }} run: >- - make docker CMD="make -k compile checkdoc longlines" + make docker CMD="make -k compile checkdoc longlines unit" diff --git a/.gitignore b/.gitignore index 1929ed3..b6e48db 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ /temp/ +/vendor/ *.elc diff --git a/Makefile b/Makefile index 7ead164..13a2fcd 100644 --- a/Makefile +++ b/Makefile @@ -51,6 +51,7 @@ longlines: ## Check for long lines | sed '/[l]onglines-start/,/longlines-stop/d' \ | grep -E '.{80}' \ | grep -E -v '\[.+\]: (#|http)' \ + | grep -E -v 'https?://' \ | sed "s/^/$$file:long line: /" \ | grep . && exit 1 || true ;\ done @@ -89,3 +90,16 @@ clean: ## Remove build artifacts .PHONY: docker docker: ## Start a Docker shell; e.g. make docker VERSION=25.3 @scripts/docker.bash "$(VERSION)" "$(CMD)" + +BUTTERCUP_VER := 1.34 +BUTTERCUP := vendor/buttercup-$(BUTTERCUP_VER) + +$(BUTTERCUP): + @rm -rf $(BUTTERCUP) && mkdir -p $(BUTTERCUP) + @curl -fsSL https://github.com/jorgenschaefer/emacs-buttercup/archive/refs/tags/v$(BUTTERCUP_VER).tar.gz -o $(BUTTERCUP).tar.gz + @tar -xf $(BUTTERCUP).tar.gz --strip-components=1 -C $(BUTTERCUP) + @rm $(BUTTERCUP).tar.gz + +.PHONY: unit +unit: $(BUTTERCUP) ## Run unit tests + @$(BUTTERCUP)/bin/buttercup test -L $(BUTTERCUP) -L . diff --git a/README.md b/README.md index d3de2d5..68f6d8d 100644 --- a/README.md +++ b/README.md @@ -578,7 +578,6 @@ Instead of defining a patch that includes the complete definition of ... (el-patch-swap "restarted" "started") ...) - (restart-args ...) (el-patch-remove (kill-emacs-hook ...)) (el-patch-swap (save-buffers-kill-emacs) diff --git a/test/el-patch-test.el b/test/el-patch-test.el new file mode 100644 index 0000000..900545f --- /dev/null +++ b/test/el-patch-test.el @@ -0,0 +1,293 @@ +;; -*- lexical-binding: t -*- + +;; `el-patch-unit-tests' - unit tests using Buttercup. +;; +;; Setup originally stolen from Apheleia and modified. + +(require 'el-patch) +(require 'el-patch-template) +(require 'buttercup) + +(require 'cl-lib) + +(describe "el-patch--resolve" + (cl-macrolet ((testcases + (description &rest specs) + `(it ,description + ,@(mapcan + (lambda (spec) + (cl-destructuring-bind (input old new) spec + `((expect (el-patch--resolve ',input nil) + :to-equal '(,old)) + (expect (el-patch--resolve ',input t) + :to-equal '(,new))))) + specs)))) + (testcases + "does no-ops when no patch directives used" + + ((foo bar baz) + (foo bar baz) + (foo bar baz)) + + ([foo bar baz] + [foo bar baz] + [foo bar baz]) + + ((oh my how . improper) + (oh my how . improper) + (oh my how . improper)) + + ) + (testcases + "handles el-patch-add and el-patch-remove" + + ((foo (el-patch-add bar) baz) + (foo baz) + (foo bar baz)) + + ([foo (el-patch-add bar) baz] + [foo baz] + [foo bar baz]) + + ((foo (el-patch-add bar baz) quux) + (foo quux) + (foo bar baz quux)) + + (((el-patch-add foo) bar baz) + (bar baz) + (foo bar baz)) + + ((foo bar (el-patch-add baz)) + (foo bar) + (foo bar baz)) + + (((el-patch-add foo) bar (el-patch-add baz)) + (bar) + (foo bar baz)) + + (((el-patch-add foo)) + () + (foo)) + + (((el-patch-add foo) bar (el-patch-remove baz)) + (bar baz) + (foo bar)) + + ) + (testcases + "handles el-patch-concat" + + ((el-patch-concat "foo" "bar") + "foobar" + "foobar") + + ((el-patch-concat "foo" (el-patch-add "bar") "baz") + "foobaz" + "foobarbaz") + + ((foo (el-patch-concat "test" (el-patch-swap "1" "2")) bar) + (foo "test1" bar) + (foo "test2" bar)) + + ))) + +(describe "el-patch--process-template" + (cl-flet ((apply-templates + (form templates) + (el-patch--apply-template + form + (mapcar + (lambda (template) + (list :template template + :old (el-patch--partial-old-resolve template) + :matched nil)) + templates)))) + (cl-macrolet ((testcases + (description &rest specs) + `(it ,description + ,@(mapcar + (lambda (spec) + (cl-destructuring-bind (form templates expected) spec + `(expect (apply-templates ',form ',templates) + :to-equal ',expected))) + specs)))) + + (testcases + "provides basic functionality" + + ((foo (1 2 3 unwanted 4 5 6) quux) + ((... 3 (el-patch-remove unwanted) 4 ...)) + (foo (1 2 3 (el-patch-remove unwanted) 4 5 6) quux)) + + ) + (testcases + "works with examples from the magit-file-icons package" + + ((defun magit-diff-insert-file-section + (file orig status modes rename header binary long-status) + (magit-insert-section + ( file file + (or (equal status "deleted") (derived-mode-p 'magit-status-mode)) + :source (and (not (equal orig file)) orig) + :header header + :binary binary) + (insert (propertize (format "%-10s %s" status + (if (or (not orig) (equal orig file)) + file + (format "%s -> %s" orig file))) + 'font-lock-face 'magit-diff-file-heading)) + (cond ((and binary long-status) + (insert (format " (%s, binary)" long-status))) + ((or binary long-status) + (insert (format " (%s)" (if binary "binary" long-status))))) + (magit-insert-heading) + (when modes + (magit-insert-section (hunk '(chmod)) + (insert modes) + (magit-insert-heading))) + (when rename + (magit-insert-section (hunk '(rename)) + (insert rename) + (magit-insert-heading))) + (magit-wash-sequence #'magit-diff-wash-hunk))) + + ((defun magit-diff-insert-file-section) + (format (el-patch-swap "%-10s %s" "%-10s %s %s") status + (el-patch-add (nerd-icons-icon-for-file (or orig file))) + (if (or (not orig) (equal orig file)) + file + (format (el-patch-swap "%s -> %s" "%s -> %s %s") orig + (el-patch-add (nerd-icons-icon-for-file file)) file)))) + + (defun magit-diff-insert-file-section + (file orig status modes rename header binary long-status) + (magit-insert-section + ( file file + (or (equal status "deleted") (derived-mode-p 'magit-status-mode)) + :source (and (not (equal orig file)) orig) + :header header + :binary binary) + (insert (propertize (format (el-patch-swap "%-10s %s" "%-10s %s %s") status + (el-patch-add (nerd-icons-icon-for-file (or orig file))) + (if (or (not orig) (equal orig file)) + file + (format (el-patch-swap "%s -> %s" "%s -> %s %s") orig + (el-patch-add (nerd-icons-icon-for-file file)) file))) + 'font-lock-face 'magit-diff-file-heading)) + (cond ((and binary long-status) + (insert (format " (%s, binary)" long-status))) + ((or binary long-status) + (insert (format " (%s)" (if binary "binary" long-status))))) + (magit-insert-heading) + (when modes + (magit-insert-section (hunk '(chmod)) + (insert modes) + (magit-insert-heading))) + (when rename + (magit-insert-section (hunk '(rename)) + (insert rename) + (magit-insert-heading))) + (magit-wash-sequence #'magit-diff-wash-hunk)))) + ) + (testcases + "works with the example from the readme" + + ((defun restart-emacs (&optional args) + "Restart Emacs. + +When called interactively ARGS is interpreted as follows + +- with a single `universal-argument' (`C-u') Emacs is restarted + with `--debug-init' flag +- with two `universal-argument' (`C-u') Emacs is restarted with + `-Q' flag +- with three `universal-argument' (`C-u') the user prompted for + the arguments + +When called non-interactively ARGS should be a list of arguments +with which Emacs should be restarted." + (interactive "P") + (restart-emacs--ensure-can-restart) + (let* ((default-directory (restart-emacs--guess-startup-directory)) + (translated-args (if (called-interactively-p 'any) + (restart-emacs--translate-prefix-to-args args) + args)) + (restart-args (append translated-args + (unless (member "-Q" translated-args) + (restart-emacs--frame-restore-args)))) + (kill-emacs-hook (append kill-emacs-hook + (unless restart-emacs--inhibit-kill-p + (list (apply-partially #'restart-emacs--launch-other-emacs + restart-args)))))) + (if restart-emacs--inhibit-kill-p + (restart-emacs--launch-other-emacs restart-args) + (save-buffers-kill-emacs)))) + + ((defun (el-patch-swap restart-emacs radian-new-emacs)) + (el-patch-concat + (el-patch-swap + "Restart Emacs." + "Start a new Emacs session without killing the current one.") + ... + (el-patch-swap "restarted" "started") + ... + (el-patch-swap "restarted" "started") + ... + (el-patch-swap "restarted" "started") + ...) + (el-patch-remove (kill-emacs-hook ...)) + (el-patch-swap + (save-buffers-kill-emacs) + (restart-emacs--launch-other-emacs restart-args))) + + (defun restart-emacs (&optional args) + (el-patch-concat + (el-patch-swap + "Restart Emacs." + "Start a new Emacs session without killing the current one.") + " +When called interactively ARGS is interpreted as follows + +- with a single `universal-argument' (`C-u') Emacs is " + (el-patch-swap "restarted" "started") + " + with `--debug-init' flag +- with two `universal-argument' (`C-u') Emacs is " + (el-patch-swap "restarted" "started") + " with + `-Q' flag +- with three `universal-argument' (`C-u') the user prompted for + the arguments + +When called non-interactively ARGS should be a list of arguments +with which Emacs should be " + (el-patch-swap "restarted" "started") + ".") + (interactive "P") + (restart-emacs--ensure-can-restart) + (let* ((default-directory (restart-emacs--guess-startup-directory)) + (translated-args (if (called-interactively-p 'any) + (restart-emacs--translate-prefix-to-args args) + args)) + (restart-args (append translated-args + (unless (member "-Q" translated-args) + (restart-emacs--frame-restore-args)))) + (el-patch-remove + (kill-emacs-hook (append kill-emacs-hook + (unless restart-emacs--inhibit-kill-p + (list (apply-partially #'restart-emacs--launch-other-emacs + restart-args))))))) + (if restart-emacs--inhibit-kill-p + (restart-emacs--launch-other-emacs restart-args) + (el-patch-swap + (save-buffers-kill-emacs) + (restart-emacs--launch-other-emacs restart-args)))))) + + ) + ;; (testcases + ;; "avoids issue #72" + + ;; ((foo "here is a very long string example" bar) + ;; )) + + )))