├── .dir-locals.el ├── .gitignore ├── .travis.yml ├── Cask ├── Makefile ├── README.md ├── assess-call.el ├── assess-discover.el ├── assess-doc.org ├── assess-robot.el ├── assess.el ├── dev-resources ├── elisp-fontified.el ├── elisp-indented.eld ├── elisp-unindented.eld ├── goodbye.txt └── hello.txt ├── test-by-cp ├── test-from-git ├── test ├── Makefile ├── assess-call-test.el ├── assess-discover-test.el ├── assess-robot-test.el ├── assess-test.el └── local-sandbox.el └── todo.org /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;;; Directory Local Variables 2 | ;;; For more information see (info "(emacs) Directory Variables") 3 | 4 | ((emacs-lisp-mode 5 | (lentic-init . lentic-orgel-org-init))) 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.cask 2 | /assess.org 3 | /assess-call.org 4 | /assess-discover.org 5 | /assess-robot.org 6 | /assess-doc.html 7 | /assess.html 8 | /makefile-local 9 | *.elc 10 | /dist 11 | /assess-pkg.el 12 | /assess-autoloads.el 13 | /test/assess-test.org 14 | /elpa-sandbox/ 15 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: generic 2 | sudo: no 3 | env: 4 | - EVM_EMACS=emacs-git-snapshot-travis-linux-xenial 5 | - EVM_EMACS=emacs-26.3-travis-linux-xenial 6 | - EVM_EMACS=emacs-26.2-travis-linux-xenial 7 | - EVM_EMACS=emacs-26.1-travis-linux-xenial 8 | - EVM_EMACS=emacs-25.3-travis 9 | - EVM_EMACS=emacs-25.2-travis 10 | - EVM_EMACS=emacs-25.1-travis 11 | - EVM_EMACS=emacs-24.5-travis 12 | - EVM_EMACS=emacs-24.4-travis 13 | install: 14 | - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh 15 | - evm install $EVM_EMACS --use --skip 16 | script: 17 | - emacs --version 18 | - make cask-free-test 19 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa-stable) 3 | 4 | (package-file "assess.el") 5 | 6 | (files "assess.el" "assess-*.el" "assess-doc.org") 7 | 8 | (development 9 | (depends-on "load-relative")) 10 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | EMACS ?= emacs 2 | CASK ?= cask 3 | 4 | -include makefile-local 5 | 6 | ifdef EMACS 7 | EMACS_ENV=EMACS=$(EMACS) 8 | endif 9 | 10 | all: install test 11 | 12 | install: 13 | $(EMACS_ENV) $(CASK) install 14 | 15 | test: install just-test 16 | 17 | package: 18 | $(EMACS_ENV) $(CASK) package 19 | 20 | just-test: 21 | $(EMACS_ENV) $(CASK) emacs --batch -q \ 22 | --directory=. \ 23 | --load assess-discover.el \ 24 | --eval '(assess-discover-run-and-exit-batch t)' 25 | 26 | .PHONY: test dist 27 | 28 | export: 29 | export 30 | 31 | 32 | multi-test: 33 | make EMACS=$(EMACSES)/master/src/emacs test 34 | make EMACS=$(EMACSES)/emacs-26.1/src/emacs test 35 | make EMACS=$(EMACSES)/emacs-25.3/src/emacs test 36 | make EMACS=$(EMACSES)/emacs-24.5/src/emacs test 37 | make EMACS=$(EMACSES)/emacs-24.4/src/emacs test 38 | 39 | elpa-sandbox: 40 | mkdir elpa-sandbox 41 | 42 | 43 | cask-free-test: elpa-sandbox 44 | emacs --batch -q \ 45 | --directory=. \ 46 | --load test/local-sandbox.el \ 47 | --eval '(assess-discover-run-and-exit-batch t)' 48 | 49 | DOCKER_TAG=26 50 | test-cp: 51 | docker run -it --rm --name docker-cp -v $(PWD):/usr/src/app -w /usr/src/app --entrypoint=/bin/bash silex/emacs:$(DOCKER_TAG)-ci-cask ./test-by-cp 52 | 53 | test-git: 54 | docker run -it --rm --name docker-git -v $(PWD):/usr/src/app -w /usr/src/app --entrypoint=/bin/bash silex/emacs:$(DOCKER_TAG)-ci-cask ./test-from-git 55 | 56 | 57 | test-cp-29.1: 58 | $(MAKE) test-cp DOCKER_TAG=29.1 59 | 60 | test-cp-28.2: 61 | $(MAKE) test-cp DOCKER_TAG=28.2 62 | 63 | test-cp-27.2: 64 | $(MAKE) test-cp DOCKER_TAG=27.2 65 | 66 | multi-test-cp: test-cp-29.1 test-cp-28.2 test-cp-27.2 67 | $(MAKE) test-cp DOCKER_TAG=26.2 68 | $(MAKE) test-cp DOCKER_TAG=26.1 69 | $(MAKE) test-cp DOCKER_TAG=25.3 70 | $(MAKE) test-cp DOCKER_TAG=25.2 71 | $(MAKE) test-cp DOCKER_TAG=25.1 72 | $(MAKE) test-cp DOCKER_TAG=master 73 | 74 | multi-test-git: 75 | $(MAKE) test-git DOCKER_TAG=29.1 76 | $(MAKE) test-git DOCKER_TAG=28.2 77 | $(MAKE) test-git DOCKER_TAG=27.2 78 | $(MAKE) test-git DOCKER_TAG=26.3 79 | $(MAKE) test-git DOCKER_TAG=26.2 80 | $(MAKE) test-git DOCKER_TAG=26.1 81 | $(MAKE) test-git DOCKER_TAG=25.3 82 | $(MAKE) test-git DOCKER_TAG=25.2 83 | $(MAKE) test-git DOCKER_TAG=25.1 84 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Assess 2 | ======== 3 | 4 | Assess provides additional support for testing Emacs packages. 5 | 6 | It provides: 7 | - a set of predicates for comparing strings, buffers and file contents. 8 | - explainer functions for all predicates giving useful output 9 | - macros for creating many temporary buffers at once, and for restoring the 10 | buffer list. 11 | - methods for testing indentation, by comparison or "roundtripping". 12 | - methods for testing fontification. 13 | 14 | Assess aims to be a stateless as possible, leaving Emacs unchanged whether 15 | the tests succeed or fail, with respect to buffers, open files and so on; this 16 | helps to keep tests independent from each other. 17 | 18 | Documentation 19 | ------------- 20 | 21 | Assess is fully 22 | [documented](http://homepages.cs.ncl.ac.uk/phillip.lord/lentic/assess-doc.html). 23 | Documentation is written and generating using the `lentic-doc` documentation 24 | system. It is also possible to generate the documentation locally: 25 | 26 | M-x package-install lentic-server 27 | M-x lentic-server-browse 28 | 29 | 30 | Status 31 | ------ 32 | 33 | The core of assess should now be considered stable and may be actively used. 34 | 35 | Assess supports runs all of the Emacs-24 series, Emacs-25 and Emacs-26 (to 36 | be). I will maintain support for older Emacs as far back as I am easily able 37 | to compile or run older versions; currently this is Emacs-24.1. 38 | 39 | Roadmap 40 | ------- 41 | 42 | I plan to move this to core Emacs, as ert-assess. This will happen after 43 | Emacs-25.1 release. 44 | 45 | Release 46 | ------- 47 | 48 | ## Version 0.5 49 | 50 | This release mostly changes internal implementation 51 | details. Specifically, the original use of "types" has been 52 | removed. Functions such as `assess-file` now return strings. 53 | 54 | 55 | ## Version 0.4 56 | 57 | This release features the first feature added by an external contributor 58 | (thanks to Matus Goljer and Damien Cassou). Assess now also supports the 59 | entire Emacs-24 series, after several requests; that this was possible was 60 | largely, if indirectly, due to Nicolas Petton's seq.el supporting all these 61 | versions 62 | 63 | ### Features 64 | 65 | - All of Emacs-24 series now supported. 66 | - `assess-with-filesystem` enables creation of a temporary file hierarchy. 67 | 68 | ### Bug Fixes 69 | - `assess-with-preserved-buffer-list` now kills even file associated buffers 70 | at the end of the form. 71 | 72 | ## Version 0.3.2 73 | 74 | Fix Version Number 75 | 76 | ## Version 0.3.1 77 | 78 | Add test, fix keybinding 79 | 80 | ## Version 0.3 81 | 82 | Add assess-robot.el 83 | 84 | ## Version 0.2 85 | 86 | Add assess-call.el 87 | 88 | ## Version 0.1 89 | 90 | First Release 91 | 92 | [![Build Status](https://travis-ci.org/phillord/assess.svg)](https://travis-ci.org/phillord/assess) 93 | -------------------------------------------------------------------------------- /assess-call.el: -------------------------------------------------------------------------------- 1 | ;;; assess-call.el --- Call and Return -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | 10 | ;; The contents of this file are subject to the GPL License, Version 3.0. 11 | 12 | ;; Copyright (C) 2016-2022 Free Software Foundation, Inc. 13 | 14 | ;; This program is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with this program. If not, see . 26 | 27 | ;;; Commentary: 28 | 29 | ;; Capture calls to functions, checking parameters and return values. 30 | 31 | ;;; Code: 32 | 33 | ;; ** Call Capture 34 | 35 | ;; Here we provide a function for tracing calls to a particular function. This 36 | ;; can be a direct or indirect call; parameters and return values are available 37 | ;; for inspection afterwards. For example: 38 | 39 | ;; #+begin_src elisp 40 | ;; (assess-call-capture 41 | ;; '+ 42 | ;; (lambda() 43 | ;; (+ 1 1))) 44 | ;; ;; => (((1 1) . 2)) 45 | ;; #+end_src 46 | 47 | ;; The return value is a list of cons cells, one for each invocation, of the 48 | ;; parameters and return values. 49 | 50 | 51 | ;; #+begin_src emacs-lisp 52 | (defun assess-call--capture-lambda () 53 | "Return function which captures args and returns of another. 54 | 55 | The returned function takes FN the function to call, and any 56 | number of ARGS to call the function with. In the special case, 57 | that FN is equal to `:return`, then all previous args and return 58 | values of FN are returned instead." 59 | (let ((capture-store nil)) 60 | (lambda (fn &rest args) 61 | (if (eq fn :return) 62 | capture-store 63 | (let ((rtn (apply fn args))) 64 | (setq capture-store 65 | (cons (cons args rtn) 66 | capture-store)) 67 | rtn))))) 68 | 69 | (defun assess-call-capture (sym-fn fn) 70 | "Trace all calls to SYM-FN when FN is called with no args. 71 | 72 | The return value is a list of cons cells, with car being the 73 | parameters of the calls, and the cdr being the return value." 74 | (let ((capture-lambda 75 | (assess-call--capture-lambda))) 76 | (unwind-protect 77 | (progn (advice-add sym-fn :around capture-lambda) 78 | (funcall fn) 79 | (funcall capture-lambda :return)) 80 | (advice-remove sym-fn capture-lambda)))) 81 | 82 | (defun assess-call--hook-capture-lambda () 83 | "Returns a function which captures all of its args. 84 | 85 | The returned function takes any number of ARGS. In the special 86 | case that the first arg is `:return` then it returns all previous 87 | args." 88 | (let ((capture-store nil)) 89 | (lambda (&rest args) 90 | (if (eq (car-safe args) :return) 91 | capture-store 92 | (setq capture-store 93 | (cons 94 | args 95 | capture-store)))))) 96 | 97 | (defun assess-call-capture-hook (hook-var fn &optional append local) 98 | "Trace all calls to HOOK-VAR when FN is called with no args. 99 | APPEND and LOCAL are passed to `add-hook` and documented there." 100 | (let ((capture-lambda 101 | (assess-call--hook-capture-lambda))) 102 | (unwind-protect 103 | (progn 104 | (add-hook hook-var 105 | capture-lambda 106 | append local) 107 | (funcall fn) 108 | (funcall capture-lambda :return)) 109 | (remove-hook hook-var 110 | capture-lambda 111 | local)))) 112 | 113 | (provide 'assess-call) 114 | ;;; assess-call.el ends here 115 | ;; #+end_src 116 | -------------------------------------------------------------------------------- /assess-discover.el: -------------------------------------------------------------------------------- 1 | ;;; assess-discover.el --- Test support functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | 10 | ;; The contents of this file are subject to the GPL License, Version 3.0. 11 | 12 | ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. 13 | 14 | ;; This program is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with this program. If not, see . 26 | 27 | ;;; Code: 28 | 29 | 30 | ;; #+begin_src emacs-lisp 31 | (defun assess-discover-tests (directory) 32 | "Discover tests in directory. 33 | 34 | Tests must conform to one (and only one!) of several naming 35 | schemes. 36 | 37 | - End with -test.el 38 | - End with -tests.el 39 | - Start with test- 40 | - Any .el file in a directory called test 41 | - Any .el file in a directory called tests 42 | 43 | Each of these is tried until one matches. So, a top-level file 44 | called \"blah-test.el\" will prevent discovery of files in a 45 | tests directory." 46 | (or 47 | ;; files with 48 | (directory-files directory nil ".*-test.el$") 49 | (directory-files directory nil ".*-tests.el$") 50 | (directory-files directory nil "test-.*.el$") 51 | (let ((dir-test 52 | (concat directory "test/"))) 53 | (when (file-exists-p dir-test) 54 | (mapcar 55 | (lambda (file) 56 | (concat dir-test file)) 57 | (directory-files dir-test nil ".*.el")))) 58 | (let ((dir-tests 59 | (concat directory "tests/"))) 60 | (when (file-exists-p dir-tests) 61 | (mapcar 62 | (lambda (file) 63 | (concat dir-tests file)) 64 | (directory-files dir-tests nil ".*.el")))))) 65 | 66 | (defun assess-discover--load-all-tests (directory) 67 | (mapc 68 | #'load 69 | (assess-discover-tests directory))) 70 | 71 | (defun assess-discover-load-tests () 72 | (interactive) 73 | (assess-discover--load-all-tests default-directory)) 74 | 75 | ;;;###autoload 76 | (defun assess-discover-run-batch (&optional selector) 77 | (assess-discover--load-all-tests default-directory) 78 | (ert-run-tests-batch selector)) 79 | 80 | ;;;###autoload 81 | (defun assess-discover-run-and-exit-batch (&optional selector) 82 | (assess-discover--load-all-tests default-directory) 83 | (ert-run-tests-batch-and-exit selector)) 84 | 85 | (provide 'assess-discover) 86 | ;;; assess-discover.el ends here 87 | ;; #+end_src 88 | -------------------------------------------------------------------------------- /assess-doc.org: -------------------------------------------------------------------------------- 1 | 2 | #+TITLE: Testing with Assess 3 | #+AUTHOR: Phillip Lord 4 | 5 | # FIXME: `ox-texinfo` should use sane defaults like the file's name 6 | # for TEXINFO_DIR_TITLE and the TITLE for TEXINFO_DIR_DESC? 7 | #+TEXINFO_DIR_CATEGORY: Emacs 8 | #+TEXINFO_DIR_TITLE: * asses: (assess-doc). 9 | #+TEXINFO_DIR_DESC: Testing with Assess 10 | 11 | #+INFOJS_OPT: view:info toc:nil 12 | 13 | #+INCLUDE: "assess.org" :lines "28-" 14 | -------------------------------------------------------------------------------- /assess-robot.el: -------------------------------------------------------------------------------- 1 | ;;; assess-robot.el --- Test support functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | ;; Version: 0.2 10 | 11 | ;; The contents of this file are subject to the GPL License, Version 3.0. 12 | 13 | ;; Copyright (C) 2016-2022 Free Software Foundation, Inc. 14 | 15 | ;; This program is free software: you can redistribute it and/or modify 16 | ;; it under the terms of the GNU General Public License as published by 17 | ;; the Free Software Foundation, either version 3 of the License, or 18 | ;; (at your option) any later version. 19 | 20 | ;; This program is distributed in the hope that it will be useful, 21 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 22 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 23 | ;; GNU General Public License for more details. 24 | 25 | ;; You should have received a copy of the GNU General Public License 26 | ;; along with this program. If not, see . 27 | 28 | ;;; Code: 29 | (defmacro assess-robot-with-switched-buffer (buffer &rest body) 30 | "With BUFFER, evaluate BODY. 31 | 32 | This macro is rather like `with-current-buffer', except that it 33 | uses `switch-to-buffer'. This is generally a bad idea when used 34 | programmatically. But, it is necessary, for example, when using 35 | keyboard macros." 36 | (declare (indent 1) (debug t)) 37 | (let ((before-buffer (make-symbol "before-buffer"))) 38 | `(let ((,before-buffer (current-buffer))) 39 | (unwind-protect 40 | (progn 41 | (switch-to-buffer ,buffer) 42 | ,@body) 43 | (switch-to-buffer ,before-buffer))))) 44 | 45 | (defmacro assess-robot-with-temp-switched-buffer (&rest body) 46 | "Evaluate BODY in temporary buffer. 47 | 48 | As with `assess-robot-with-switched-buffer', `switch-to-buffer' 49 | is used." 50 | (declare (indent 0) (debug t)) 51 | (let ((temp-buffer (make-symbol "temp-buffer"))) 52 | `(let ((,temp-buffer (generate-new-buffer " *temp*"))) 53 | (assess-robot-with-switched-buffer ,temp-buffer 54 | (unwind-protect 55 | (progn 56 | ;; Enable the undo list because we want it for most robot 57 | ;; situations. 58 | (setq buffer-undo-list nil) 59 | ,@body) 60 | (and (buffer-name ,temp-buffer) 61 | (kill-buffer ,temp-buffer))))))) 62 | 63 | (defmacro assess-robot-with-switched-buffer-string (&rest body) 64 | "Evalate BODY in a temporary buffer and return buffer string. 65 | 66 | See also `assess-robot-with-temp-switched-buffer'." 67 | (declare (debug t)) 68 | `(assess-robot-with-temp-switched-buffer 69 | (progn 70 | ,@body 71 | (buffer-substring-no-properties 72 | (point-min) (point-max))))) 73 | 74 | (defun assess-robot-execute-kmacro (macro) 75 | "Execute the MACRO. 76 | 77 | In this case, MACRO is the \"long form\" accepted by 78 | `edit-kdb-macro'." 79 | (let ((macro (read-kbd-macro macro))) 80 | ;; I wanted to add a nice way to edit the macro, but sadly 81 | ;; edit-kdb-macro provides no nice entry point. So, we take the nasty step 82 | ;; of setting the last-kbd-macro instead. 83 | (setq last-kbd-macro macro) 84 | (execute-kbd-macro macro))) 85 | 86 | (defun assess-robot-copy-and-finish () 87 | "Copy the macro in edmacro to the `kill-ring'." 88 | (interactive) 89 | (declare-function edmacro-finish-edit "edmacro" ()) 90 | (save-excursion 91 | (goto-char (point-min)) 92 | (search-forward "Macro:") 93 | (forward-line) 94 | (let ((string 95 | (buffer-substring-no-properties 96 | (point) 97 | (point-max)))) 98 | (with-temp-buffer 99 | (insert "\"" string "\"") 100 | (kill-ring-save (point-min) 101 | (point-max)))) 102 | (edmacro-finish-edit))) 103 | 104 | (with-eval-after-load 'edmacro 105 | (defvar edmacro-mode-map) 106 | (define-key edmacro-mode-map (kbd "C-c C-k") #'assess-robot-copy-and-finish)) 107 | 108 | (provide 'assess-robot) 109 | ;;; assess-robot.el ends here 110 | -------------------------------------------------------------------------------- /assess.el: -------------------------------------------------------------------------------- 1 | ;;; assess.el --- Test support functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | ;; Version: 0.7 10 | ;; Package-Requires: ((emacs "24.4")(m-buffer "0.15")) 11 | 12 | ;; The contents of this file are subject to the GPL License, Version 3.0. 13 | 14 | ;; Copyright (C) 2015-2024 Free Software Foundation, Inc. 15 | 16 | ;; This program is free software: you can redistribute it and/or modify 17 | ;; it under the terms of the GNU General Public License as published by 18 | ;; the Free Software Foundation, either version 3 of the License, or 19 | ;; (at your option) any later version. 20 | 21 | ;; This program is distributed in the hope that it will be useful, 22 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 23 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 24 | ;; GNU General Public License for more details. 25 | 26 | ;; You should have received a copy of the GNU General Public License 27 | ;; along with this program. If not, see . 28 | 29 | ;;; Commentary: 30 | 31 | ;; This file provides functions to support ert, the Emacs Regression Test 32 | ;; framework. It includes: 33 | 34 | ;; - a set of predicates for comparing strings, buffers and file contents. 35 | ;; - explainer functions for all predicates giving useful output 36 | ;; - macros for creating many temporary buffers at once, and for restoring the 37 | ;; buffer list. 38 | ;; - methods for testing indentation, by comparison or "round-tripping". 39 | ;; - methods for testing fontification. 40 | 41 | ;; Assess aims to be a stateless as possible, leaving Emacs unchanged whether 42 | ;; the tests succeed or fail, with respect to buffers, open files and so on; this 43 | ;; helps to keep tests independent from each other. Violations of this will be 44 | ;; considered a bug. 45 | 46 | ;; Assess aims also to be as noiseless as possible, reducing and suppressing 47 | ;; extraneous messages where possible, to leave a clean ert output in batch mode. 48 | 49 | 50 | ;;; Status: 51 | 52 | ;; Assess is currently a work in progress; the API is not currently stable. I 53 | ;; may also considering winding this into ert-x, because then it can be used 54 | ;; to test core. 55 | 56 | ;; Assess used to be called sisyphus which seemed like a good idea when I 57 | ;; started, but I kept spelling it wrong. 58 | 59 | 60 | ;;; Code: 61 | 62 | ;; ** Preliminaries 63 | 64 | ;; #+begin_src emacs-lisp 65 | (require 'pp) 66 | (require 'ert) 67 | (require 'm-buffer-at) 68 | (require 'm-buffer) 69 | (require 'seq) 70 | ;; #+end_src 71 | 72 | ;; ** Advice 73 | 74 | ;; Emacs-24 insists on printing out results on a single line with escaped 75 | ;; newlines. This does not work so well with the explainer functions in assess 76 | ;; and, probably, does not make sense anywhere. So, we advice here. The use of 77 | ;; nadvice.el limits this package to Emacs 24.4. Emacs 25 has this fixed. 78 | 79 | ;; #+begin_src emacs-lisp 80 | (defun assess--ert-pp-with-indentation-and-newline (orig object) 81 | (let ((pp-escape-newlines nil)) 82 | (funcall orig object))) 83 | 84 | (advice-add 85 | 'ert--pp-with-indentation-and-newline 86 | :around 87 | #'assess--ert-pp-with-indentation-and-newline) 88 | ;; #+end_src 89 | 90 | ;; ** Deliberate Errors 91 | 92 | ;; Sometimes during testing, we need to throw an "error" deliberately. Assess' 93 | ;; own test cases do this to check that state is preserved with this form of 94 | ;; non-local exit. Throwing `error' itself is a bit dangerous because we might 95 | ;; get that for other reasons; so we create a new symbol here for general use. 96 | 97 | ;; #+begin_src emacs-lisp 98 | (if (fboundp 'define-error) 99 | (define-error 'assess-deliberate-error 100 | "An error deliberately caused during testing." 101 | 'error) 102 | (put 'assess-deliberate-error 103 | 'error-conditions 104 | '(error assess-deliberate-error)) 105 | (put 'assess-deliberate-error 106 | 'error-message 107 | "A error deliberately caused during testing.")) 108 | ;; #+end_src 109 | 110 | ;; ** Buffer creation 111 | 112 | ;; For tests, it is often better to use temporary buffers, as it is much less 113 | ;; affected by the existing state of Emacs, and much less likely to affect future 114 | ;; state; this is particularly the case where tests are being developed as the 115 | ;; developer may be trying to change or write test files at the same time as 116 | ;; Emacs is trying to use them for testing. 117 | 118 | ;; Emacs really only provides a single primitive `with-temp-buffer' for this 119 | ;; situation, and that only creates a single temporary buffer at a time. Nesting 120 | ;; of these forms sometimes works, but fails if we need to operate on two buffers 121 | ;; at once. 122 | 123 | ;; So, we provide an environment for restoring the buffer list. This allows any 124 | ;; creation of buffers we need for testing, followed by clean up afterwards. For 125 | ;; example, a trivial usage would be to remove buffers explicitly created. 126 | 127 | ;; #+begin_src elisp 128 | ;; (assess-with-preserved-buffer-list 129 | ;; (get-buffer-create "a") 130 | ;; (get-buffer-create "b") 131 | ;; (get-buffer-create "c")) 132 | ;; #+end_src 133 | 134 | ;; Any buffer created in this scope is removed, whether this is as a direct or 135 | ;; indirect result of the function. For example, this usage creates a ~*Help*~ 136 | ;; buffer which then gets removed again. 137 | 138 | ;; #+begin_src elisp 139 | ;; (assess-with-preserved-buffer-list 140 | ;; (describe-function 'self-insert-command)) 141 | ;; #+end_src 142 | 143 | ;; This does not prevent changes to existing buffers of course. If ~*Help*~ is 144 | ;; already open before evaluation, it will remain open afterwards but with 145 | ;; different content. 146 | 147 | ;; Sometimes, it is useful to create several temporary buffers at once. 148 | ;; `assess-with-temp-buffers' provides an easy mechanism for doing this, as 149 | ;; well as evaluating content in these buffers. For example, this returns true 150 | ;; (actually three killed buffers which were live when the `mapc' form runs). 151 | 152 | ;; #+begin_src elisp 153 | ;; (assess-with-temp-buffers 154 | ;; (a b c) 155 | ;; (mapc #'buffer-live-p (list a b c))) 156 | ;; #+end_src 157 | 158 | ;; While this creates two buffers, puts "hellogoodbye" into one and "goodbye" 159 | ;; into the other, then compares the contents of these buffers with `assess='. 160 | 161 | ;; #+begin_src elisp 162 | ;; (assess-with-temp-buffers 163 | ;; ((a (insert "hello") 164 | ;; (insert "goodbye")) 165 | ;; (b (insert "goodbye"))) 166 | ;; (assess= a b)) 167 | ;; #+end_src 168 | 169 | ;; Finally, we provide a simple mechanism for converting any assess type into a 170 | ;; buffer. The following form, for example, returns the contents of the ~.emacs~ 171 | ;; file. 172 | 173 | ;; #+begin_src elisp 174 | ;; (assess-as-temp-buffer 175 | ;; (assess-file "~/.emacs") 176 | ;; (buffer-string)) 177 | ;; #+end_src 178 | 179 | ;; *** Implementation 180 | 181 | ;; #+begin_src emacs-lisp 182 | (defmacro assess-with-preserved-buffer-list (&rest body) 183 | "Evaluate BODY, but delete any buffers that have been created." 184 | (declare (debug t)) 185 | `(let ((before-buffer-list 186 | (buffer-list))) 187 | (unwind-protect 188 | (progn 189 | ,@body) 190 | (seq-map 191 | (lambda (it) 192 | (with-current-buffer it 193 | (set-buffer-modified-p nil) 194 | (kill-buffer))) 195 | (seq-difference (buffer-list) 196 | before-buffer-list))))) 197 | 198 | (defun assess--temp-buffer-let-form (item) 199 | (if (not (listp item)) 200 | (assess--temp-buffer-let-form 201 | (list item)) 202 | `(,(car item) 203 | (with-current-buffer 204 | (generate-new-buffer " *assess-with-temp-buffers*") 205 | ,@(cdr item) 206 | (current-buffer))))) 207 | ;; #+end_src 208 | 209 | ;; The implementation of `assess-with-temp-buffers' currently uses 210 | ;; `assess-with-preserved-buffer-list' to remove buffers which means that it 211 | ;; will also delete any buffers created by the user; this may be a mistake, and 212 | ;; it might be better to delete the relevant buffers explicitly. 213 | 214 | ;; #+begin_src emacs-lisp 215 | (defmacro assess-with-temp-buffers (varlist &rest body) 216 | "Bind variables in varlist to temp buffers, then eval BODY. 217 | 218 | VARLIST is (nearly) of the same form as a `let' binding. Each 219 | element is a symbol or a list (symbol valueforms). Each symbol is 220 | bound to a buffer generated with `generate-new-buffer'. 221 | VALUEFORMS are evaluated with the buffer current. Any buffers 222 | created inside this form (and not just by this form!) are 223 | unconditionally killed at the end of the form. 224 | 225 | Unlike `let' there can be multiple valueforms which are, 226 | effectively, placed within an impicit `progn'." 227 | (declare (indent 1) 228 | (debug 229 | ((&rest (symbolp &rest form)) 230 | body))) 231 | (let ((let-form 232 | (seq-map 233 | #'assess--temp-buffer-let-form 234 | varlist))) 235 | `(assess-with-preserved-buffer-list 236 | (let* ,let-form 237 | ,@body)))) 238 | 239 | (defmacro assess-as-temp-buffer (x &rest body) 240 | "Insert X in a type-appropriate way into a temp buffer and eval 241 | BODY there. 242 | 243 | See `assess-ensure-string' for the meaning of type-appropriate." 244 | (declare (indent 1) (debug t)) 245 | `(with-temp-buffer 246 | (insert (assess-ensure-string ,x)) 247 | ,@body)) 248 | ;; #+end_src 249 | 250 | ;; ** Converters 251 | 252 | ;; The majority of test functionality compares strings. We provide 253 | ;; here some functions to convert between other Emacs types and 254 | ;; strings. 255 | 256 | ;; #+begin_src elisp 257 | ;; ;; Return a string of the contents of .emacs 258 | ;; (assess-file "~/.emacs") 259 | 260 | ;; ;; Return the contents of the buffer with name *Messages* 261 | ;; (assess-buffer "*Messages*") 262 | ;; #+end_src 263 | 264 | ;; *** Implementation 265 | 266 | ;; #+begin_src emacs-lisp 267 | (defun assess-ensure-string (x) 268 | "Turn X into a string in a type appropriate way. 269 | 270 | If X is identified as a file, returns the file contents. 271 | If X is identified as a buffer, returns the buffer contents. 272 | If X is a string, returns that. 273 | 274 | See also `assess-buffer' and `assess-file' which turn a 275 | string into something that will identified appropriately." 276 | (cond 277 | ((stringp x) x) 278 | ((bufferp x) (m-buffer-at-string x)) 279 | (t (error "Type not recognised")))) 280 | 281 | (defalias 'assess-buffer #'get-buffer-create 282 | "Create a buffer. 283 | 284 | This is now an alias for `get-buffer-create' but used to do 285 | something quite different.") 286 | 287 | (defun assess-file (f) 288 | "Convert a file to the string contents of that file." 289 | (with-temp-buffer 290 | (insert-file-contents f) 291 | (buffer-string))) 292 | ;; #+end_src 293 | 294 | ;; ** Entity Comparison 295 | 296 | ;; In this section, we provide support for comparing strings, buffer or file 297 | ;; contents. The main entry point is `assess=', which works like `string=' but 298 | ;; on any of the three data types, in any order. 299 | 300 | ;; #+begin_src elisp 301 | ;; ;; Compare Two Strings 302 | ;; (assess= "hello" "goodbye") 303 | 304 | ;; ;; Compare the contents of Two Buffers 305 | ;; (assess= 306 | ;; (assess-buffer "assess.el") 307 | ;; (assess-buffer "assess-previous.el")) 308 | 309 | ;; ;; Compare the contents of Two files 310 | ;; (assess= 311 | ;; (assess-file "~/.emacs") 312 | ;; (assess-file "~/.emacs")) 313 | 314 | ;; ;; We can use core Emacs types also 315 | ;; (assess= 316 | ;; (assess-buffer "assess.el") 317 | ;; (get-buffer "assess-previous.el")) 318 | 319 | ;; ;; And in any combination; here we compare a string and the contents of a 320 | ;; ;; file. 321 | ;; (assess= 322 | ;; ";; This is an empty .emacs file" 323 | ;; (assess-file "~/.emacs")) 324 | ;; #+end_src 325 | 326 | ;; In addition, `assess=' has an "explainer" function attached which produces a 327 | ;; richer output when `assess=' returns false, showing diffs of the string 328 | ;; comparison. Compare, for example, the results of running these two tests, one 329 | ;; using `string=' and one using `assess='. 330 | 331 | ;; #+BEGIN_EXAMPLE 332 | ;; F temp 333 | ;; (ert-test-failed 334 | ;; ((should 335 | ;; (string= "a" "b")) 336 | ;; :form 337 | ;; (string= "a" "b") 338 | ;; :value nil)) 339 | 340 | ;; F test-assess= 341 | ;; (ert-test-failed 342 | ;; ((should 343 | ;; (assess= "a" "b")) 344 | ;; :form 345 | ;; (assess= "a" "b") 346 | ;; :value nil :explanation "Strings: 347 | ;; a 348 | ;; and 349 | ;; b 350 | ;; Differ at:*** /tmp/a935uPW 2016-01-20 13:25:47.373076381 +0000 351 | ;; --- /tmp/b9357Zc 2016-01-20 13:25:47.437076381 +0000 352 | ;; *************** 353 | ;; *** 1 **** 354 | ;; ! a 355 | ;; \\ No newline at end of file 356 | ;; --- 1 ---- 357 | ;; ! b 358 | ;; \\ No newline at end of file 359 | 360 | ;; ")) 361 | ;; #+END_EXAMPLE 362 | 363 | ;; As `assess=' has a compatible interface with `string=' it is also possible 364 | ;; to add this explainer function to `string=' for use with tests which do not 365 | ;; otherwise use assess, like so: 366 | 367 | ;; #+begin_src elisp 368 | ;; (put 'string= 'ert-explainer 'assess-explain=) 369 | ;; #+end_src 370 | 371 | ;; Currently, `assess' uses the ~diff~ program to do the comparison if it is 372 | ;; available, or falls back to just reporting a difference -- this could do with 373 | ;; improving, but it is at least no worse than the existing behaviour for string 374 | ;; comparison. 375 | 376 | ;; *** Implementation 377 | 378 | ;; We start by writing a file silently -- this is important because the 379 | ;; ~*Messages*~ buffer should not be affected by the machinery of a failing test, 380 | ;; as it hides what is happening from the test code. 381 | 382 | ;; #+begin_src emacs-lisp 383 | (defun assess--write-file-silently (filename) 384 | "Write current buffer into FILENAME. 385 | Unlike most other ways of saving a file, this should not 386 | print any messages!" 387 | (write-region 388 | (point-min) (point-max) 389 | filename nil 390 | 'dont-display-wrote-file-message)) 391 | ;; #+end_src 392 | 393 | ;; Diff does a nicer comparison than anything in Emacs, although a lisp 394 | ;; implementation would have been more portable. Diff is used by quite a few 395 | ;; other tools in Emacs, so probably most people will have access to diff. 396 | 397 | ;; #+begin_src emacs-lisp 398 | (defun assess--explainer-diff-string= (a b) 399 | "Compare strings A and B using diff output. 400 | 401 | We assume that diff exists. Temporary files are left 402 | afterwards for cleanup by the operating system." 403 | (assess-with-preserved-buffer-list 404 | (let* ((diff 405 | (executable-find "diff")) 406 | (a-buffer 407 | (generate-new-buffer "a")) 408 | (b-buffer 409 | (generate-new-buffer "b")) 410 | (a-file 411 | (make-temp-file 412 | (buffer-name a-buffer))) 413 | (b-file 414 | (make-temp-file 415 | (buffer-name b-buffer)))) 416 | (with-current-buffer 417 | a-buffer 418 | (insert a) 419 | (assess--write-file-silently a-file)) 420 | (with-current-buffer 421 | b-buffer 422 | (insert b) 423 | (assess--write-file-silently b-file)) 424 | (progn 425 | (format "Strings:\n%s\nand\n%s\nDiffer at:%s\n" 426 | a b 427 | (with-temp-buffer 428 | (call-process 429 | diff 430 | ;; no infile 431 | nil 432 | ;; dump to current buffer 433 | t 434 | nil 435 | "-c" 436 | a-file 437 | b-file) 438 | (buffer-string))))))) 439 | 440 | (defun assess--explainer-simple-string= (a b) 441 | "Compare strings for first difference." 442 | ;; We could do a bit more here. 443 | (format "String :%s:%s: are not equal." a b)) 444 | ;; #+end_src 445 | 446 | ;; And the actual predicate function and explainer. We do a simple string 447 | ;; comparison on the contents of each entity. 448 | 449 | ;; #+begin_src emacs-lisp 450 | (defun assess= (a b) 451 | "Compare A and B to see if they are the same. 452 | 453 | Equality in this sense means compare the contents in a way which 454 | is appropriate for the type of the two arguments. So, if they are 455 | strings, the compare strings, if buffers, then compare the buffer 456 | contents and so on. 457 | 458 | Text properties in strings or buffers are ignored." 459 | (string= 460 | (assess-ensure-string a) 461 | (assess-ensure-string b))) 462 | 463 | (defun assess-explain= (a b) 464 | "Compare A and B and return an explanation. 465 | 466 | This function is called by ERT as an explainer function 467 | automatically. See `assess=' for more information." 468 | (let ((a (assess-ensure-string a)) 469 | (b (assess-ensure-string b))) 470 | (cond 471 | ((assess= a b) 472 | t) 473 | ((executable-find "diff") 474 | (assess--explainer-diff-string= a b)) 475 | (t 476 | (assess--explainer-simple-string= a b))))) 477 | 478 | (put 'assess= 'ert-explainer 'assess-explain=) 479 | ;; #+end_src 480 | 481 | ;; ** Opening files 482 | 483 | ;; Opening files presents a particular problem for testing, particularly if we 484 | ;; open a file that is already open in the same or a different Emacs. For batch 485 | ;; use of Emacs with parallelisation, the situation becomes intractable. 486 | 487 | ;; A solution is to copy files before we open them, which means that they can be 488 | ;; changed freely. Largely, the copied file will behave the same as the main file; 489 | ;; the only notable exception to this is those features which depend on the 490 | ;; current working directory (dir-local variables, for example). 491 | 492 | ;; ~assess-make-related-file~ provides a simple method for doing this. For 493 | ;; example, this form will return exactly the contents of ~my-test-file.el~, even 494 | ;; if that file is current open in the current Emacs (even if the buffer has not 495 | ;; been saved). Likewise, a test opening this file could be run in a batch Emacs 496 | ;; without interfering with an running interactive Emacs. 497 | 498 | ;; #+begin_src elisp 499 | ;; (assess-as-temp-buffer 500 | ;; (assess-make-related-file "dev-resources/my-test-file.el") 501 | ;; (buffer-substring)) 502 | ;; #+end_src 503 | 504 | ;; We also add support for opening a file, as if it where opened interactively, 505 | ;; with all the appropriate hooks being run, in the form of the 506 | ;; `assess-with-find-file' macro. Combined with `assess-make-related-file', 507 | ;; we can write the following expression without removing our ~.emacs~. 508 | 509 | ;; #+begin_src elisp 510 | ;; (assess-with-find-file 511 | ;; (assess-make-related-file "~/.emacs") 512 | ;; (erase-buffer) 513 | ;; (save-buffer)) 514 | ;; #+end_src 515 | 516 | ;; #+RESULTS: 517 | 518 | ;; *** Implementation 519 | 520 | ;; All of the functions here support the file type introduced earlier, but 521 | ;; interpret raw strings as a file also. 522 | 523 | ;; #+begin_src emacs-lisp 524 | (defun assess--make-related-file-1 (file &optional directory) 525 | (make-temp-file 526 | (concat 527 | (or directory 528 | temporary-file-directory) 529 | (file-name-nondirectory file)) 530 | nil 531 | (concat "." 532 | (file-name-extension file)))) 533 | 534 | (defun assess-make-related-file (file &optional directory) 535 | "Open a copy of FILE in DIRECTORY. 536 | 537 | FILE is copied to a temporary file in DIRECTORY or 538 | `temporary-file-directory'. The copy has a unique name but shares 539 | the same file extension. 540 | 541 | This is useful for making test changes to FILE without actually 542 | altering it." 543 | (let* ((related-file 544 | (assess--make-related-file-1 file directory))) 545 | (copy-file file related-file t) 546 | related-file)) 547 | 548 | (defmacro assess-with-find-file (file &rest body) 549 | "Open FILE and evaluate BODY in resultant buffer. 550 | 551 | FILE is opened with `find-file-noselect' so all the normal hooks 552 | for file opening should occur. The buffer is killed after the 553 | macro exits, unless it was already open. This happens 554 | unconditionally, even if the buffer has changed. 555 | 556 | See also `assess-make-related-file'." 557 | (declare (debug t) (indent 1)) 558 | (let ((temp-buffer (make-symbol "temp-buffer")) 559 | (file-has-buffer-p (make-symbol "file-has-buffer-p"))) 560 | `(let* ((,file-has-buffer-p 561 | (find-buffer-visiting ,file)) 562 | (,temp-buffer)) 563 | (unwind-protect 564 | (with-current-buffer 565 | (setq ,temp-buffer 566 | (find-file-noselect ,file)) 567 | ,@body) 568 | (when 569 | ;; kill the buffer unless it was already open. 570 | (and (not ,file-has-buffer-p) 571 | (buffer-live-p ,temp-buffer)) 572 | ;; kill unconditionally 573 | (with-current-buffer ,temp-buffer 574 | (set-buffer-modified-p nil)) 575 | (kill-buffer ,temp-buffer)))))) 576 | ;; #+end_src 577 | 578 | ;; ** Creating Files and Directories 579 | ;; I can write some documentation here if Phil wants to merge code below. 580 | ;; *** Implementation 581 | ;; #+BEGIN_SRC emacs-lisp 582 | (defun assess-with-filesystem--make-parent (spec path) 583 | "If SPEC is a file name, create its parent directory rooted at PATH." 584 | (save-match-data 585 | (when (string-match "\\(.*\\)/" spec) 586 | (make-directory (concat path "/" (match-string 1 spec)) t)))) 587 | 588 | (defun assess-with-filesystem--init (spec &optional path) 589 | "Interpret the SPEC inside PATH." 590 | (setq path (or path ".")) 591 | (cond 592 | ((listp spec) 593 | (cond 594 | ;; non-empty file 595 | ((and (stringp (car spec)) 596 | (stringp (cadr spec))) 597 | (when (string-match-p "/\\'" (car spec)) 598 | (error "Invalid syntax: `%s' - cannot create a directory with text content" (car spec))) 599 | (assess-with-filesystem--make-parent (car spec) path) 600 | (with-temp-file (concat path "/" (car spec)) 601 | (insert (cadr spec)))) 602 | ;; directory 603 | ((and (stringp (car spec)) 604 | (consp (cadr spec))) 605 | (make-directory (concat path "/" (car spec)) t) 606 | (mapc (lambda (s) (assess-with-filesystem--init 607 | s (concat path "/" (car spec)))) (cadr spec))) 608 | ;; recursive spec, this should probably never happen 609 | (t (mapc (lambda (s) (assess-with-filesystem--init s path)) spec)))) 610 | ;; directory specified using a string 611 | ((and (stringp spec) 612 | (string-match-p "/\\'" spec)) 613 | (make-directory (concat path "/" spec) t)) 614 | ;; empty file 615 | ((stringp spec) 616 | (assess-with-filesystem--make-parent spec path) 617 | (write-region "" nil (concat path "/" spec) nil 'no-message)) 618 | (t (error "Invalid syntax: `%s'" spec)))) 619 | 620 | (defmacro assess-with-filesystem (spec &rest forms) 621 | "Create temporary file hierarchy according to SPEC and run FORMS. 622 | 623 | SPEC is a list of specifications for file system entities which 624 | are to be created. 625 | 626 | File system entities are specified as follows: 627 | 628 | 1. a string FILE is the name of file to be created 629 | - if the string contains \"/\", parent directories are created 630 | automatically 631 | - if the string ends with \"/\", a directory is created 632 | 2. a list of two elements (FILE CONTENT) specifies filename and the 633 | content to put in the file 634 | - the \"/\" rules apply in the same way as in 1., except you can not 635 | create a directory this way 636 | 3. a list where car is a string and cadr is a list (DIR SPEC) is a 637 | recursive specification evaluated with DIR as current directory 638 | - the \"/\" rules apply in the same way as in 1., except you can not 639 | create a file this way, a directory is always created 640 | 641 | An example showing all the possibilities: 642 | 643 | (\"empty_file\" 644 | \"dir/empty_file\" 645 | \"dir/subdir/\" 646 | (\"non_empty_file\" \"content\") 647 | (\"dir/anotherdir/non_empty_file\" \"tralala\") 648 | (\"big_dir\" (\"empty_file\" 649 | (\"non_empty_file\" \"content\") 650 | \"subdir/empty_file\"))) 651 | 652 | If we want to run some code in a directory with an empty file 653 | \"foo.txt\" present, we call: 654 | 655 | (assess-with-filesystem \\='(\"foo\") 656 | (code-here) 657 | (and-some-more-forms)) 658 | 659 | You should *not* depend on where exactly the hierarchy is created. 660 | By default, a new directory in `temporary-file-directory' is 661 | created and the specification is evaluated there, but this is up 662 | for change." 663 | (declare (indent 1)) 664 | (let ((temp-root (make-symbol "temp-root")) 665 | (old-dd (make-symbol "old-dd"))) 666 | `(let ((,temp-root (make-temp-file "temp-fs-" t)) 667 | (,old-dd default-directory)) 668 | (unwind-protect 669 | (progn 670 | (setq default-directory ,temp-root) 671 | (mapc (lambda (s) (assess-with-filesystem--init s ".")) ,spec) 672 | ,@forms) 673 | (delete-directory ,temp-root t) 674 | (setq default-directory ,old-dd))))) 675 | ;; #+END_SRC 676 | ;; ** Indentation functions 677 | 678 | ;; There are two main ways to test indentation -- we can either take unindented 679 | ;; text, indent it, and then compare it to something else; or, we can roundtrip 680 | ;; -- take indented code, unindent it, re-indent it again and see whether we end 681 | ;; up with what we started. Assess supports both of these. 682 | 683 | ;; Additionally, there are two different ways to specific a mode -- we can either 684 | ;; define it explicitly or, if we are opening from a file, we can use the normal 685 | ;; `auto-mode-alist' functionality to determine the mode. Assess supports both 686 | ;; of these also. 687 | 688 | ;; The simplest function is `assess-indentation=' which we can use as follows. 689 | ;; In this case, we have mixed a multi-line string and a single line with 690 | ;; control-n characters; this is partly to show that we can, and partly to make 691 | ;; sure that the code works both in an `org-mode' buffer and an ~*Org Src*~ buffer. 692 | 693 | ;; #+begin_src elisp 694 | ;; (assess-indentation= 695 | ;; 'emacs-lisp-mode 696 | ;; "(assess-with-find-file 697 | ;; \"~/.emacs\" 698 | ;; (buffer-string))" 699 | ;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))") 700 | ;; #+end_src 701 | 702 | ;; #+RESULTS: 703 | ;; : t 704 | 705 | ;; Probably more useful is `assess-roundtrip-indentation=' which allows us to 706 | ;; just specify the indented form; in this case, the string is first unindented 707 | ;; (every line starts at the first position) and then reindented. This saves the 708 | ;; effort of keeping the text in both the indented and unindent forms in sync 709 | ;; (but without the indentation). 710 | 711 | ;; #+begin_src elisp 712 | ;; (assess-roundtrip-indentation= 713 | ;; 'emacs-lisp-mode 714 | ;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))") 715 | ;; #+end_src 716 | 717 | ;; #+RESULTS: 718 | ;; : t 719 | 720 | ;; While these are useful for simple forms of indentation checking, they have 721 | ;; the significant problem of writing indented code inside an Emacs string. An 722 | ;; easier solution for longer pieces of code is to use 723 | ;; `assess-file-roundtrip-indentation='. This opens a file (safely using 724 | ;; `assess-make-related-file'), unindents, and reindents. The mode must be set 725 | ;; up automatically by the file type. 726 | 727 | ;; #+begin_src elisp 728 | ;; (assess-file-roundtrip-indentation= 729 | ;; "assess.el") 730 | ;; #+end_src 731 | 732 | ;; #+RESULTS: 733 | 734 | ;; All of these methods are fully supported with ert explainer functions -- as 735 | ;; before they use diff where possible to compare the two forms. 736 | 737 | 738 | ;; *** Implementation 739 | 740 | ;; We start with some functionality for making Emacs quiet while indenting, 741 | ;; otherwise we will get a large amount of spam on the command line. Emacs needs 742 | ;; to have a better technique for shutting up `message'. 743 | 744 | ;; #+begin_src emacs-lisp 745 | (defun assess--indent-buffer (&optional column) 746 | (let ((inhibit-message t)) 747 | (cond 748 | (column 749 | (indent-region (point-min) (point-max) column)) 750 | ;; if indent-region-function is set, use it, and hope that it is not 751 | ;; noisy. 752 | (indent-region-function 753 | (funcall indent-region-function (point-min) (point-max))) 754 | (t 755 | (seq-map 756 | (lambda (m) 757 | (goto-char m) 758 | (indent-according-to-mode)) 759 | (m-buffer-match-line-start (current-buffer))))))) 760 | 761 | (defun assess--indent-in-mode (mode unindented) 762 | (with-temp-buffer 763 | (insert 764 | (assess-ensure-string unindented)) 765 | (funcall mode) 766 | (assess--indent-buffer) 767 | (buffer-string))) 768 | ;; #+end_src 769 | 770 | ;; Now for the basic indentation= comparison. 771 | 772 | ;; #+begin_src emacs-lisp 773 | (defun assess-indentation= (mode unindented indented) 774 | "Return non-nil if UNINDENTED indents in MODE to INDENTED. 775 | Both UNINDENTED and INDENTED can be any value usable by 776 | `assess-ensure-string'. Indentation is performed using 777 | `indent-region', which MODE should set up appropriately. 778 | 779 | See also `assess-file-roundtrip-indentation=' for an 780 | alternative mechanism." 781 | (assess= 782 | (assess--indent-in-mode 783 | mode 784 | unindented) 785 | indented)) 786 | 787 | (defun assess-explain-indentation= (mode unindented indented) 788 | "Explanation function for `assess-indentation='." 789 | (assess-explain= 790 | (assess--indent-in-mode 791 | mode 792 | unindented) 793 | indented)) 794 | 795 | (put 'assess-indentation= 'ert-explainer 'assess-explain-indentation=) 796 | ;; #+end_src 797 | 798 | ;; Roundtripping. 799 | 800 | ;; #+begin_src emacs-lisp 801 | (defun assess--buffer-unindent (buffer) 802 | (with-current-buffer 803 | buffer 804 | (assess--indent-buffer 0))) 805 | 806 | (defun assess--roundtrip-1 (comp mode indented) 807 | (with-temp-buffer 808 | (funcall comp 809 | mode 810 | (progn 811 | (insert 812 | (assess-ensure-string indented)) 813 | (assess--buffer-unindent (current-buffer)) 814 | (buffer-string)) 815 | indented))) 816 | 817 | (defun assess-roundtrip-indentation= (mode indented) 818 | "Return t if in MODE, text in INDENTED is corrected indented. 819 | 820 | This is checked by unindenting the text, then reindenting it according 821 | to MODE. 822 | 823 | See also `assess-indentation=' and 824 | `assess-file-roundtrip-indentation=' for alternative 825 | mechanisms of checking indentation." 826 | (assess--roundtrip-1 827 | #'assess-indentation= 828 | mode indented)) 829 | 830 | (defun assess-explain-roundtrip-indentation= (mode indented) 831 | "Explanation function for `assess-roundtrip-indentation='." 832 | (assess--roundtrip-1 833 | #'assess-explain-indentation= 834 | mode indented)) 835 | 836 | (put 'assess-roundtrip-indentation= 837 | 'ert-explainer 838 | 'assess-explain-roundtrip-indentation=) 839 | ;; #+end_src 840 | 841 | ;; And file based checking. 842 | 843 | ;; #+begin_src emacs-lisp 844 | (defun assess--file-roundtrip-1 (comp file) 845 | (funcall 846 | comp 847 | (assess-with-find-file 848 | (assess-make-related-file file) 849 | (assess--buffer-unindent (current-buffer)) 850 | (assess--indent-buffer) 851 | (buffer-string)) 852 | (assess-file file))) 853 | 854 | (defun assess-file-roundtrip-indentation= (file) 855 | "Return t if text in FILE is indented correctly. 856 | 857 | FILE is copied with `assess-make-related-file', so this 858 | function should be side-effect free whether or not FILE is 859 | already open. The file is opened with `find-file-noselect', so 860 | hooks associated with interactive visiting of a file should all 861 | be called, with the exception of directory local variables, as 862 | the copy of FILE will be in a different directory." 863 | (assess--file-roundtrip-1 864 | #'assess= file)) 865 | 866 | (defun assess-explain-file-roundtrip-indentation= (file) 867 | "Explanation function for `assess-file-roundtrip-indentation=." 868 | (assess--file-roundtrip-1 869 | #'assess-explain= file)) 870 | 871 | (put 'assess-file-roundtrip-indentation= 872 | 'ert-explainer 873 | 'assess-explain-file-roundtrip-indentation=) 874 | ;; #+end_src 875 | 876 | ;; ** Font-Lock 877 | 878 | ;; Here we define two predicates that can be used to checking 879 | ;; fontification/syntax highlighting; as with indentation, one accepts strings 880 | ;; but requires an explicit mode, while the other reads from file and depends on 881 | ;; the normal Emacs mechanisms for defining the mode. These two are 882 | ;; `assess-font-at=' and `assess-file-font-at='. Both of these have the same 883 | ;; interface and have attached explainer functions. Here, we show examples with 884 | ;; `assess-face-at='. 885 | 886 | ;; The simplest use is to specify a point location and a face. This returns true 887 | ;; if at least that face is present at the location. 888 | 889 | ;; #+begin_src elisp 890 | ;; (assess-face-at= 891 | ;; "(defun x ())" 892 | ;; 'emacs-lisp-mode 893 | ;; 2 894 | ;; 'font-lock-keyword-face) 895 | ;; #+end_src 896 | 897 | ;; It is also possible to specify several locations in a list, with a single 898 | ;; face. This checks that the given font is present at every location. 899 | 900 | ;; #+begin_src elisp 901 | ;; (assess-face-at= 902 | ;; "(defun x ()) 903 | ;; (defun y ()) 904 | ;; (defun z ())" 905 | ;; 'emacs-lisp-mode 906 | ;; '(2 15 28) 907 | ;; 'font-lock-keyword-face) 908 | ;; #+end_src 909 | 910 | ;; Or, we can specify a list of faces in which case the locations and faces are 911 | ;; checked in a pairwise manner. 912 | 913 | ;; #+begin_src elisp 914 | ;; (assess-face-at= 915 | ;; "(defun x ())" 916 | ;; 'emacs-lisp-mode 917 | ;; '(2 8) 918 | ;; '(font-lock-keyword-face font-lock-function-name-face)) 919 | ;; #+end_src 920 | 921 | ;; It is also possible to define locations with regexps; again either one or 922 | ;; multiple regexps can be used. With a single string, all matches are checked, 923 | ;; with the first match to the first is checked, then the next match to the 924 | ;; second, incrementally. 925 | 926 | ;; #+begin_src elisp 927 | ;; (assess-face-at= 928 | ;; "(defun x ())\n(defun y ())\n(defun z ())" 929 | ;; 'emacs-lisp-mode 930 | ;; "defun" 931 | ;; 'font-lock-keyword-face) 932 | 933 | ;; (assess-face-at= 934 | ;; "(defun x ())\n(defmacro y ())\n(defun z ())" 935 | ;; 'emacs-lisp-mode 936 | ;; '("defun" "defmacro" "defun") 937 | ;; 'font-lock-keyword-face) 938 | ;; #+end_src 939 | 940 | 941 | ;; The locations can also be specified as a `lambda' which takes a single 942 | ;; argument of a buffer. The return result can be any form of location accepted 943 | ;; by `assess-face-at=', including a list of match data generated, as in this 944 | ;; case, by the `m-buffer' package. 945 | 946 | ;; #+begin_src elisp 947 | ;; (assess-face-at= 948 | ;; "(defun x ())\n(defun y ())\n(defun z ())" 949 | ;; 'emacs-lisp-mode 950 | ;; (lambda(buf) 951 | ;; (m-buffer-match buf "defun")) 952 | ;; 'font-lock-keyword-face) 953 | ;; #+end_src 954 | 955 | 956 | ;; *** Implementation 957 | 958 | ;; First, `assess-face-at='. 959 | 960 | 961 | ;; #+begin_src emacs-lisp 962 | (defun assess--face-at-location= 963 | (location face property throw-on-nil) 964 | ;; it's match data 965 | (if (listp location) 966 | ;; We need to test every point but not the last because the match is 967 | ;; passed the end. 968 | (let ((all nil)) 969 | (cl-loop for i from 970 | (marker-position (car location)) 971 | below 972 | (marker-position (cadr location)) 973 | do 974 | (setq all 975 | (cons (assess--face-at-location= 976 | i face 977 | property throw-on-nil) 978 | all))) 979 | (seq-every-p #'identity all)) 980 | (let* ((local-faces 981 | (get-text-property location property)) 982 | (rtn 983 | ;; for face this can be one of -- a face name (a symbol or string) 984 | ;; a list of faces, or a plist of face attributes 985 | (pcase local-faces 986 | ;; compare directly 987 | ((pred symbolp) 988 | (eq face local-faces)) 989 | ;; give up -- we should probably be able to compare the plists here. 990 | ((and `(,s . ,_) 991 | (guard (keywordp s))) 992 | nil) 993 | ;; compare that we have at least this. 994 | ((and `(,s . ,_) 995 | (guard (symbolp s))) 996 | (member face s))))) 997 | (if (and throw-on-nil 998 | (not rtn)) 999 | (throw 1000 | 'face-non-match 1001 | (format "Face does not match expected value 1002 | \tExpected: %s 1003 | \tActual: %s 1004 | \tLocation: %s 1005 | \tLine Context: %s 1006 | \tbol Position: %s 1007 | " 1008 | face local-faces location 1009 | (thing-at-point 'line) 1010 | (m-buffer-at-line-beginning-position 1011 | (current-buffer) location))) 1012 | rtn)))) 1013 | 1014 | 1015 | (defun assess--face-at= 1016 | (buffer locations faces property throw-on-nil) 1017 | (let* ( 1018 | ;; default property 1019 | (property (or property 'face)) 1020 | ;; make sure we have a list of locations 1021 | (locations 1022 | (pcase locations 1023 | ((pred functionp) 1024 | (funcall locations buffer)) 1025 | ((pred listp) 1026 | locations) 1027 | (_ (list locations)))) 1028 | (first-location 1029 | (car locations)) 1030 | ;; make sure we have a list of markers 1031 | (locations 1032 | (cond 1033 | ((integerp first-location) 1034 | (m-buffer-pos-to-marker buffer locations)) 1035 | ((stringp first-location) 1036 | (m-buffer-match-multi locations :buffer buffer)) 1037 | ;; markers 1038 | ((markerp first-location) 1039 | locations) 1040 | ;; match data 1041 | ((and (listp first-location) 1042 | (markerp (car first-location))) 1043 | locations))) 1044 | ;; make sure we have a list of faces 1045 | (faces 1046 | (if (and (listp faces) 1047 | ;; but not nil 1048 | (not (eq nil faces))) 1049 | faces 1050 | (list faces))) 1051 | ;; make sure faces is as long as locations 1052 | (faces 1053 | (progn 1054 | (while (> (length locations) 1055 | (length faces)) 1056 | ;; cycle faces if needed 1057 | (setq faces (append faces (seq-copy faces)))) 1058 | faces))) 1059 | (seq-every-p 1060 | (lambda (it) 1061 | (assess--face-at-location= 1062 | (car it) (cdr it) property throw-on-nil)) 1063 | (seq-mapn #'cons locations faces)))) 1064 | 1065 | (defun assess--face-at=-1 (x mode locations faces property throw-on-nil) 1066 | (with-temp-buffer 1067 | (insert (assess-ensure-string x)) 1068 | (funcall mode) 1069 | (if (fboundp 'font-lock-ensure) 1070 | (font-lock-ensure) 1071 | (with-no-warnings (font-lock-fontify-buffer))) 1072 | (assess--face-at= (current-buffer) locations faces property throw-on-nil))) 1073 | 1074 | (defun assess-face-at= 1075 | (x mode locations faces &optional property) 1076 | "Return non-nil if in X with MODE at MARKERS, FACES are present on PROPERTY. 1077 | 1078 | This function tests if one or more faces are present at specific 1079 | locations in some text. It operates over single or multiple 1080 | values for both locations and faces; if there are more locations 1081 | than faces, then faces will be cycled over. If locations are 1082 | match data, then each the beginning and end of each match are 1083 | tested against each face. 1084 | 1085 | X can be a buffer, file name or string -- see 1086 | `assess-ensure-string' for details. 1087 | 1088 | MODE is the major mode with which to fontify X -- actually, it 1089 | will just be a function called to initialize the buffer. 1090 | 1091 | LOCATIONS can be either one or a list of the following things: 1092 | integer positions in X; markers in X (or nil!); match data in X; 1093 | or strings which match X. If this is a list, all items in list 1094 | should be of the same type. 1095 | 1096 | FACES can be one or more faces. 1097 | 1098 | PROPERTY is the text property on which to check the faces. 1099 | 1100 | See also `assess-ensure-string' for treatment of the parameter X. 1101 | 1102 | See `assess-file-face-at=' for a similar function which 1103 | operates over files and takes the mode from that file." 1104 | (assess--face-at=-1 x mode locations faces property nil)) 1105 | 1106 | (defun assess-explain-face-at= 1107 | (x mode locations faces &optional property) 1108 | (catch 'face-non-match 1109 | (assess--face-at=-1 x mode locations faces property t))) 1110 | 1111 | (put 'assess-face-at= 1112 | 'ert-explainer 1113 | 'assess-explain-face-at=) 1114 | ;; #+end_src 1115 | 1116 | ;; Followed by `assess-file-face-at='. 1117 | 1118 | ;; #+begin_src emacs-lisp 1119 | (defun assess--file-face-at=-1 (file locations faces property throw-on-nil) 1120 | (assess-with-find-file 1121 | (assess-make-related-file file) 1122 | (if (fboundp 'font-lock-ensure) 1123 | (font-lock-ensure) 1124 | (with-no-warnings (font-lock-fontify-buffer))) 1125 | (assess--face-at= (current-buffer) locations faces property throw-on-nil))) 1126 | 1127 | (defun assess-file-face-at= (file locations faces &optional property) 1128 | (assess--file-face-at=-1 file locations faces property nil)) 1129 | 1130 | (defun assess-explain-file-face-at= (file locations faces &optional property) 1131 | (catch 'face-non-match 1132 | (assess--file-face-at=-1 file locations faces property t))) 1133 | 1134 | (put 'assess-file-face-at= 1135 | 'ert-explainer 1136 | 'assess-explain-file-face-at=) 1137 | ;; #+end_src 1138 | 1139 | 1140 | ;; #+begin_src emacs-lisp 1141 | (provide 'assess) 1142 | ;;; assess.el ends here 1143 | ;; #+end_src 1144 | -------------------------------------------------------------------------------- /dev-resources/elisp-fontified.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016-2022 Free Software Foundation, Inc. 4 | 5 | (defun functionname (_args &optional _body) 6 | (+ 1 2)) 7 | 8 | (defun functionname2 (_args &optional _body) 9 | (+ 1 3)) 10 | -------------------------------------------------------------------------------- /dev-resources/elisp-indented.eld: -------------------------------------------------------------------------------- 1 | ( 2 | ( 3 | ( 4 | ( 5 | )))) 6 | -------------------------------------------------------------------------------- /dev-resources/elisp-unindented.eld: -------------------------------------------------------------------------------- 1 | ( 2 | ( 3 | ( 4 | ( 5 | )))) -------------------------------------------------------------------------------- /dev-resources/goodbye.txt: -------------------------------------------------------------------------------- 1 | goodbye 2 | -------------------------------------------------------------------------------- /dev-resources/hello.txt: -------------------------------------------------------------------------------- 1 | hello 2 | -------------------------------------------------------------------------------- /test-by-cp: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | cd .. 4 | mkdir copy 5 | cd copy 6 | cp -rf ../app/* . 7 | 8 | rm makefile-local 9 | make cask-free-test 10 | -------------------------------------------------------------------------------- /test-from-git: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | cd .. 4 | mkdir git 5 | cd git 6 | git clone ../app . 7 | make test 8 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | ## what ever we called, don't do it here 2 | default: 3 | $(MAKE) -C .. 4 | 5 | $(MAKECMDGOALS): 6 | $(MAKE) -C .. $(MAKECMDGOALS) 7 | -------------------------------------------------------------------------------- /test/assess-call-test.el: -------------------------------------------------------------------------------- 1 | ;;; assess-call-test.el --- Tests for assess-call.el -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; The contents of this file are subject to the GPL License, Version 3.0. 6 | 7 | ;; Copyright (C) 2015, 2016, Phillip Lord, Newcastle University 8 | 9 | ;; This program is free software: you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | 23 | ;;; Code: 24 | 25 | ;; ** Requires 26 | 27 | ;; #+begin_src emacs-lisp 28 | (require 'ert) 29 | (require 'assess) 30 | (require 'assess-call) 31 | 32 | (defun assess-call-no-advice () 33 | ;; Check by version number 34 | (if (and 35 | (= emacs-major-version 24) 36 | (or (= emacs-minor-version 3) 37 | (= emacs-minor-version 2) 38 | (= emacs-minor-version 1))) 39 | :failed :passed)) 40 | 41 | (defun assess-call-return-car (&rest args) 42 | (car args)) 43 | 44 | (defun assess-call-call-return-car (&rest args) 45 | (apply #'assess-call-return-car args)) 46 | 47 | (ert-deftest call-capture () 48 | :expected-result (assess-call-no-advice) 49 | (should 50 | (equal 51 | '(((10 11 12) . 10)) 52 | (assess-call-capture 53 | 'assess-call-return-car 54 | (lambda () 55 | (assess-call-return-car 10 11 12)))))) 56 | 57 | (ert-deftest call-capture-deep () 58 | :expected-result (assess-call-no-advice) 59 | (should 60 | (equal 61 | '(((20 21 22) . 20)) 62 | (assess-call-capture 63 | 'assess-call-return-car 64 | (lambda () 65 | (assess-call-call-return-car 20 21 22)))))) 66 | 67 | (defun assess-call-capture-multiply (a b) 68 | (* a b)) 69 | 70 | (ert-deftest call-capture-twice () 71 | :expected-result (assess-call-no-advice) 72 | (should 73 | (equal 74 | '(((3 4) . 12) ((1 2) . 2)) 75 | (assess-call-capture 76 | 'assess-call-capture-multiply 77 | (lambda () 78 | (assess-call-capture-multiply 1 2) 79 | (assess-call-capture-multiply 3 4)))))) 80 | 81 | (defun assess-call-adviced-p (symbol) 82 | "Return non-nil if SYMBOL has advice." 83 | ;; eeech 84 | (let ((retn nil)) 85 | (advice-mapc 86 | (lambda (&rest _) 87 | (setq retn t)) 88 | symbol) 89 | retn)) 90 | 91 | (ert-deftest assess-call-test-capture-fail () 92 | :expected-result (assess-call-no-advice) 93 | (should-not 94 | (assess-call-adviced-p 'assess-call-capture-multiply)) 95 | (should 96 | (let ((retn nil)) 97 | (assess-call-capture 98 | 'assess-call-capture-multiply 99 | (lambda () 100 | (setq retn 101 | (assess-call-adviced-p 'assess-call-capture-multiply)))) 102 | retn)) 103 | (should-not 104 | (condition-case nil 105 | (assess-call-capture 106 | 'assess-call-capture-multiply 107 | (lambda () 108 | (signal 'assess-deliberate-error nil))) 109 | (assess-deliberate-error 110 | (assess-call-adviced-p 'assess-call-capture-multiply))))) 111 | 112 | (defvar assess-call-test-hook nil) 113 | 114 | (ert-deftest assess-call-test-hook-test () 115 | (should 116 | (equal 117 | '(nil) 118 | (assess-call-capture-hook 119 | 'assess-call-test-hook 120 | (lambda () 121 | (run-hooks 'assess-call-test-hook))))) 122 | (should 123 | (equal 124 | '(nil nil) 125 | (assess-call-capture-hook 126 | 'assess-call-test-hook 127 | (lambda () 128 | (run-hooks 'assess-call-test-hook) 129 | (run-hooks 'assess-call-test-hook))))) 130 | (should 131 | (equal 132 | '((bob)) 133 | (assess-call-capture-hook 134 | 'assess-call-test-hook 135 | (lambda () 136 | (run-hook-with-args 'assess-call-test-hook 137 | 'bob)))))) 138 | 139 | 140 | (ert-deftest assess-call-test-hook-fail () 141 | ;; should be nil 142 | (should (not assess-call-test-hook)) 143 | ;; and should be nil if we error 144 | (should 145 | (condition-case nil 146 | (assess-call-capture-hook 147 | 'assess-call-test-hook 148 | (lambda () 149 | (signal 'assess-deliberate-error nil))) 150 | (assess-deliberate-error 151 | (not assess-call-test-hook))))) 152 | 153 | 154 | (ert-deftest assess-call-return-value () 155 | "Test that return of the instrumented form is not affected. 156 | 157 | The form that we are capturing should return the same value that 158 | it would were it not instrumented, which was not true with 159 | earlier versions of this library." 160 | :expected-result (assess-call-no-advice) 161 | (should 162 | (= 4 163 | (let ((rtn-from-form)) 164 | (assess-call-capture 165 | #'assess-call-capture-multiply 166 | (lambda () 167 | (setq rtn-from-form 168 | (assess-call-capture-multiply 2 2)))) 169 | rtn-from-form)))) 170 | 171 | 172 | (provide 'assess-call-test) 173 | ;;; assess-call-test ends here 174 | -------------------------------------------------------------------------------- /test/assess-discover-test.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2016-2022 Free Software Foundation, Inc. 4 | 5 | (ert-deftest assess-discover-test-has-this-been-defined () 6 | "This test is here so that we can test elsewhere that is has 7 | actually been defined." 8 | (should t)) 9 | 10 | (provide 'assess-discover-test) 11 | -------------------------------------------------------------------------------- /test/assess-robot-test.el: -------------------------------------------------------------------------------- 1 | ;;; assess-robot-test.el --- Test support functions -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; This file is not part of Emacs 6 | 7 | ;; Author: Phillip Lord 8 | ;; Maintainer: Phillip Lord 9 | 10 | ;; The contents of this file are subject to the GPL License, Version 3.0. 11 | 12 | ;; Copyright (C) 2015, 2016, Phillip Lord 13 | 14 | ;; This program is free software: you can redistribute it and/or modify 15 | ;; it under the terms of the GNU General Public License as published by 16 | ;; the Free Software Foundation, either version 3 of the License, or 17 | ;; (at your option) any later version. 18 | 19 | ;; This program is distributed in the hope that it will be useful, 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 | ;; GNU General Public License for more details. 23 | 24 | ;; You should have received a copy of the GNU General Public License 25 | ;; along with this program. If not, see . 26 | 27 | ;;; Code: 28 | 29 | (require 'assess) 30 | (require 'assess-robot) 31 | (require 'ert) 32 | 33 | (ert-deftest assess-robot-test-with-switched-buffer () 34 | (should 35 | (with-temp-buffer 36 | (let ((c (current-buffer))) 37 | (assess-robot-with-switched-buffer 38 | (current-buffer)) 39 | (buffer-live-p c)))) 40 | (should-not 41 | (buffer-live-p 42 | (with-temp-buffer 43 | (assess-robot-with-switched-buffer 44 | (current-buffer) 45 | (current-buffer)))))) 46 | 47 | (ert-deftest assess-robot-test-with-temp-switched-buffer () 48 | (should-not 49 | (let ((b4 (current-buffer))) 50 | (assess-robot-with-temp-switched-buffer 51 | (equal 52 | b4 (current-buffer))))) 53 | (should-not 54 | (buffer-live-p 55 | (assess-robot-with-temp-switched-buffer 56 | (current-buffer))))) 57 | 58 | (ert-deftest assess-robot-test-with-switched-buffer-string () 59 | (should 60 | (assess= 61 | "hello" 62 | (assess-robot-with-switched-buffer-string 63 | (insert "hello"))))) 64 | 65 | (ert-deftest assess-robot-test-execute-kmacro () 66 | (should 67 | (assess= 68 | "hello" 69 | (assess-robot-with-switched-buffer-string 70 | (assess-robot-execute-kmacro 71 | " 72 | hello ;; self-insert-command * 5 73 | "))))) 74 | 75 | 76 | (provide 'assess-robot-test) 77 | -------------------------------------------------------------------------------- /test/assess-test.el: -------------------------------------------------------------------------------- 1 | ;;; assess-test.el --- Tests for assess.el -*- lexical-binding: t -*- 2 | 3 | ;;; Header: 4 | 5 | ;; The contents of this file are subject to the GPL License, Version 3.0. 6 | 7 | ;; Copyright (C) 2015, 2016, Phillip Lord, Newcastle University 8 | 9 | ;; This program is free software: you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | 23 | ;;; Code: 24 | 25 | ;; ** Requires 26 | 27 | ;; #+begin_src emacs-lisp 28 | (require 'load-relative) 29 | (require 'assess) 30 | (require 'cl-lib) 31 | 32 | ;; #+end_src 33 | 34 | ;; ** Always failing test 35 | 36 | ;; For when I need to test my test scripts! 37 | 38 | ;; #+begin_src emacs-lisp 39 | (ert-deftest assess-fail-for-sure () 40 | :expected-result :failed 41 | (should nil)) 42 | ;; #+end_src 43 | 44 | ;; ** Test Extraction 45 | 46 | ;; Assess supports tests functions which means that we need the ability to test 47 | ;; tests. This code simple extracts knowledge from the results of tests. 48 | 49 | ;; #+begin_src emacs-lisp 50 | (defun assess-test--plist-from-result (result) 51 | (cl-cdadr 52 | (ert-test-result-with-condition-condition result))) 53 | 54 | (ert-deftest plist-extraction () 55 | (let ((tmp 56 | (assess-test--plist-from-result 57 | (ert-run-test 58 | (make-ert-test 59 | :body 60 | (lambda () 61 | (should 62 | (eq 1 2)))))))) 63 | (should 64 | (equal 65 | tmp 66 | '(:form (eq 1 2) :value nil))))) 67 | 68 | (defun assess-test--explanation-from-result (result) 69 | (plist-get 70 | (assess-test--plist-from-result result) 71 | :explanation)) 72 | 73 | (ert-deftest explanation-extraction-from-result () 74 | "Test that explanation is extractable from failing test. 75 | This also tests the advice on string=." 76 | (let ((tmp 77 | (ert-run-test 78 | (make-ert-test 79 | :body 80 | (lambda () 81 | (should 82 | (assess= "1" "2"))))))) 83 | (should 84 | (assess-test--explanation-from-result tmp)))) 85 | 86 | (defun assess-test--explanation (f) 87 | (assess-test--explanation-from-result 88 | (ert-run-test 89 | (make-ert-test 90 | :body f)))) 91 | 92 | (ert-deftest explanation-extraction () 93 | "Test that explanation is extractable from failing test. 94 | This also tests the advice on string=." 95 | (should 96 | (assess-test--explanation 97 | (lambda () 98 | (should 99 | (assess= "1" "2")))))) 100 | ;; #+end_src 101 | 102 | ;; ** Ensure-String testing 103 | 104 | ;; #+begin_src emacs-lisp 105 | (defvar assess-test-hello.txt 106 | (relative-expand-file-name "../dev-resources/hello.txt")) 107 | 108 | (ert-deftest ensure-string () 109 | (should 110 | (equal "hello" 111 | (assess-ensure-string "hello"))) 112 | (should 113 | (with-temp-buffer 114 | (equal "hello" 115 | (progn 116 | (insert "hello") 117 | (assess-ensure-string (current-buffer)))))) 118 | (should 119 | (with-temp-buffer 120 | (equal "hello\n" 121 | (assess-ensure-string 122 | (assess-file assess-test-hello.txt))))) 123 | (should-error 124 | (assess-ensure-string :hello))) 125 | 126 | ;; #+end_src 127 | 128 | ;; ** Compare Buffer to String 129 | 130 | ;; #+begin_src emacs-lisp 131 | 132 | (ert-deftest buffer-string= () 133 | (with-temp-buffer 134 | (insert "hello") 135 | (should 136 | (assess= 137 | (current-buffer) 138 | "hello"))) 139 | (with-temp-buffer 140 | (insert "goodbye") 141 | (should-not 142 | (assess= 143 | (current-buffer) 144 | "hello"))) 145 | (should 146 | (assess-test--explanation 147 | (lambda () 148 | (with-temp-buffer 149 | (insert "goodbye") 150 | (should 151 | (assess= 152 | (current-buffer) 153 | "hello"))))))) 154 | 155 | ;; #+end_src 156 | 157 | ;; ** Buffer to Buffer 158 | 159 | ;; #+begin_src emacs-lisp 160 | 161 | (ert-deftest buffer= () 162 | (assess-with-temp-buffers 163 | ((a 164 | (insert "hello")) 165 | (b 166 | (insert "hello"))) 167 | (should 168 | (assess= a b))) 169 | (assess-with-temp-buffers 170 | ((a 171 | (insert "hello")) 172 | (b 173 | (insert "goodbye"))) 174 | (should-not 175 | (assess= 176 | a b))) 177 | (should 178 | (assess-with-temp-buffers 179 | ((a (insert "hello")) 180 | (b (insert "goodbye"))) 181 | (assess-test--explanation 182 | (lambda () 183 | (should 184 | (assess= 185 | a b))))))) 186 | 187 | ;; #+end_src 188 | 189 | ;; ** Buffer to file 190 | 191 | ;; #+begin_src emacs-lisp 192 | (ert-deftest file-string= () 193 | (should 194 | (assess= 195 | (assess-file 196 | assess-test-hello.txt) 197 | "hello\n")) 198 | (should-not 199 | (assess= 200 | (assess-file assess-test-hello.txt) 201 | "goodbye")) 202 | (should 203 | (assess-test--explanation 204 | (lambda () 205 | (should 206 | (assess= 207 | (assess-file 208 | assess-test-hello.txt) 209 | "goodbye")))))) 210 | 211 | 212 | ;; #+end_src 213 | 214 | ;; ** Preserved Buffer List and With Temp Buffers 215 | 216 | ;; #+begin_src emacs-lisp 217 | 218 | (ert-deftest preserved-buffer-list () 219 | (should 220 | (= 221 | (length (buffer-list)) 222 | (progn 223 | (assess-with-preserved-buffer-list 224 | (generate-new-buffer "preserved-buffer-list")) 225 | (length (buffer-list))))) 226 | 227 | (should 228 | (= 229 | (length (buffer-list)) 230 | (condition-case nil 231 | (assess-with-preserved-buffer-list 232 | (generate-new-buffer "preserved-buffer-list") 233 | (signal 'assess-deliberate-error nil)) 234 | (assess-deliberate-error 235 | (length (buffer-list))))))) 236 | 237 | (ert-deftest with-temp-buffers () 238 | (should 239 | (bufferp 240 | (assess-with-temp-buffers (a) a))) 241 | (should 242 | (bufferp 243 | (assess-with-temp-buffers 244 | ((a (insert "hello"))) 245 | a))) 246 | (should 247 | (equal 248 | "hello" 249 | (assess-with-temp-buffers 250 | ((a (insert "hello"))) 251 | (with-current-buffer 252 | a 253 | (buffer-string))))) 254 | (should 255 | (= 256 | (+ 2 (length (buffer-list))) 257 | (assess-with-temp-buffers (_a _b) 258 | (length (buffer-list))))) 259 | (should 260 | (= 261 | (length (buffer-list)) 262 | (progn 263 | (assess-with-temp-buffers (_a _b) nil) 264 | (length (buffer-list)))))) 265 | 266 | ;; #+end_src 267 | 268 | ;; ** Open Close files 269 | 270 | ;; #+begin_src emacs-lisp 271 | 272 | (ert-deftest assess-test-related-file () 273 | (should 274 | (file-exists-p 275 | (assess-make-related-file assess-test-hello.txt))) 276 | (should 277 | (assess= 278 | (assess-file assess-test-hello.txt) 279 | (assess-file 280 | (assess-make-related-file assess-test-hello.txt))))) 281 | 282 | (ert-deftest assess-test-with-find-file () 283 | (should 284 | (assess-with-find-file 285 | (assess-make-related-file assess-test-hello.txt))) 286 | (should-not 287 | (assess= 288 | assess-test-hello.txt 289 | (assess-with-find-file 290 | (assess-make-related-file assess-test-hello.txt) 291 | (insert "hello") 292 | (buffer-string))))) 293 | 294 | ;; #+end_src 295 | 296 | ;; ** Creating Files and Directories 297 | ;; #+BEGIN_SRC emacs-lisp 298 | (ert-deftest assess-test-create-multiple-files () 299 | (assess-with-filesystem '("foo" "bar" "baz") 300 | (should (file-regular-p "foo")) 301 | (should (file-regular-p "bar")) 302 | (should (file-regular-p "baz")))) 303 | 304 | (ert-deftest assess-test-create-multiple-directories-and-files () 305 | (assess-with-filesystem '("foo/" "bar/" "baz") 306 | (should (file-directory-p "foo")) 307 | (should (file-directory-p "bar")) 308 | (should (file-regular-p "baz")))) 309 | 310 | (ert-deftest assess-test-create-nested-directories () 311 | (assess-with-filesystem '("foo/bar" "foo/baz/") 312 | (should (file-regular-p "foo/bar")) 313 | (should (file-directory-p "foo/baz")))) 314 | 315 | (defun assess-test-file-contain-p (file content) 316 | "Return nil iff FILE does not contain CONTENT." 317 | (and (file-regular-p file) 318 | (with-temp-buffer 319 | (insert-file-contents file) 320 | (string-match-p content (buffer-string))))) 321 | 322 | (ert-deftest assess-test-create-non-empty-file () 323 | (assess-with-filesystem '(("foo" "amazing content")) 324 | (should (assess-test-file-contain-p "foo" "amazing content")))) 325 | 326 | (ert-deftest assess-test-create-non-empty-nested-file () 327 | (assess-with-filesystem '(("foo/bar" "amazing content")) 328 | (should (assess-test-file-contain-p "foo/bar" "amazing content")))) 329 | 330 | (ert-deftest assess-test-nest-files-recursively () 331 | (assess-with-filesystem '(("foo" ("bar" "baz" "bam/")) 332 | ("a/b" ("c" "d/")) 333 | ("x" (("y" ("z")) 334 | ("content" "content") 335 | "w"))) 336 | (should (file-regular-p "foo/bar")) 337 | (should (file-regular-p "foo/baz")) 338 | (should (file-regular-p "a/b/c")) 339 | (should (file-regular-p "x/y/z")) 340 | (should (file-regular-p "x/content")) 341 | (should (file-regular-p "x/w")) 342 | (should (assess-test-file-contain-p "x/content" "content")) 343 | (should (file-directory-p "foo/bam")) 344 | (should (file-directory-p "a/b/d")))) 345 | ;; #+END_SRC 346 | ;; ** Indentation Tests 347 | 348 | ;; #+begin_src emacs-lisp 349 | 350 | (ert-deftest assess--test-indent-in-mode () 351 | (should 352 | (assess= 353 | "( 354 | ( 355 | ( 356 | ( 357 | ))))" 358 | (assess--indent-in-mode 359 | 'emacs-lisp-mode 360 | "(\n(\n(\n(\n))))")))) 361 | 362 | (ert-deftest assess--test-indentation= () 363 | (should 364 | (assess-indentation= 365 | 'emacs-lisp-mode 366 | "(\n(\n(\n(\n))))" 367 | "( 368 | ( 369 | ( 370 | ( 371 | ))))")) 372 | (should-not 373 | (assess-indentation= 374 | 'emacs-lisp-mode 375 | "hello" 376 | "goodbye")) 377 | (should 378 | (assess-test--explanation 379 | (lambda () 380 | (should 381 | (assess-indentation= 382 | 'emacs-lisp-mode 383 | "hello" 384 | "goodbye")))))) 385 | 386 | (defvar assess-dev-resources 387 | (relative-expand-file-name "../dev-resources/")) 388 | 389 | (defvar assess-dev-elisp-indented 390 | (concat assess-dev-resources 391 | "elisp-indented.eld")) 392 | 393 | (defvar assess-dev-elisp-unindented 394 | (concat assess-dev-resources 395 | "elisp-unindented.eld")) 396 | 397 | (ert-deftest assess-test-roundtrip-indentation= () 398 | (should 399 | (assess-roundtrip-indentation= 400 | 'emacs-lisp-mode 401 | (assess-file assess-dev-elisp-indented))) 402 | (should-not 403 | (assess-roundtrip-indentation= 404 | 'emacs-lisp-mode 405 | (assess-file assess-dev-elisp-unindented)))) 406 | 407 | (ert-deftest assess-test-roundtrip-indentation-explain= () 408 | (should 409 | (assess-test--explanation 410 | (lambda () 411 | (should 412 | (assess-roundtrip-indentation= 413 | 'emacs-lisp-mode 414 | (assess-file assess-dev-elisp-unindented))))))) 415 | 416 | (ert-deftest assess-test-file-roundtrip-indentation= () 417 | (should 418 | (let ((auto-mode-alist '((".*" . emacs-lisp-mode)))) 419 | (assess-file-roundtrip-indentation= 420 | assess-dev-elisp-indented))) 421 | (should-not 422 | (let ((auto-mode-alist '((".*" . emacs-lisp-mode)))) 423 | (assess-file-roundtrip-indentation= 424 | assess-dev-elisp-unindented)))) 425 | 426 | (ert-deftest assess-test-file-roundtrip-indentation-explain= () 427 | ;; let bind auto-mode-alist because ".eld" is not associated with 428 | ;; emacs-lisp-mode before Emacs-29. Putting the let binding here 429 | ;; rather than in the lambda is necessary for reasons I don't quite understand 430 | (should 431 | (let ((auto-mode-alist '((".*" . emacs-lisp-mode)))) 432 | (assess-test--explanation 433 | (lambda () 434 | (should 435 | (assess-file-roundtrip-indentation= 436 | assess-dev-elisp-unindented))))))) 437 | 438 | ;; ** Face Tests 439 | (defvar assess-dev-elisp-fontified 440 | (concat assess-dev-resources 441 | "elisp-fontified.el")) 442 | 443 | (ert-deftest assess-test-face-at-simple () 444 | (should 445 | (assess-face-at= 446 | "(defun x ())" 447 | 'emacs-lisp-mode 448 | 2 449 | 'font-lock-keyword-face)) 450 | (should-not 451 | (assess-face-at= 452 | "(not-defun x ())" 453 | 'emacs-lisp-mode 454 | 2 455 | 'font-lock-keyword-face))) 456 | 457 | (ert-deftest assess-test-face-at-multiple-positions () 458 | (should 459 | (assess-face-at= 460 | "(defun x ()) 461 | (defun y ()) 462 | (defun z ())" 463 | 'emacs-lisp-mode 464 | '(2 15 28) 465 | 'font-lock-keyword-face)) 466 | (should-not 467 | (assess-face-at= 468 | "(defun x ()) 469 | (defun y ()) 470 | (not-defun z ())" 471 | 'emacs-lisp-mode 472 | '(2 15 28) 473 | 'font-lock-keyword-face))) 474 | 475 | (ert-deftest assess-test-face-at-multiple-faces () 476 | (should 477 | (assess-face-at= 478 | "(defun x ())" 479 | 'emacs-lisp-mode 480 | '(2 8) 481 | '(font-lock-keyword-face font-lock-function-name-face))) 482 | (should-not 483 | (assess-face-at= 484 | "(defun x ())" 485 | 'emacs-lisp-mode 486 | '(2 10) 487 | '(font-lock-keyword-face font-lock-function-name-face)))) 488 | 489 | (ert-deftest assess-test-face-at-with-m-buffer () 490 | (should 491 | (assess-face-at= 492 | "(defun x ())\n(defun y ())\n(defun z ())" 493 | 'emacs-lisp-mode 494 | (lambda(buf) 495 | (m-buffer-match buf "defun")) 496 | 'font-lock-keyword-face))) 497 | 498 | (ert-deftest assess-test-face-at-with-strings () 499 | (should 500 | (assess-face-at= 501 | "(defun x ())\n(defun y ())\n(defun z ())" 502 | 'emacs-lisp-mode 503 | "defun" 504 | 'font-lock-keyword-face)) 505 | (should 506 | (assess-face-at= 507 | "(defun x ())\n(defmacro y ())\n(defun z ())" 508 | 'emacs-lisp-mode 509 | '("defun" "defmacro" "defun") 510 | 'font-lock-keyword-face))) 511 | 512 | (ert-deftest assess-test-file-face-at () 513 | (should 514 | (assess-file-face-at= 515 | assess-dev-elisp-fontified 516 | (lambda (buffer) 517 | (m-buffer-match buffer "defun")) 518 | 'font-lock-keyword-face))) 519 | 520 | (ert-deftest assess-discover-test () 521 | "Test to see if another test has been defined, which should be auto-discovered" 522 | (should 523 | (get 'assess-discover-test-has-this-been-defined 'ert--test))) 524 | 525 | ;; https://github.com/phillord/assess/issues/4 526 | (ert-deftest issue-4-has-type-face () 527 | "Test that no faces are present at point." 528 | :expected-result 529 | ;; Emacs 24.2 just does not do this. 530 | (if (and 531 | (= emacs-major-version 24) 532 | (or (= emacs-minor-version 2) 533 | (= emacs-minor-version 1))) 534 | :failed :passed) 535 | (should-not 536 | (assess-face-at= "foo bar" 'fundamental-mode 537 | "bar" 'font-lock-type-face)) 538 | (should-not 539 | (let ((inhibit-message t)) 540 | (assess-face-at= "def" 'python-mode "def" nil)))) 541 | 542 | ;; https://github.com/phillord/assess/issues/5 543 | (ert-deftest issue-5-test-example () 544 | (should-not (assess-indentation= 'fundamental-mode "foo" "bar"))) 545 | 546 | 547 | (ert-deftest strings-with-unequal-properties () 548 | (should 549 | (assess= 550 | (propertize "hello" 'property 1) 551 | "hello")) 552 | (should 553 | (assess-with-temp-buffers 554 | ((a (insert ";; Commented") 555 | (emacs-lisp-mode) 556 | ;; use instead of font-lock-ensure for emacs 24 557 | (if (fboundp 'font-lock-ensure) 558 | (font-lock-ensure) 559 | (with-no-warnings (font-lock-fontify-buffer)))) 560 | (b (insert ";; Commented") 561 | (if (fboundp 'font-lock-ensure) 562 | (font-lock-ensure) 563 | (with-no-warnings (font-lock-fontify-buffer))))) 564 | (assess= a b)))) 565 | ;; #+end_src 566 | -------------------------------------------------------------------------------- /test/local-sandbox.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t; -*- 2 | 3 | ;; FIXME: Merely loading a file should not cause such drastic changes. 4 | 5 | (setq package-user-dir 6 | (concat 7 | default-directory 8 | "elpa-sandbox/" 9 | (int-to-string emacs-major-version) 10 | "." 11 | (int-to-string emacs-minor-version) 12 | )) 13 | 14 | 15 | (setq package-archives 16 | '(("gnu" . "https://elpa.gnu.org/packages/") 17 | ("melpa-stable" . "https://stable.melpa.org/packages/") 18 | )) 19 | 20 | ;; switch this off or Emacs-25 will fail to get to gnu 21 | (setq package-check-signature nil) 22 | (package-initialize) 23 | (package-refresh-contents) 24 | 25 | (package-install 'm-buffer) 26 | (package-install 'load-relative) 27 | 28 | (load-file "assess-discover.el") 29 | 30 | -------------------------------------------------------------------------------- /todo.org: -------------------------------------------------------------------------------- 1 | 2 | ** Pre/post command support functions 3 | 4 | Not sure how I can test these better -- but worth thinking about -- I guess do 5 | some set up, then and buffer-local pre or post command, run some stuff, 6 | compare. 7 | 8 | 9 | Do these get called with "call-interactively"? 10 | 11 | 12 | ** Minor mode local and global activation 13 | 14 | Tricky because global mode will affect all buffers. 15 | 16 | This is a tricky one to preserve activation status, but it can work. 17 | 18 | 19 | 20 | 21 | 22 | ** Should call functions 23 | 24 | Something to test whether a function has been called, and with what values. 25 | 26 | Easy enough to do with advice. 27 | 28 | ** Better ERT batch output 29 | 30 | ERT should output parsable error messages, with locations of files in batch. 31 | 32 | Compile mode should actually pick this up! 33 | 34 | ** Sisyphus-compile 35 | 36 | A compile mode for sisyphus which returns an internal Emacs. Should also 37 | prompt for emacs executable (with versions!), selector. 38 | --------------------------------------------------------------------------------