assess-0.6/0000755000175000017500000000000013620567707012527 5ustar dogslegdogslegassess-0.6/test/0000755000175000017500000000000013620567707013506 5ustar dogslegdogslegassess-0.6/test/assess-discover-test.el0000644000175000017500000000030313620567707020116 0ustar dogslegdogsleg(ert-deftest assess-discover-test-has-this-been-defined () "This test is here so that we can test elsewhere that is has actually been defined." (should t)) (provide 'assess-discover-test) assess-0.6/test/assess-robot-test.el0000644000175000017500000000414413620567707017434 0ustar dogslegdogsleg;;; assess-robot-test.el --- Test support functions -*- lexical-binding: t -*- ;;; Header: ;; This file is not part of Emacs ;; Author: Phillip Lord ;; Maintainer: Phillip Lord ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2015, 2016, Phillip Lord ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (require 'assess) (require 'assess-robot) (require 'ert) (ert-deftest assess-robot-test-with-switched-buffer () (should (with-temp-buffer (let ((c (current-buffer))) (assess-robot-with-switched-buffer (current-buffer)) (buffer-live-p c)))) (should-not (buffer-live-p (with-temp-buffer (assess-robot-with-switched-buffer (current-buffer) (current-buffer)))))) (ert-deftest assess-robot-test-with-temp-switched-buffer () (should-not (let ((b4 (current-buffer))) (assess-robot-with-temp-switched-buffer (equal b4 (current-buffer))))) (should-not (buffer-live-p (assess-robot-with-temp-switched-buffer (current-buffer))))) (ert-deftest assess-robot-test-with-switched-buffer-string () (should (assess= "hello" (assess-robot-with-switched-buffer-string (insert "hello"))))) (ert-deftest assess-robot-test-execute-kmacro () (should (assess= "hello" (assess-robot-with-switched-buffer-string (assess-robot-execute-kmacro " hello ;; self-insert-command * 5 "))))) (provide 'assess-robot-test) assess-0.6/test/Makefile0000644000175000017500000000016213620567707015145 0ustar dogslegdogsleg## what ever we called, don't do it here default: $(MAKE) -C .. $(MAKECMDGOALS): $(MAKE) -C .. $(MAKECMDGOALS) assess-0.6/test/local-sandbox.el0000644000175000017500000000110313620567707016551 0ustar dogslegdogsleg(setq package-user-dir (concat default-directory "elpa-sandbox/" (int-to-string emacs-major-version) "." (int-to-string emacs-minor-version) )) (setq package-archives '(("gnu" . "https://elpa.gnu.org/packages/") ("melpa-stable" . "https://stable.melpa.org/packages/") )) ;; switch this off or Emacs-25 will fail to get to gnu (setq package-check-signature nil) (package-initialize) (package-refresh-contents) (package-install 'm-buffer) (package-install 'load-relative) (load-file "assess-discover.el") assess-0.6/test/assess-test.el0000644000175000017500000003267513620567707016323 0ustar dogslegdogsleg;;; assess-test.el --- Tests for assess.el -*- lexical-binding: t -*- ;;; Header: ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2015, 2016, Phillip Lord, Newcastle University ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: ;; ** Requires ;; #+begin_src emacs-lisp (require 'load-relative) (require 'assess) (unless (require 'cl-lib nil t) (require 'cl) (defalias 'cl-cdadr 'cdadr) (defalias 'cl-loop 'loop)) ;; #+end_src ;; ** Always failing test ;; For when I need to test my test scripts! ;; #+begin_src emacs-lisp (ert-deftest assess-fail-for-sure () :expected-result :failed (should nil)) ;; #+end_src ;; ** Test Extraction ;; Assess supports tests functions which means that we need the ability to test ;; tests. This code simple extracts knowledge from the results of tests. ;; #+begin_src emacs-lisp (defun assess-test--plist-from-result (result) (cl-cdadr (ert-test-result-with-condition-condition result))) (ert-deftest plist-extraction () (let ((tmp (assess-test--plist-from-result (ert-run-test (make-ert-test :body (lambda () (should (eq 1 2)))))))) (should (equal tmp '(:form (eq 1 2) :value nil))))) (defun assess-test--explanation-from-result (result) (plist-get (assess-test--plist-from-result result) :explanation)) (ert-deftest explanation-extraction-from-result () "Test that explanation is extractable from failing test. This also tests the advice on string=." (let ((tmp (ert-run-test (make-ert-test :body (lambda () (should (assess= "1" "2"))))))) (should (assess-test--explanation-from-result tmp)))) (defun assess-test--explanation (f) (assess-test--explanation-from-result (ert-run-test (make-ert-test :body f)))) (ert-deftest explanation-extraction () "Test that explanation is extractable from failing test. This also tests the advice on string=." (should (assess-test--explanation (lambda () (should (assess= "1" "2")))))) ;; #+end_src ;; ** Ensure-String testing ;; #+begin_src emacs-lisp (defvar assess-test-hello.txt (relative-expand-file-name "../dev-resources/hello.txt")) (ert-deftest ensure-string () (should (equal "hello" (assess-ensure-string "hello"))) (should (with-temp-buffer (equal "hello" (progn (insert "hello") (assess-ensure-string (current-buffer)))))) (should (with-temp-buffer (equal "hello\n" (assess-ensure-string (assess-file assess-test-hello.txt))))) (should-error (assess-ensure-string :hello))) ;; #+end_src ;; ** Compare Buffer to String ;; #+begin_src emacs-lisp (ert-deftest buffer-string= () (with-temp-buffer (insert "hello") (should (assess= (current-buffer) "hello"))) (with-temp-buffer (insert "goodbye") (should-not (assess= (current-buffer) "hello"))) (should (assess-test--explanation (lambda () (with-temp-buffer (insert "goodbye") (should (assess= (current-buffer) "hello"))))))) ;; #+end_src ;; ** Buffer to Buffer ;; #+begin_src emacs-lisp (ert-deftest buffer= () (assess-with-temp-buffers ((a (insert "hello")) (b (insert "hello"))) (should (assess= a b))) (assess-with-temp-buffers ((a (insert "hello")) (b (insert "goodbye"))) (should-not (assess= a b))) (should (assess-with-temp-buffers ((a (insert "hello")) (b (insert "goodbye"))) (assess-test--explanation (lambda () (should (assess= a b))))))) ;; #+end_src ;; ** Buffer to file ;; #+begin_src emacs-lisp (ert-deftest file-string= () (should (assess= (assess-file assess-test-hello.txt) "hello\n")) (should-not (assess= (assess-file assess-test-hello.txt) "goodbye")) (should (assess-test--explanation (lambda () (should (assess= (assess-file assess-test-hello.txt) "goodbye")))))) ;; #+end_src ;; ** Preserved Buffer List and With Temp Buffers ;; #+begin_src emacs-lisp (ert-deftest preserved-buffer-list () (should (= (length (buffer-list)) (progn (assess-with-preserved-buffer-list (generate-new-buffer "preserved-buffer-list")) (length (buffer-list))))) (should (= (length (buffer-list)) (condition-case e (assess-with-preserved-buffer-list (generate-new-buffer "preserved-buffer-list") (signal 'assess-deliberate-error nil)) (assess-deliberate-error (length (buffer-list))))))) (ert-deftest with-temp-buffers () (should (bufferp (assess-with-temp-buffers (a) a))) (should (bufferp (assess-with-temp-buffers (a (insert "hello")) a))) (should (equal "hello" (assess-with-temp-buffers ((a (insert "hello"))) (with-current-buffer a (buffer-string))))) (should (= (+ 2 (length (buffer-list))) (assess-with-temp-buffers (a b) (length (buffer-list))))) (should (= (length (buffer-list)) (progn (assess-with-temp-buffers (a b)) (length (buffer-list)))))) ;; #+end_src ;; ** Open Close files ;; #+begin_src emacs-lisp (ert-deftest assess-test-related-file () (should (file-exists-p (assess-make-related-file assess-test-hello.txt))) (should (assess= (assess-file assess-test-hello.txt) (assess-file (assess-make-related-file assess-test-hello.txt))))) (ert-deftest assess-test-with-find-file () (should (assess-with-find-file (assess-make-related-file assess-test-hello.txt))) (should-not (assess= assess-test-hello.txt (assess-with-find-file (assess-make-related-file assess-test-hello.txt) (insert "hello") (buffer-string))))) ;; #+end_src ;; ** Creating Files and Directories ;; #+BEGIN_SRC emacs-lisp (ert-deftest assess-test-create-multiple-files () (assess-with-filesystem '("foo" "bar" "baz") (should (file-regular-p "foo")) (should (file-regular-p "bar")) (should (file-regular-p "baz")))) (ert-deftest assess-test-create-multiple-directories-and-files () (assess-with-filesystem '("foo/" "bar/" "baz") (should (file-directory-p "foo")) (should (file-directory-p "bar")) (should (file-regular-p "baz")))) (ert-deftest assess-test-create-nested-directories () (assess-with-filesystem '("foo/bar" "foo/baz/") (should (file-regular-p "foo/bar")) (should (file-directory-p "foo/baz")))) (defun assess-test-file-contain-p (file content) "Return nil iff FILE does not contain CONTENT." (and (file-regular-p file) (with-temp-buffer (insert-file-contents file) (string-match-p content (buffer-string))))) (ert-deftest assess-test-create-non-empty-file () (assess-with-filesystem '(("foo" "amazing content")) (should (assess-test-file-contain-p "foo" "amazing content")))) (ert-deftest assess-test-create-non-empty-nested-file () (assess-with-filesystem '(("foo/bar" "amazing content")) (should (assess-test-file-contain-p "foo/bar" "amazing content")))) (ert-deftest assess-test-nest-files-recursively () (assess-with-filesystem '(("foo" ("bar" "baz" "bam/")) ("a/b" ("c" "d/")) ("x" (("y" ("z")) ("content" "content") "w"))) (should (file-regular-p "foo/bar")) (should (file-regular-p "foo/baz")) (should (file-regular-p "a/b/c")) (should (file-regular-p "x/y/z")) (should (file-regular-p "x/content")) (should (file-regular-p "x/w")) (should (assess-test-file-contain-p "x/content" "content")) (should (file-directory-p "foo/bam")) (should (file-directory-p "a/b/d")))) ;; #+END_SRC ;; ** Indentation Tests ;; #+begin_src emacs-lisp (ert-deftest assess--test-indent-in-mode () (should (assess= "( ( ( ( ))))" (assess--indent-in-mode 'emacs-lisp-mode "(\n(\n(\n(\n))))")))) (ert-deftest assess--test-indentation= () (should (assess-indentation= 'emacs-lisp-mode "(\n(\n(\n(\n))))" "( ( ( ( ))))")) (should-not (assess-indentation= 'emacs-lisp-mode "hello" "goodbye")) (should (assess-test--explanation (lambda () (should (assess-indentation= 'emacs-lisp-mode "hello" "goodbye")))))) (defvar assess-dev-resources (relative-expand-file-name "../dev-resources/")) (defvar assess-dev-elisp-indented (concat assess-dev-resources "elisp-indented.el")) (defvar assess-dev-elisp-unindented (concat assess-dev-resources "elisp-unindented.el")) (ert-deftest assess-test-roundtrip-indentation= () (should (assess-roundtrip-indentation= 'emacs-lisp-mode (assess-file assess-dev-elisp-indented))) (should-not (assess-roundtrip-indentation= 'emacs-lisp-mode (assess-file assess-dev-elisp-unindented)))) (ert-deftest assess-test-roundtrip-indentation-explain= () (should (assess-test--explanation (lambda () (should (assess-roundtrip-indentation= 'emacs-lisp-mode (assess-file assess-dev-elisp-unindented))))))) (ert-deftest assess-test-file-roundtrip-indentation= () (should (assess-file-roundtrip-indentation= assess-dev-elisp-indented)) (should-not (assess-file-roundtrip-indentation= assess-dev-elisp-unindented))) (ert-deftest assess-test-file-roundtrip-indentation-explain= () (should (assess-test--explanation (lambda () (should (assess-file-roundtrip-indentation= assess-dev-elisp-unindented)))))) ;; ** Face Tests (defvar assess-dev-elisp-fontified (concat assess-dev-resources "elisp-fontified.el")) (ert-deftest assess-test-face-at-simple () (should (assess-face-at= "(defun x ())" 'emacs-lisp-mode 2 'font-lock-keyword-face)) (should-not (assess-face-at= "(not-defun x ())" 'emacs-lisp-mode 2 'font-lock-keyword-face))) (ert-deftest assess-test-face-at-multiple-positions () (should (assess-face-at= "(defun x ()) (defun y ()) (defun z ())" 'emacs-lisp-mode '(2 15 28) 'font-lock-keyword-face)) (should-not (assess-face-at= "(defun x ()) (defun y ()) (not-defun z ())" 'emacs-lisp-mode '(2 15 28) 'font-lock-keyword-face))) (ert-deftest assess-test-face-at-multiple-faces () (should (assess-face-at= "(defun x ())" 'emacs-lisp-mode '(2 8) '(font-lock-keyword-face font-lock-function-name-face))) (should-not (assess-face-at= "(defun x ())" 'emacs-lisp-mode '(2 10) '(font-lock-keyword-face font-lock-function-name-face)))) (ert-deftest assess-test-face-at-with-m-buffer () (should (assess-face-at= "(defun x ())\n(defun y ())\n(defun z ())" 'emacs-lisp-mode (lambda(buf) (m-buffer-match buf "defun")) 'font-lock-keyword-face))) (ert-deftest assess-test-face-at-with-strings () (should (assess-face-at= "(defun x ())\n(defun y ())\n(defun z ())" 'emacs-lisp-mode "defun" 'font-lock-keyword-face)) (should (assess-face-at= "(defun x ())\n(defmacro y ())\n(defun z ())" 'emacs-lisp-mode '("defun" "defmacro" "defun") 'font-lock-keyword-face))) (ert-deftest assess-test-file-face-at () (should (assess-file-face-at= assess-dev-elisp-fontified (lambda (buffer) (m-buffer-match buffer "defun")) 'font-lock-keyword-face))) (ert-deftest assess-discover-test () "Test to see if another test has been defined, which should be auto-discovered" (should (get 'assess-discover-test-has-this-been-defined 'ert--test))) ;; https://github.com/phillord/assess/issues/4 (ert-deftest issue-4-has-type-face () "Test that no faces are present at point." :expected-result ;; Emacs 24.2 just does not do this. (if (and (= emacs-major-version 24) (or (= emacs-minor-version 2) (= emacs-minor-version 1))) :failed :passed) (should-not (assess-face-at= "foo bar" 'fundamental-mode "bar" 'font-lock-type-face)) (should-not (let ((inhibit-message t)) (assess-face-at= "def" 'python-mode "def" nil)))) ;; https://github.com/phillord/assess/issues/5 (ert-deftest issue-5-test-example () (should-not (assess-indentation= 'fundamental-mode "foo" "bar"))) (ert-deftest strings-with-unequal-properties () (should (assess= (propertize "hello" 'property 1) "hello")) (should (assess-with-temp-buffers ((a (insert ";; Commented") (emacs-lisp-mode) ;; use instead of font-lock-ensure for emacs 24 (font-lock-fontify-buffer)) (b (insert ";; Commented") (font-lock-fontify-buffer))) (assess= a b)))) ;; #+end_src assess-0.6/test/assess-call-test.el0000644000175000017500000001104113620567707017214 0ustar dogslegdogsleg;;; assess-call-test.el --- Tests for assess-call.el -*- lexical-binding: t -*- ;;; Header: ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2015, 2016, Phillip Lord, Newcastle University ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: ;; ** Requires ;; #+begin_src emacs-lisp (require 'ert) (require 'assess) (require 'assess-call) (defun assess-call-no-advice () ;; Check by version number (if (and (= emacs-major-version 24) (or (= emacs-minor-version 3) (= emacs-minor-version 2) (= emacs-minor-version 1))) :failed :passed)) (defun assess-call-return-car (&rest args) (car args)) (defun assess-call-call-return-car (&rest args) (apply #'assess-call-return-car args)) (ert-deftest call-capture () :expected-result (assess-call-no-advice) (should (equal '(((10 11 12) . 10)) (assess-call-capture 'assess-call-return-car (lambda () (assess-call-return-car 10 11 12)))))) (ert-deftest call-capture-deep () :expected-result (assess-call-no-advice) (should (equal '(((20 21 22) . 20)) (assess-call-capture 'assess-call-return-car (lambda () (assess-call-call-return-car 20 21 22)))))) (defun assess-call-capture-multiply (a b) (* a b)) (ert-deftest call-capture-twice () :expected-result (assess-call-no-advice) (should (equal '(((3 4) . 12) ((1 2) . 2)) (assess-call-capture 'assess-call-capture-multiply (lambda () (assess-call-capture-multiply 1 2) (assess-call-capture-multiply 3 4)))))) (defun assess-call-adviced-p (symbol) "Return non-nil if SYMBOL has advice." ;; eeech (let ((retn nil)) (advice-mapc (lambda (&rest _) (setq retn t)) symbol) retn)) (ert-deftest assess-call-test-capture-fail () :expected-result (assess-call-no-advice) (should-not (assess-call-adviced-p 'assess-call-capture-multiply)) (should (let ((retn nil)) (assess-call-capture 'assess-call-capture-multiply (lambda () (setq retn (assess-call-adviced-p 'assess-call-capture-multiply)))) retn)) (should-not (condition-case err (assess-call-capture 'assess-call-capture-multiply (lambda () (signal 'assess-deliberate-error nil))) (assess-deliberate-error (assess-call-adviced-p 'assess-call-capture-multiply))))) (defvar assess-call-test-hook nil) (ert-deftest assess-call-test-hook-test () (should (equal '(nil) (assess-call-capture-hook 'assess-call-test-hook (lambda () (run-hooks 'assess-call-test-hook))))) (should (equal '(nil nil) (assess-call-capture-hook 'assess-call-test-hook (lambda () (run-hooks 'assess-call-test-hook) (run-hooks 'assess-call-test-hook))))) (should (equal '((bob)) (assess-call-capture-hook 'assess-call-test-hook (lambda () (run-hook-with-args 'assess-call-test-hook 'bob)))))) (ert-deftest assess-call-test-hook-fail () ;; should be nil (should (not assess-call-test-hook)) ;; and should be nil if we error (should (condition-case err (assess-call-capture-hook 'assess-call-test-hook (lambda () (signal 'assess-deliberate-error nil))) (assess-deliberate-error (not assess-call-test-hook))))) (ert-deftest assess-call-return-value () "Test that return of the instrumented form is not affected. The form that we are capturing should return the same value that it would were it not instrumented, which was not true with earlier versions of this library." :expected-result (assess-call-no-advice) (should (= 4 (let ((rtn-from-form)) (assess-call-capture #'assess-call-capture-multiply (lambda () (setq rtn-from-form (assess-call-capture-multiply 2 2)))) rtn-from-form)))) (provide 'assess-call-test) ;;; assess-call-test ends here assess-0.6/assess.el0000644000175000017500000011164013620567707014355 0ustar dogslegdogsleg;;; assess.el --- Test support functions -*- lexical-binding: t -*- ;;; Header: ;; This file is not part of Emacs ;; Author: Phillip Lord ;; Maintainer: Phillip Lord ;; Version: 0.6 ;; Package-Requires: ((emacs "24.4")(m-buffer "0.15")) ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2015, 2016, Phillip Lord ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; This file provides functions to support ert, the Emacs Regression Test ;; framework. It includes: ;; - a set of predicates for comparing strings, buffers and file contents. ;; - explainer functions for all predicates giving useful output ;; - macros for creating many temporary buffers at once, and for restoring the ;; buffer list. ;; - methods for testing indentation, by comparison or "round-tripping". ;; - methods for testing fontification. ;; Assess aims to be a stateless as possible, leaving Emacs unchanged whether ;; the tests succeed or fail, with respect to buffers, open files and so on; this ;; helps to keep tests independent from each other. Violations of this will be ;; considered a bug. ;; Assess aims also to be as noiseless as possible, reducing and suppressing ;; extraneous messages where possible, to leave a clean ert output in batch mode. ;;; Status: ;; Assess is currently a work in progress; the API is not currently stable. I ;; may also considering winding this into ert-x, because then it can be used ;; to test core. ;; Assess used to be called sisyphus which seemed like a good idea when I ;; started, but I kept spelling it wrong. ;;; Code: ;; ** Preliminaries ;; #+begin_src emacs-lisp (require 'pp) (require 'ert) (require 'm-buffer-at) (require 'm-buffer) (require 'seq) ;; #+end_src ;; ** Advice ;; Emacs-24 insists on printing out results on a single line with escaped ;; newlines. This does not work so well with the explainer functions in assess ;; and, probably, does not make sense anywhere. So, we advice here. The use of ;; nadvice.el limits this package to Emacs 24.4. Emacs 25 has this fixed. ;; #+begin_src emacs-lisp (when (fboundp 'advice-add) (defun assess--ert-pp-with-indentation-and-newline (orig object) (let ((pp-escape-newlines nil)) (funcall orig object))) (advice-add 'ert--pp-with-indentation-and-newline :around #'assess--ert-pp-with-indentation-and-newline)) ;; #+end_src ;; ** Deliberate Errors ;; Sometimes during testing, we need to throw an "error" deliberately. Assess' ;; own test cases do this to check that state is preserved with this form of ;; non-local exit. Throwing `error' itself is a bit dangerous because we might ;; get that for other reasons; so we create a new symbol here for general use. ;; #+begin_src emacs-lisp (if (fboundp 'define-error) (define-error 'assess-deliberate-error "An error deliberately caused during testing." 'error) (put 'assess-deliberate-error 'error-conditions '(error assess-deliberate-error)) (put 'assess-deliberate-error 'error-message "A error deliberately caused during testing.")) ;; #+end_src ;; ** Buffer creation ;; For tests, it is often better to use temporary buffers, as it is much less ;; affected by the existing state of Emacs, and much less likely to affect future ;; state; this is particularly the case where tests are being developed as the ;; developer may be trying to change or write test files at the same time as ;; Emacs is trying to use them for testing. ;; Emacs really only provides a single primitive `with-temp-buffer' for this ;; situation, and that only creates a single temporary buffer at a time. Nesting ;; of these forms sometimes works, but fails if we need to operate on two buffers ;; at once. ;; So, we provide an environment for restoring the buffer list. This allows any ;; creation of buffers we need for testing, followed by clean up afterwards. For ;; example, a trivial usage would be to remove buffers explicitly created. ;; #+begin_src elisp ;; (assess-with-preserved-buffer-list ;; (get-buffer-create "a") ;; (get-buffer-create "b") ;; (get-buffer-create "c")) ;; #+end_src ;; Any buffer created in this scope is removed, whether this is as a direct or ;; indirect result of the function. For example, this usage creates a ~*Help*~ ;; buffer which then gets removed again. ;; #+begin_src elisp ;; (assess-with-preserved-buffer-list ;; (describe-function 'self-insert-command)) ;; #+end_src ;; This does not prevent changes to existing buffers of course. If ~*Help*~ is ;; already open before evaluation, it will remain open afterwards but with ;; different content. ;; Sometimes, it is useful to create several temporary buffers at once. ;; `assess-with-temp-buffers' provides an easy mechanism for doing this, as ;; well as evaluating content in these buffers. For example, this returns true ;; (actually three killed buffers which were live when the `mapc' form runs). ;; #+begin_src elisp ;; (assess-with-temp-buffers ;; (a b c) ;; (mapc #'buffer-live-p (list a b c))) ;; #+end_src ;; While this creates two buffers, puts "hellogoodbye" into one and "goodbye" ;; into the other, then compares the contents of these buffers with `assess='. ;; #+begin_src elisp ;; (assess-with-temp-buffers ;; ((a (insert "hello") ;; (insert "goodbye")) ;; (b (insert "goodbye"))) ;; (assess= a b)) ;; #+end_src ;; Finally, we provide a simple mechanism for converting any assess type into a ;; buffer. The following form, for example, returns the contents of the ~.emacs~ ;; file. ;; #+begin_src elisp ;; (assess-as-temp-buffer ;; (assess-file "~/.emacs") ;; (buffer-string)) ;; #+end_src ;; *** Implementation ;; #+begin_src emacs-lisp (defmacro assess-with-preserved-buffer-list (&rest body) "Evaluate BODY, but delete any buffers that have been created." (declare (debug t)) `(let ((before-buffer-list (buffer-list))) (unwind-protect (progn ,@body) (seq-map (lambda (it) (with-current-buffer it (set-buffer-modified-p nil) (kill-buffer))) (seq-difference (buffer-list) before-buffer-list))))) (defun assess--temp-buffer-let-form (item) (if (not (listp item)) (assess--temp-buffer-let-form (list item)) `(,(car item) (with-current-buffer (generate-new-buffer " *assess-with-temp-buffers*") ,@(cdr item) (current-buffer))))) ;; #+end_src ;; The implementation of `assess-with-temp-buffers' currently uses ;; `assess-with-preserved-buffer-list' to remove buffers which means that it ;; will also delete any buffers created by the user; this may be a mistake, and ;; it might be better to delete the relevant buffers explicitly. ;; #+begin_src emacs-lisp (defmacro assess-with-temp-buffers (varlist &rest body) "Bind variables in varlist to temp buffers, then eval BODY. VARLIST is (nearly) of the same form as a `let' binding. Each element is a symbol or a list (symbol valueforms). Each symbol is bound to a buffer generated with `generate-new-buffer'. VALUEFORMS are evaluated with the buffer current. Any buffers created inside this form (and not just by this form!) are unconditionally killed at the end of the form. Unlike `let' there can be multiple valueforms which are, effectively, placed within an impicit `progn'." (declare (indent 1) (debug ((&rest (symbolp &rest form)) body))) (let ((let-form (seq-map #'assess--temp-buffer-let-form varlist))) `(assess-with-preserved-buffer-list (let* ,let-form ,@body)))) (defmacro assess-as-temp-buffer (x &rest body) "Insert X in a type-appropriate way into a temp buffer and eval BODY there. See `assess-ensure-string' for the meaning of type-appropriate." (declare (indent 1) (debug t)) `(with-temp-buffer (insert (assess-ensure-string ,x)) ,@body)) ;; #+end_src ;; ** Converters ;; The majority of test functionality compares strings. We provide ;; here some functions to convert between other Emacs types and ;; strings. ;; #+begin_src elisp ;; ;; Return a string of the contents of .emacs ;; (assess-file "~/.emacs") ;; ;; Return the contents of the buffer with name *Messages* ;; (assess-buffer "*Messages*") ;; #+end_src ;; *** Implementation ;; #+begin_src emacs-lisp (defun assess-ensure-string (x) "Turn X into a string in a type appropriate way. If X is identified as a file, returns the file contents. If X is identified as a buffer, returns the buffer contents. If X is a string, returns that. See also `assess-buffer' and `assess-file' which turn a string into something that will identified appropriately." (cond ((stringp x) x) ((bufferp x) (m-buffer-at-string x)) (t (error "Type not recognised")))) (defalias 'assess-buffer 'get-buffer-create "Create a buffer. This is now an alias for `get-buffer-create' but used to do something quite different.") (defun assess-file (f) "Convert a file to the string contents of that file." (with-temp-buffer (insert-file-contents f) (buffer-string))) ;; #+end_src ;; ** Entity Comparison ;; In this section, we provide support for comparing strings, buffer or file ;; contents. The main entry point is `assess=', which works like `string=' but ;; on any of the three data types, in any order. ;; #+begin_src elisp ;; ;; Compare Two Strings ;; (assess= "hello" "goodbye") ;; ;; Compare the contents of Two Buffers ;; (assess= ;; (assess-buffer "assess.el") ;; (assess-buffer "assess-previous.el")) ;; ;; Compare the contents of Two files ;; (assess= ;; (assess-file "~/.emacs") ;; (assess-file "~/.emacs")) ;; ;; We can use core Emacs types also ;; (assess= ;; (assess-buffer "assess.el") ;; (get-buffer "assess-previous.el")) ;; ;; And in any combination; here we compare a string and the contents of a ;; ;; file. ;; (assess= ;; ";; This is an empty .emacs file" ;; (assess-file "~/.emacs")) ;; #+end_src ;; In addition, `assess=' has an "explainer" function attached which produces a ;; richer output when `assess=' returns false, showing diffs of the string ;; comparison. Compare, for example, the results of running these two tests, one ;; using `string=' and one using `assess='. ;; #+BEGIN_EXAMPLE ;; F temp ;; (ert-test-failed ;; ((should ;; (string= "a" "b")) ;; :form ;; (string= "a" "b") ;; :value nil)) ;; F test-assess= ;; (ert-test-failed ;; ((should ;; (assess= "a" "b")) ;; :form ;; (assess= "a" "b") ;; :value nil :explanation "Strings: ;; a ;; and ;; b ;; Differ at:*** /tmp/a935uPW 2016-01-20 13:25:47.373076381 +0000 ;; --- /tmp/b9357Zc 2016-01-20 13:25:47.437076381 +0000 ;; *************** ;; *** 1 **** ;; ! a ;; \\ No newline at end of file ;; --- 1 ---- ;; ! b ;; \\ No newline at end of file ;; ")) ;; #+END_EXAMPLE ;; As `assess=' has a compatible interface with `string=' it is also possible ;; to add this explainer function to `string=' for use with tests which do not ;; otherwise use assess, like so: ;; #+begin_src elisp ;; (put 'string= 'ert-explainer 'assess-explain=) ;; #+end_src ;; Currently, `assess' uses the ~diff~ program to do the comparison if it is ;; available, or falls back to just reporting a difference -- this could do with ;; improving, but it is at least no worse than the existing behaviour for string ;; comparison. ;; *** Implementation ;; We start by writing a file silently -- this is important because the ;; ~*Messages*~ buffer should not be affected by the machinery of a failing test, ;; as it hides what is happening from the test code. ;; #+begin_src emacs-lisp (defun assess--write-file-silently (filename) "Write current buffer into FILENAME. Unlike most other ways of saving a file, this should not print any messages!" (write-region (point-min) (point-max) filename nil 'dont-display-wrote-file-message)) ;; #+end_src ;; Diff does a nicer comparison than anything in Emacs, although a lisp ;; implementation would have been more portable. Diff is used by quite a few ;; other tools in Emacs, so probably most people will have access to diff. ;; #+begin_src emacs-lisp (defun assess--explainer-diff-string= (a b) "Compare strings A and B using diff output. We assume that diff exists. Temporary files are left afterwards for cleanup by the operating system." (assess-with-preserved-buffer-list (let* ((diff (executable-find "diff")) (a-buffer (generate-new-buffer "a")) (b-buffer (generate-new-buffer "b")) (a-file (make-temp-file (buffer-name a-buffer))) (b-file (make-temp-file (buffer-name b-buffer)))) (with-current-buffer a-buffer (insert a) (assess--write-file-silently a-file)) (with-current-buffer b-buffer (insert b) (assess--write-file-silently b-file)) (progn (format "Strings:\n%s\nand\n%s\nDiffer at:%s\n" a b (with-temp-buffer (call-process diff ;; no infile nil ;; dump to current buffer t nil "-c" a-file b-file) (buffer-string))))))) (defun assess--explainer-simple-string= (a b) "Compare strings for first difference." ;; We could do a bit more here. (format "String :%s:%s: are not equal." a b)) ;; #+end_src ;; And the actual predicate function and explainer. We do a simple string ;; comparison on the contents of each entity. ;; #+begin_src emacs-lisp (defun assess= (a b) "Compare A and B to see if they are the same. Equality in this sense means compare the contents in a way which is appropriate for the type of the two arguments. So, if they are strings, the compare strings, if buffers, then compare the buffer contents and so on. Text properties in strings or buffers are ignored." (string= (assess-ensure-string a) (assess-ensure-string b))) (defun assess-explain= (a b) "Compare A and B and return an explanation. This function is called by ERT as an explainer function automatically. See `assess=' for more information." (let ((a (assess-ensure-string a)) (b (assess-ensure-string b))) (cond ((assess= a b) t) ((executable-find "diff") (assess--explainer-diff-string= a b)) (t (assess--explainer-simple-string= a b))))) (put 'assess= 'ert-explainer 'assess-explain=) ;; #+end_src ;; ** Opening files ;; Opening files presents a particular problem for testing, particularly if we ;; open a file that is already open in the same or a different Emacs. For batch ;; use of Emacs with parallelisation, the situation becomes intractable. ;; A solution is to copy files before we open them, which means that they can be ;; changed freely. Largely, the copied file will behave the same as the main file; ;; the only notable exception to this is those features which depend on the ;; current working directory (dir-local variables, for example). ;; ~assess-make-related-file~ provides a simple method for doing this. For ;; example, this form will return exactly the contents of ~my-test-file.el~, even ;; if that file is current open in the current Emacs (even if the buffer has not ;; been saved). Likewise, a test opening this file could be run in a batch Emacs ;; without interfering with an running interactive Emacs. ;; #+begin_src elisp ;; (assess-as-temp-buffer ;; (assess-make-related-file "dev-resources/my-test-file.el") ;; (buffer-substring)) ;; #+end_src ;; We also add support for opening a file, as if it where opened interactively, ;; with all the appropriate hooks being run, in the form of the ;; `assess-with-find-file' macro. Combined with `assess-make-related-file', ;; we can write the following expression without removing our ~.emacs~. ;; #+begin_src elisp ;; (assess-with-find-file ;; (assess-make-related-file "~/.emacs") ;; (erase-buffer) ;; (save-buffer)) ;; #+end_src ;; #+RESULTS: ;; *** Implementation ;; All of the functions here support the file type introduced earlier, but ;; interpret raw strings as a file also. ;; #+begin_src emacs-lisp (defun assess--make-related-file-1 (file &optional directory) (make-temp-file (concat (or directory temporary-file-directory) (file-name-nondirectory file)) nil (concat "." (file-name-extension file)))) (defun assess-make-related-file (file &optional directory) "Open a copy of FILE in DIRECTORY. FILE is copied to a temporary file in DIRECTORY or `temporary-file-directory'. The copy has a unique name but shares the same file extension. This is useful for making test changes to FILE without actually altering it." (let* ((related-file (assess--make-related-file-1 file directory))) (copy-file file related-file t) related-file)) (defmacro assess-with-find-file (file &rest body) "Open FILE and evaluate BODY in resultant buffer. FILE is opened with `find-file-noselect' so all the normal hooks for file opening should occur. The buffer is killed after the macro exits, unless it was already open. This happens unconditionally, even if the buffer has changed. See also `assess-make-related-file'." (declare (debug t) (indent 1)) (let ((temp-buffer (make-symbol "temp-buffer")) (file-has-buffer-p (make-symbol "file-has-buffer-p"))) `(let* ((,file-has-buffer-p (find-buffer-visiting ,file)) (,temp-buffer)) (unwind-protect (with-current-buffer (setq ,temp-buffer (find-file-noselect ,file)) ,@body) (when ;; kill the buffer unless it was already open. (and (not ,file-has-buffer-p) (buffer-live-p ,temp-buffer)) ;; kill unconditionally (with-current-buffer ,temp-buffer (set-buffer-modified-p nil)) (kill-buffer ,temp-buffer)))))) ;; #+end_src ;; ** Creating Files and Directories ;; I can write some documentation here if Phil wants to merge code below. ;; *** Implementation ;; #+BEGIN_SRC emacs-lisp (defun assess-with-filesystem--make-parent (spec path) "If SPEC is a file name, create its parent directory rooted at PATH." (save-match-data (when (string-match "\\(.*\\)/" spec) (make-directory (concat path "/" (match-string 1 spec)) t)))) (defun assess-with-filesystem--init (spec &optional path) "Interpret the SPEC inside PATH." (setq path (or path ".")) (cond ((listp spec) (cond ;; non-empty file ((and (stringp (car spec)) (stringp (cadr spec))) (when (string-match-p "/\\'" (car spec)) (error "Invalid syntax: `%s' - cannot create a directory with text content" (car spec))) (assess-with-filesystem--make-parent (car spec) path) (with-temp-file (concat path "/" (car spec)) (insert (cadr spec)))) ;; directory ((and (stringp (car spec)) (consp (cadr spec))) (make-directory (concat path "/" (car spec)) t) (mapc (lambda (s) (assess-with-filesystem--init s (concat path "/" (car spec)))) (cadr spec))) ;; recursive spec, this should probably never happen (t (mapc (lambda (s) (assess-with-filesystem--init s path)) spec)))) ;; directory specified using a string ((and (stringp spec) (string-match-p "/\\'" spec)) (make-directory (concat path "/" spec) t)) ;; empty file ((stringp spec) (assess-with-filesystem--make-parent spec path) (write-region "" nil (concat path "/" spec) nil 'no-message)) (t (error "Invalid syntax: `%s'" spec)))) (defmacro assess-with-filesystem (spec &rest forms) "Create temporary file hierarchy according to SPEC and run FORMS. SPEC is a list of specifications for file system entities which are to be created. File system entities are specified as follows: 1. a string FILE is the name of file to be created - if the string contains \"/\", parent directories are created automatically - if the string ends with \"/\", a directory is created 2. a list of two elements (FILE CONTENT) specifies filename and the content to put in the file - the \"/\" rules apply in the same way as in 1., except you can not create a directory this way 3. a list where car is a string and cadr is a list (DIR SPEC) is a recursive specification evaluated with DIR as current directory - the \"/\" rules apply in the same way as in 1., except you can not create a file this way, a directory is always created An example showing all the possibilities: (\"empty_file\" \"dir/empty_file\" \"dir/subdir/\" (\"non_empty_file\" \"content\") (\"dir/anotherdir/non_empty_file\" \"tralala\") (\"big_dir\" (\"empty_file\" (\"non_empty_file\" \"content\") \"subdir/empty_file\"))) If we want to run some code in a directory with an empty file \"foo.txt\" present, we call: (assess-with-filesystem '(\"foo\") (code-here) (and-some-more-forms)) You should *not* depend on where exactly the hierarchy is created. By default, a new directory in `temporary-file-directory' is created and the specification is evaluated there, but this is up for change." (declare (indent 1)) (let ((temp-root (make-symbol "temp-root")) (old-dd (make-symbol "old-dd"))) `(let ((,temp-root (make-temp-file "temp-fs-" t)) (,old-dd default-directory)) (unwind-protect (progn (setq default-directory ,temp-root) (mapc (lambda (s) (assess-with-filesystem--init s ".")) ,spec) ,@forms) (delete-directory ,temp-root t) (setq default-directory ,old-dd))))) ;; #+END_SRC ;; ** Indentation functions ;; There are two main ways to test indentation -- we can either take unindented ;; text, indent it, and then compare it to something else; or, we can roundtrip ;; -- take indented code, unindent it, re-indent it again and see whether we end ;; up with what we started. Assess supports both of these. ;; Additionally, there are two different ways to specific a mode -- we can either ;; define it explicitly or, if we are opening from a file, we can use the normal ;; `auto-mode-alist' functionality to determine the mode. Assess supports both ;; of these also. ;; The simplest function is `assess-indentation=' which we can use as follows. ;; In this case, we have mixed a multi-line string and a single line with ;; control-n characters; this is partly to show that we can, and partly to make ;; sure that the code works both in an `org-mode' buffer and an ~*Org Src*~ buffer. ;; #+begin_src elisp ;; (assess-indentation= ;; 'emacs-lisp-mode ;; "(assess-with-find-file ;; \"~/.emacs\" ;; (buffer-string))" ;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))") ;; #+end_src ;; #+RESULTS: ;; : t ;; Probably more useful is `assess-roundtrip-indentation=' which allows us to ;; just specify the indented form; in this case, the string is first unindented ;; (every line starts at the first position) and then reindented. This saves the ;; effort of keeping the text in both the indented and unindent forms in sync ;; (but without the indentation). ;; #+begin_src elisp ;; (assess-roundtrip-indentation= ;; 'emacs-lisp-mode ;; "(assess-with-find-file\n \"~/.emacs\"\n (buffer-string))") ;; #+end_src ;; #+RESULTS: ;; : t ;; While these are useful for simple forms of indentation checking, they have ;; the significant problem of writing indented code inside an Emacs string. An ;; easier solution for longer pieces of code is to use ;; `assess-file-roundtrip-indentation='. This opens a file (safely using ;; `assess-make-related-file'), unindents, and reindents. The mode must be set ;; up automatically by the file type. ;; #+begin_src elisp ;; (assess-file-roundtrip-indentation= ;; "assess.el") ;; #+end_src ;; #+RESULTS: ;; All of these methods are fully supported with ert explainer functions -- as ;; before they use diff where possible to compare the two forms. ;; *** Implementation ;; We start with some functionality for making Emacs quiet while indenting, ;; otherwise we will get a large amount of spam on the command line. Emacs needs ;; to have a better technique for shutting up `message'. ;; #+begin_src emacs-lisp (defun assess--indent-buffer (&optional column) (let ((inhibit-message t)) (cond (column (indent-region (point-min) (point-max) column)) ;; if indent-region-function is set, use it, and hope that it is not ;; noisy. (indent-region-function (funcall indent-region-function (point-min) (point-max))) (t (seq-map (lambda (m) (goto-char m) (indent-according-to-mode)) (m-buffer-match-line-start (current-buffer))))))) (defun assess--indent-in-mode (mode unindented) (with-temp-buffer (insert (assess-ensure-string unindented)) (funcall mode) (assess--indent-buffer) (buffer-string))) ;; #+end_src ;; Now for the basic indentation= comparison. ;; #+begin_src emacs-lisp (defun assess-indentation= (mode unindented indented) "Return non-nil if UNINDENTED indents in MODE to INDENTED. Both UNINDENTED and INDENTED can be any value usable by `assess-ensure-string'. Indentation is performed using `indent-region', which MODE should set up appropriately. See also `assess-file-roundtrip-indentation=' for an alternative mechanism." (assess= (assess--indent-in-mode mode unindented) indented)) (defun assess-explain-indentation= (mode unindented indented) "Explanation function for `assess-indentation='." (assess-explain= (assess--indent-in-mode mode unindented) indented)) (put 'assess-indentation= 'ert-explainer 'assess-explain-indentation=) ;; #+end_src ;; Roundtripping. ;; #+begin_src emacs-lisp (defun assess--buffer-unindent (buffer) (with-current-buffer buffer (assess--indent-buffer 0))) (defun assess--roundtrip-1 (comp mode indented) (with-temp-buffer (funcall comp mode (progn (insert (assess-ensure-string indented)) (assess--buffer-unindent (current-buffer)) (buffer-string)) indented))) (defun assess-roundtrip-indentation= (mode indented) "Return t if in MODE, text in INDENTED is corrected indented. This is checked by unindenting the text, then reindenting it according to MODE. See also `assess-indentation=' and `assess-file-roundtrip-indentation=' for alternative mechanisms of checking indentation." (assess--roundtrip-1 #'assess-indentation= mode indented)) (defun assess-explain-roundtrip-indentation= (mode indented) "Explanation function for `assess-roundtrip-indentation='." (assess--roundtrip-1 #'assess-explain-indentation= mode indented)) (put 'assess-roundtrip-indentation= 'ert-explainer 'assess-explain-roundtrip-indentation=) ;; #+end_src ;; And file based checking. ;; #+begin_src emacs-lisp (defun assess--file-roundtrip-1 (comp file) (funcall comp (assess-with-find-file (assess-make-related-file file) (assess--buffer-unindent (current-buffer)) (assess--indent-buffer) (buffer-string)) (assess-file file))) (defun assess-file-roundtrip-indentation= (file) "Return t if text in FILE is indented correctly. FILE is copied with `assess-make-related-file', so this function should be side-effect free whether or not FILE is already open. The file is opened with `find-file-noselect', so hooks associated with interactive visiting of a file should all be called, with the exception of directory local variables, as the copy of FILE will be in a different directory." (assess--file-roundtrip-1 #'assess= file)) (defun assess-explain-file-roundtrip-indentation= (file) "Explanation function for `assess-file-roundtrip-indentation=." (assess--file-roundtrip-1 #'assess-explain= file)) (put 'assess-file-roundtrip-indentation= 'ert-explainer 'assess-explain-file-roundtrip-indentation=) ;; #+end_src ;; ** Font-Lock ;; Here we define two predicates that can be used to checking ;; fontification/syntax highlighting; as with indentation, one accepts strings ;; but requires an explicit mode, while the other reads from file and depends on ;; the normal Emacs mechanisms for defining the mode. These two are ;; `assess-font-at=' and `assess-file-font-at='. Both of these have the same ;; interface and have attached explainer functions. Here, we show examples with ;; `assess-face-at='. ;; The simplest use is to specify a point location and a face. This returns true ;; if at least that face is present at the location. ;; #+begin_src elisp ;; (assess-face-at= ;; "(defun x ())" ;; 'emacs-lisp-mode ;; 2 ;; 'font-lock-keyword-face) ;; #+end_src ;; It is also possible to specify several locations in a list, with a single ;; face. This checks that the given font is present at every location. ;; #+begin_src elisp ;; (assess-face-at= ;; "(defun x ()) ;; (defun y ()) ;; (defun z ())" ;; 'emacs-lisp-mode ;; '(2 15 28) ;; 'font-lock-keyword-face) ;; #+end_src ;; Or, we can specify a list of faces in which case the locations and faces are ;; checked in a pairwise manner. ;; #+begin_src elisp ;; (assess-face-at= ;; "(defun x ())" ;; 'emacs-lisp-mode ;; '(2 8) ;; '(font-lock-keyword-face font-lock-function-name-face)) ;; #+end_src ;; It is also possible to define locations with regexps; again either one or ;; multiple regexps can be used. With a single string, all matches are checked, ;; with the first match to the first is checked, then the next match to the ;; second, incrementally. ;; #+begin_src elisp ;; (assess-face-at= ;; "(defun x ())\n(defun y ())\n(defun z ())" ;; 'emacs-lisp-mode ;; "defun" ;; 'font-lock-keyword-face) ;; (assess-face-at= ;; "(defun x ())\n(defmacro y ())\n(defun z ())" ;; 'emacs-lisp-mode ;; '("defun" "defmacro" "defun") ;; 'font-lock-keyword-face) ;; #+end_src ;; The locations can also be specified as a `lambda' which takes a single ;; argument of a buffer. The return result can be any form of location accepted ;; by `assess-face-at=', including a list of match data generated, as in this ;; case, by the `m-buffer' package. ;; #+begin_src elisp ;; (assess-face-at= ;; "(defun x ())\n(defun y ())\n(defun z ())" ;; 'emacs-lisp-mode ;; (lambda(buf) ;; (m-buffer-match buf "defun")) ;; 'font-lock-keyword-face) ;; #+end_src ;; *** Implementation ;; First, `assess-face-at='. ;; #+begin_src emacs-lisp (defun assess--face-at-location= (location face property throw-on-nil) ;; it's match data (if (listp location) ;; We need to test every point but not the last because the match is ;; passed the end. (let ((all nil)) (cl-loop for i from (marker-position (car location)) below (marker-position (cadr location)) do (setq all (cons (assess--face-at-location= i face property throw-on-nil) all))) (seq-every-p #'identity all)) (let* ((local-faces (get-text-property location property)) (rtn ;; for face this can be one of -- a face name (a symbol or string) ;; a list of faces, or a plist of face attributes (pcase local-faces ;; compare directly ((pred symbolp) (eq face local-faces)) ;; give up -- we should probably be able to compare the plists here. ((and `(,s . ,_) (guard (keywordp s))) nil) ;; compare that we have at least this. ((and `(,s . ,_) (guard (symbolp s))) (member face s))))) (if (and throw-on-nil (not rtn)) (throw 'face-non-match (format "Face does not match expected value \tExpected: %s \tActual: %s \tLocation: %s \tLine Context: %s \tbol Position: %s " face local-faces location (thing-at-point 'line) (m-buffer-at-line-beginning-position (current-buffer) location))) rtn)))) (defun assess--face-at= (buffer locations faces property throw-on-nil) (let* ( ;; default property (property (or property 'face)) ;; make sure we have a list of locations (locations (pcase locations ((pred functionp) (funcall locations buffer)) ((pred listp) locations) (_ (list locations)))) (first-location (car locations)) ;; make sure we have a list of markers (locations (cond ((integerp first-location) (m-buffer-pos-to-marker buffer locations)) ((stringp first-location) (m-buffer-match-multi locations :buffer buffer)) ;; markers ((markerp first-location) locations) ;; match data ((and (listp first-location) (markerp (car first-location))) locations))) ;; make sure we have a list of faces (faces (if (and (listp faces) ;; but not nil (not (eq nil faces))) faces (list faces))) ;; make sure faces is as long as locations (faces (progn (while (> (length locations) (length faces)) ;; cycle faces if needed (setq faces (append faces (seq-copy faces)))) faces))) (seq-every-p (lambda (it) (assess--face-at-location= (car it) (cdr it) property throw-on-nil)) (seq-mapn #'cons locations faces)))) (defun assess--face-at=-1 (x mode locations faces property throw-on-nil) (with-temp-buffer (insert (assess-ensure-string x)) (funcall mode) (font-lock-fontify-buffer) (assess--face-at= (current-buffer) locations faces property throw-on-nil))) (defun assess-face-at= (x mode locations faces &optional property) "Return non-nil if in X with MODE at MARKERS, FACES are present on PROPERTY. This function tests if one or more faces are present at specific locations in some text. It operates over single or multiple values for both locations and faces; if there are more locations than faces, then faces will be cycled over. If locations are match data, then each the beginning and end of each match are tested against each face. X can be a buffer, file name or string -- see `assess-ensure-string' for details. MODE is the major mode with which to fontify X -- actually, it will just be a function called to initialize the buffer. LOCATIONS can be either one or a list of the following things: integer positions in X; markers in X (or nil!); match data in X; or strings which match X. If this is a list, all items in list should be of the same type. FACES can be one or more faces. PROPERTY is the text property on which to check the faces. See also `assess-ensure-string' for treatment of the parameter X. See `assess-file-face-at=' for a similar function which operates over files and takes the mode from that file." (assess--face-at=-1 x mode locations faces property nil)) (defun assess-explain-face-at= (x mode locations faces &optional property) (catch 'face-non-match (assess--face-at=-1 x mode locations faces property t))) (put 'assess-face-at= 'ert-explainer 'assess-explain-face-at=) ;; #+end_src ;; Followed by `assess-file-face-at='. ;; #+begin_src emacs-lisp (defun assess--file-face-at=-1 (file locations faces property throw-on-nil) (assess-with-find-file (assess-make-related-file file) (font-lock-fontify-buffer) (assess--face-at= (current-buffer) locations faces property throw-on-nil))) (defun assess-file-face-at= (file locations faces &optional property) (assess--file-face-at=-1 file locations faces property nil)) (defun assess-explain-file-face-at= (file locations faces &optional property) (catch 'face-non-match (assess--file-face-at=-1 file locations faces property t))) (put 'assess-file-face-at= 'ert-explainer 'assess-explain-file-face-at=) ;; #+end_src ;; #+begin_src emacs-lisp (provide 'assess) ;;; assess.el ends here ;; #+end_src assess-0.6/Cask0000644000175000017500000000024013620567707013327 0ustar dogslegdogsleg(source gnu) (source melpa-stable) (package-file "assess.el") (files "assess.el" "assess-*.el" "assess-doc.org") (development (depends-on "load-relative")) assess-0.6/assess-doc.org0000644000175000017500000000017513620567707015307 0ustar dogslegdogsleg #+TITLE: Testing with Assess #+AUTHOR: Phillip Lord #+INFOJS_OPT: view:info toc:nil #+INCLUDE: "assess.org" :lines "28-" assess-0.6/.dir-locals.el0000644000175000017500000000023513620567707015160 0ustar dogslegdogsleg;;; Directory Local Variables ;;; For more information see (info "(emacs) Directory Variables") ((emacs-lisp-mode (lentic-init . lentic-orgel-org-init))) assess-0.6/Makefile0000644000175000017500000000336013620567707014171 0ustar dogslegdogslegEMACS ?= emacs CASK ?= cask -include makefile-local ifdef EMACS EMACS_ENV=EMACS=$(EMACS) endif all: install test install: $(EMACS_ENV) $(CASK) install test: install just-test package: $(EMACS_ENV) $(CASK) package just-test: $(EMACS_ENV) $(CASK) emacs --batch -q \ --directory=. \ --load assess-discover.el \ --eval '(assess-discover-run-and-exit-batch t)' .PHONY: test dist export: export multi-test: make EMACS=$(EMACSES)/master/src/emacs test make EMACS=$(EMACSES)/emacs-26.1/src/emacs test make EMACS=$(EMACSES)/emacs-25.3/src/emacs test make EMACS=$(EMACSES)/emacs-24.5/src/emacs test make EMACS=$(EMACSES)/emacs-24.4/src/emacs test elpa-sandbox: mkdir elpa-sandbox cask-free-test: elpa-sandbox emacs --batch -q \ --directory=. \ --load test/local-sandbox.el \ --eval '(assess-discover-run-and-exit-batch t)' DOCKER_TAG=26 test-cp: docker run -it --rm --name docker-cp -v $(PWD):/usr/src/app -w /usr/src/app --entrypoint=/bin/bash silex/emacs:$(DOCKER_TAG)-dev ./test-by-cp test-git: docker run -it --rm --name docker-git -v $(PWD):/usr/src/app -w /usr/src/app --entrypoint=/bin/bash silex/emacs:$(DOCKER_TAG)-dev ./test-from-git multi-test-cp: $(MAKE) test-cp DOCKER_TAG=26.2 $(MAKE) test-cp DOCKER_TAG=26.1 $(MAKE) test-cp DOCKER_TAG=25.3 $(MAKE) test-cp DOCKER_TAG=25.2 $(MAKE) test-cp DOCKER_TAG=25.1 $(MAKE) test-cp DOCKER_TAG=24.5 $(MAKE) test-cp DOCKER_TAG=24.4 $(MAKE) test-cp DOCKER_TAG=master multi-test-git: $(MAKE) test-git DOCKER_TAG=27.0 $(MAKE) test-git DOCKER_TAG=26.3 $(MAKE) test-git DOCKER_TAG=26.2 $(MAKE) test-git DOCKER_TAG=26.1 $(MAKE) test-git DOCKER_TAG=25.3 $(MAKE) test-git DOCKER_TAG=25.2 $(MAKE) test-git DOCKER_TAG=25.1 $(MAKE) test-git DOCKER_TAG=24.5 $(MAKE) test-git DOCKER_TAG=24.4 assess-0.6/README.md0000644000175000017500000000464613620567707014020 0ustar dogslegdogslegAssess ======== Assess provides additional support for testing Emacs packages. It provides: - a set of predicates for comparing strings, buffers and file contents. - explainer functions for all predicates giving useful output - macros for creating many temporary buffers at once, and for restoring the buffer list. - methods for testing indentation, by comparison or "roundtripping". - methods for testing fontification. Assess aims to be a stateless as possible, leaving Emacs unchanged whether the tests succeed or fail, with respect to buffers, open files and so on; this helps to keep tests independent from each other. Documentation ------------- Assess is fully [documented](http://homepages.cs.ncl.ac.uk/phillip.lord/lentic/assess-doc.html). Documentation is written and generating using the `lentic-doc` documentation system. It is also possible to generate the documentation locally: M-x package-install lentic-server M-x lentic-server-browse Status ------ The core of assess should now be considered stable and may be actively used. Assess supports runs all of the Emacs-24 series, Emacs-25 and Emacs-26 (to be). I will maintain support for older Emacs as far back as I am easily able to compile or run older versions; currently this is Emacs-24.1. Roadmap ------- I plan to move this to core Emacs, as ert-assess. This will happen after Emacs-25.1 release. Release ------- ## Version 0.5 This release mostly changes internal implementation details. Specifically, the original use of "types" has been removed. Functions such as `assess-file` now return strings. ## Version 0.4 This release features the first feature added by an external contributor (thanks to Matus Goljer and Damien Cassou). Assess now also supports the entire Emacs-24 series, after several requests; that this was possible was largely, if indirectly, due to Nicolas Petton's seq.el supporting all these versions ### Features - All of Emacs-24 series now supported. - `assess-with-filesystem` enables creation of a temporary file hierarchy. ### Bug Fixes - `assess-with-preserved-buffer-list` now kills even file associated buffers at the end of the form. ## Version 0.3.2 Fix Version Number ## Version 0.3.1 Add test, fix keybinding ## Version 0.3 Add assess-robot.el ## Version 0.2 Add assess-call.el ## Version 0.1 First Release [![Build Status](https://travis-ci.org/phillord/assess.svg)](https://travis-ci.org/phillord/assess) assess-0.6/todo.org0000644000175000017500000000153013620567707014204 0ustar dogslegdogsleg ** Pre/post command support functions Not sure how I can test these better -- but worth thinking about -- I guess do some set up, then and buffer-local pre or post command, run some stuff, compare. Do these get called with "call-interactively"? ** Minor mode local and global activation Tricky because global mode will affect all buffers. This is a tricky one to preserve activation status, but it can work. ** Should call functions Something to test whether a function has been called, and with what values. Easy enough to do with advice. ** Better ERT batch output ERT should output parsable error messages, with locations of files in batch. Compile mode should actually pick this up! ** Sisyphus-compile A compile mode for sisyphus which returns an internal Emacs. Should also prompt for emacs executable (with versions!), selector. assess-0.6/assess-call.el0000644000175000017500000000723513620567707015272 0ustar dogslegdogsleg;;; assess-call.el --- Call and Return -*- lexical-binding: t -*- ;;; Header: ;; This file is not part of Emacs ;; Author: Phillip Lord ;; Maintainer: Phillip Lord ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2016, Phillip Lord ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; Capture calls to functions, checking parameters and return values. ;;; Code: ;; ** Call Capture ;; Here we provide a function for tracing calls to a particular function. This ;; can be a direct or indirect call; parameters and return values are available ;; for inspection afterwards. For example: ;; #+begin_src elisp ;; (assess-call-capture ;; '+ ;; (lambda() ;; (+ 1 1))) ;; ;; => (((1 1) . 2)) ;; #+end_src ;; The return value is a list of cons cells, one for each invocation, of the ;; parameters and return values. ;; #+begin_src emacs-lisp (defun assess-call--capture-lambda () "Return function which captures args and returns of another. The returned function takes FN the function to call, and any number of ARGS to call the function with. In the special case, that FN is equal to `:return`, then all previous args and return values of FN are returned instead." (let ((capture-store nil)) (lambda (fn &rest args) (if (eq fn :return) capture-store (let ((rtn (apply fn args))) (setq capture-store (cons (cons args rtn) capture-store)) rtn))))) (defun assess-call-capture (sym-fn fn) "Trace all calls to SYM-FN when FN is called with no args. The return value is a list of cons cells, with car being the parameters of the calls, and the cdr being the return value." (let ((capture-lambda (assess-call--capture-lambda))) (unwind-protect (progn (advice-add sym-fn :around capture-lambda) (funcall fn) (funcall capture-lambda :return)) (advice-remove sym-fn capture-lambda)))) (defun assess-call--hook-capture-lambda () "Returns a function which captures all of its args. The returned function takes any number of ARGS. In the special case that the first arg is `:return` then it returns all previous args." (let ((capture-store nil)) (lambda (&rest args) (if (eq (car-safe args) :return) capture-store (setq capture-store (cons args capture-store)))))) (defun assess-call-capture-hook (hook-var fn &optional append local) "Trace all calls to HOOK-VAR when FN is called with no args. APPEND and LOCAL are passed to `add-hook` and documented there." (let ((capture-lambda (assess-call--hook-capture-lambda))) (unwind-protect (progn (add-hook hook-var capture-lambda append local) (funcall fn) (funcall capture-lambda :return)) (remove-hook hook-var capture-lambda local)))) (provide 'assess-call) ;;; assess-call.el ends here ;; #+end_src assess-0.6/assess-robot.el0000644000175000017500000000725113620567707015502 0ustar dogslegdogsleg;;; assess-robot.el --- Test support functions -*- lexical-binding: t -*- ;;; Header: ;; This file is not part of Emacs ;; Author: Phillip Lord ;; Maintainer: Phillip Lord ;; Version: 0.2 ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2016, Phillip Lord ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: (defmacro assess-robot-with-switched-buffer (buffer &rest body) "With BUFFER, evaluate BODY. This macro is rather like `with-current-buffer', except that it uses `switch-to-buffer'. This is generally a bad idea when used programmatically. But, it is necessary, for example, when using keyboard macros." (declare (indent 1) (debug t)) (let ((before-buffer (make-symbol "before-buffer"))) `(let ((,before-buffer (current-buffer))) (unwind-protect (progn (switch-to-buffer ,buffer) ,@body) (switch-to-buffer ,before-buffer))))) (defmacro assess-robot-with-temp-switched-buffer (&rest body) "Evaluate BODY in temporary buffer. As with `assess-robot-with-switched-buffer', `switch-to-buffer' is used." (declare (indent 0) (debug t)) (let ((temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-buffer (generate-new-buffer " *temp*"))) (assess-robot-with-switched-buffer ,temp-buffer (unwind-protect (progn ;; Enable the undo list because we want it for most robot ;; situations. (setq buffer-undo-list nil) ,@body) (and (buffer-name ,temp-buffer) (kill-buffer ,temp-buffer))))))) (defmacro assess-robot-with-switched-buffer-string (&rest body) "Evalate BODY in a temporary buffer and return buffer string. See also `assess-robot-with-temp-switched-buffer'." (declare (debug t)) `(assess-robot-with-temp-switched-buffer (progn ,@body (buffer-substring-no-properties (point-min) (point-max))))) (defun assess-robot-execute-kmacro (macro) "Execute the MACRO. In this case, MACRO is the \"long form\" accepted by `edit-kdb-macro'." (let ((macro (read-kbd-macro macro))) ;; I wanted to add a nice way to edit the macro, but sadly ;; edit-kdb-macro provides no nice entry point. So, we take the nasty step ;; of setting the last-kbd-macro instead. (setq last-kbd-macro macro) (execute-kbd-macro (read-kbd-macro macro)))) (defun assess-robot-copy-and-finish () "Copy the macro in edmacro to the kill-ring." (interactive) (save-excursion (goto-char (point-min)) (search-forward "Macro:") (forward-line) (let ((string (buffer-substring-no-properties (point) (point-max)))) (with-temp-buffer (insert "\"") (insert string) (insert "\"") (kill-ring-save (point-min) (point-max)))) (edmacro-finish-edit))) (eval-after-load 'edmacro '(define-key edmacro-mode-map (kbd "C-c C-k") 'assess-robot-copy-and-finish)) (provide 'assess-robot) ;;; assess-robot.el ends here assess-0.6/test-by-cp0000644000175000017500000000013513620567707014440 0ustar dogslegdogsleg#!/bin/sh cd .. mkdir copy cd copy cp -rf ../app/* . rm makefile-local make cask-free-test assess-0.6/dev-resources/0000755000175000017500000000000013620567707015315 5ustar dogslegdogslegassess-0.6/dev-resources/elisp-fontified.el0000644000175000017500000000015413620567707020720 0ustar dogslegdogsleg(defun functionname (args &optional body) (+ 1 2)) (defun functionname2 (args &optional body) (+ 1 3)) assess-0.6/dev-resources/goodbye.txt0000644000175000017500000000001013620567707017475 0ustar dogslegdogsleggoodbye assess-0.6/dev-resources/elisp-indented.el0000644000175000017500000000002713620567707020542 0ustar dogslegdogsleg( ( ( ( )))) assess-0.6/dev-resources/elisp-unindented.el0000644000175000017500000000001413620567707021101 0ustar dogslegdogsleg( ( ( ( ))))assess-0.6/dev-resources/hello.txt0000644000175000017500000000000613620567707017155 0ustar dogslegdogsleghello assess-0.6/assess-discover.el0000644000175000017500000000522413620567707016171 0ustar dogslegdogsleg;;; assess-discover.el --- Test support functions -*- lexical-binding: t -*- ;;; Header: ;; This file is not part of Emacs ;; Author: Phillip Lord ;; Maintainer: Phillip Lord ;; The contents of this file are subject to the GPL License, Version 3.0. ;; Copyright (C) 2015, 2016, Phillip Lord ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Code: ;; #+begin_src emacs-lisp (defun assess-discover-tests (directory) "Discover tests in directory. Tests must conform to one (and only one!) of several naming schemes. - End with -test.el - End with -tests.el - Start with test- - Any .el file in a directory called test - Any .el file in a directory called tests Each of these is tried until one matches. So, a top-level file called \"blah-test.el\" will prevent discovery of files in a tests directory." (or ;; files with (directory-files directory nil ".*-test.el$") (directory-files directory nil ".*-tests.el$") (directory-files directory nil "test-.*.el$") (let ((dir-test (concat directory "test/"))) (when (file-exists-p dir-test) (mapcar (lambda (file) (concat dir-test file)) (directory-files dir-test nil ".*.el")))) (let ((dir-tests (concat directory "tests/"))) (when (file-exists-p dir-tests) (mapcar (lambda (file) (concat dir-tests file)) (directory-files dir-tests nil ".*.el")))))) (defun assess-discover--load-all-tests (directory) (mapc 'load (assess-discover-tests directory))) (defun assess-discover-load-tests () (interactive) (assess-discover--load-all-tests default-directory)) ;;;###autoload (defun assess-discover-run-batch (&optional selector) (assess-discover--load-all-tests default-directory) (ert-run-tests-batch selector)) ;;;###autoload (defun assess-discover-run-and-exit-batch (&optional selector) (assess-discover--load-all-tests default-directory) (ert-run-tests-batch-and-exit selector)) (provide 'assess-discover) ;;; assess-discover.el ends here ;; #+end_src assess-0.6/.travis.yml0000644000175000017500000000110213620567707014632 0ustar dogslegdogsleglanguage: generic sudo: no env: - EVM_EMACS=emacs-git-snapshot-travis-linux-xenial - EVM_EMACS=emacs-26.3-travis-linux-xenial - EVM_EMACS=emacs-26.2-travis-linux-xenial - EVM_EMACS=emacs-26.1-travis-linux-xenial - EVM_EMACS=emacs-25.3-travis - EVM_EMACS=emacs-25.2-travis - EVM_EMACS=emacs-25.1-travis - EVM_EMACS=emacs-24.5-travis - EVM_EMACS=emacs-24.4-travis install: - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh - evm install $EVM_EMACS --use --skip script: - emacs --version - make cask-free-test assess-0.6/test-from-git0000644000175000017500000000007713620567707015157 0ustar dogslegdogsleg#!/bin/sh cd .. mkdir git cd git git clone ../app . make test