branch: elpa/buttercup
commit b75b3e98b8d65096b614e77a96e503a5f7b11d8c
Author: Jorgen Schaefer <[email protected]>
Commit: Jorgen Schaefer <[email protected]>
Add a discovery test runner.
---
Makefile | 4 +--
ROADMAP.md | 20 -----------
buttercup-compat.el | 97 ++++++++++++++++++++++++++++++++++++++++++++++++++++
buttercup.el | 98 +++++++++++++++++++++++------------------------------
4 files changed, 141 insertions(+), 78 deletions(-)
diff --git a/Makefile b/Makefile
index 7d2d6ab..ffea9bb 100644
--- a/Makefile
+++ b/Makefile
@@ -5,5 +5,5 @@ EMACS := emacs
all: test
test:
- $(EMACS) -batch -L . -l buttercup.el -f buttercup-markdown-runner
README.md
- $(EMACS) -batch -L . -l buttercup-test.el -f buttercup-run
+ $(EMACS) -batch -L . -l buttercup.el -f buttercup-run-markdown README.md
+ $(EMACS) -batch -L . -l buttercup.el -f buttercup-run-discover
diff --git a/ROADMAP.md b/ROADMAP.md
index 524a1de..cf48d28 100644
--- a/ROADMAP.md
+++ b/ROADMAP.md
@@ -1,23 +1,3 @@
-# Version 1.0: Jasmine’s introduction.html
-
-I will declare buttercup ready to be used once it implements most of
-the stuff in
-[Jasmine’s introduction](https://jasmine.github.io/edge/introduction.html).
-At this time, this is missing:
-
-## Test Runners
-
-This would also be a great time to write useful test runners. For the
-first release, there should be `buttercup-run-discover`,
-`buttercup-run-markdown`, and `buttercup-run-at-point`.
-
-## Suite Execution
-
-All of those can use the same `buttercup-run` function, which should
-run a list of suites and call a reporter with results. All execution
-should happen with `debug-on-error` set. We’ll deal with backtraces
-later.
-
# Version 1.1: The Missing Features
## Pending Specs
diff --git a/buttercup-compat.el b/buttercup-compat.el
new file mode 100644
index 0000000..4a0a682
--- /dev/null
+++ b/buttercup-compat.el
@@ -0,0 +1,97 @@
+;;; buttercup-compat.el --- Compatibility definitions for buttercup
+
+;; Copyright (C) 2015 Jorgen Schaefer <[email protected]>
+
+;; Author: Jorgen Schaefer <[email protected]>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides compatibility definitions for buttercup. These
+;; are primarily backported features of later versions of Emacs that
+;; are not available in earlier ones.
+
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Introduced in 24.3
+
+(when (not (fboundp 'cl-defstruct))
+ (defalias 'cl-defstruct 'defstruct))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Introduced in 24.4
+
+(when (not (fboundp 'define-error))
+ (defun define-error (name message &optional parent)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such an error
+is signaled without being caught by a `condition-case'.
+PARENT is either a signal or a list of signals from which it inherits.
+Defaults to `error'."
+ (unless parent (setq parent 'error))
+ (let ((conditions
+ (if (consp parent)
+ (apply #'append
+ (mapcar (lambda (parent)
+ (cons parent
+ (or (get parent 'error-conditions)
+ (error "Unknown signal `%s'"
parent))))
+ parent))
+ (cons parent (get parent 'error-conditions)))))
+ (put name 'error-conditions
+ (delete-dups (copy-sequence (cons name conditions))))
+ (when message (put name 'error-message message)))))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; Introduced in 25.1
+
+(when (not (fboundp 'directory-files-recursively))
+ (defun directory-files-recursively (dir match &optional include-directories)
+ "Return all files under DIR that have file names matching MATCH (a regexp).
+This function works recursively. Files are returned in \"depth first\"
+and alphabetical order.
+If INCLUDE-DIRECTORIES, also include directories that have matching names."
+ (let ((result nil)
+ (files nil)
+ ;; When DIR is "/", remote file names like "/method:" could
+ ;; also be offered. We shall suppress them.
+ (tramp-mode (and tramp-mode (file-remote-p dir))))
+ (dolist (file (sort (file-name-all-completions "" dir)
+ 'string<))
+ (unless (member file '("./" "../"))
+ (if (directory-name-p file)
+ (let* ((leaf (substring file 0 (1- (length file))))
+ (full-file (expand-file-name leaf dir)))
+ ;; Don't follow symlinks to other directories.
+ (unless (file-symlink-p full-file)
+ (setq result
+ (nconc result (directory-files-recursively
+ full-file match include-directories))))
+ (when (and include-directories
+ (string-match match leaf))
+ (setq result (nconc result (list full-file)))))
+ (when (string-match match file)
+ (push (expand-file-name file dir) files)))))
+ (nconc result (nreverse files)))))
+
+(when (not (fboundp 'directory-name-p))
+ (defsubst directory-name-p (name)
+ "Return non-nil if NAME ends with a slash character."
+ (and (> (length name) 0)
+ (char-equal (aref name (1- (length name))) ?/))))
+
+(provide 'buttercup-compat)
+;;; buttercup-compat.el ends here
diff --git a/buttercup.el b/buttercup.el
index 3679ccd..891026e 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -28,35 +28,7 @@
;;; Code:
(require 'cl)
-
-;;;;;;;;;;;;;;;;;
-;;; Compatibility
-
-;; Introduced in 24.3
-(when (not (fboundp 'cl-defstruct))
- (defalias 'cl-defstruct 'defstruct))
-
-;; Introduced in 24.4
-(when (not (fboundp 'define-error))
- (defun define-error (name message &optional parent)
- "Define NAME as a new error signal.
-MESSAGE is a string that will be output to the echo area if such an error
-is signaled without being caught by a `condition-case'.
-PARENT is either a signal or a list of signals from which it inherits.
-Defaults to `error'."
- (unless parent (setq parent 'error))
- (let ((conditions
- (if (consp parent)
- (apply #'append
- (mapcar (lambda (parent)
- (cons parent
- (or (get parent 'error-conditions)
- (error "Unknown signal `%s'"
parent))))
- parent))
- (cons parent (get parent 'error-conditions)))))
- (put name 'error-conditions
- (delete-dups (copy-sequence (cons name conditions))))
- (when message (put name 'error-message message)))))
+(require 'buttercup-compat)
;;;;;;;;;;
;;; expect
@@ -551,9 +523,45 @@ KEYWORD can have one of the following values:
;;;;;;;;;;;;;;;;
;;; Test Runners
+(defun buttercup-run-at-point ()
+ "Run the buttercup suite at point."
+ (interactive)
+ (let ((buttercup-suites nil)
+ (lexical-binding t))
+ (eval-defun nil)
+ (buttercup-run)
+ (message "Suite executed successfully")))
+
+(defun buttercup-run-discover ()
+ "Discover and load test files, then run all defined suites.
+
+Takes directories as command line arguments, defaulting to the
+current directory."
+ (dolist (dir (or command-line-args-left '(".")))
+ (dolist (file (directory-files-recursively dir
+ "\\'test-\\|-test.el\\'"))
+ (load file nil t)))
+ (buttercup-run))
+
+(defun buttercup-run-markdown ()
+ (let ((lisp-buffer (generate-new-buffer "elisp")))
+ (dolist (file command-line-args-left)
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (while (re-search-forward "```lisp\n\\(\\(?:.\\|\n\\)*?\\)```"
+ nil t)
+ (let ((code (match-string 1)))
+ (with-current-buffer lisp-buffer
+ (insert code))))))
+ (with-current-buffer lisp-buffer
+ (setq lexical-binding t)
+ (eval-region (point-min)
+ (point-max)))
+ (buttercup-run)))
+
(defun buttercup-run ()
(if buttercup-suites
- (mapc #'buttercup-run-suite buttercup-suites)
+ (mapc #'buttercup--run-suite buttercup-suites)
(error "No suites defined")))
(defvar buttercup--before-each nil
@@ -566,7 +574,7 @@ Do not change the global value.")
Do not change the global value.")
-(defun buttercup-run-suite (suite &optional level)
+(defun buttercup--run-suite (suite &optional level)
(let* ((level (or level 0))
(indent (make-string (* 2 level) ?\s))
(buttercup--before-each (append buttercup--before-each
@@ -580,14 +588,14 @@ Do not change the global value.")
(dolist (sub (buttercup-suite-children suite))
(cond
((buttercup-suite-p sub)
- (buttercup-run-suite sub (1+ level)))
+ (buttercup--run-suite sub (1+ level)))
((buttercup-spec-p sub)
- (buttercup-run-spec sub (1+ level)))))
+ (buttercup--run-spec sub (1+ level)))))
(dolist (f (buttercup-suite-after-all suite))
(funcall f))
(message "")))
-(defun buttercup-run-spec (spec level)
+(defun buttercup--run-spec (spec level)
(message "%s%s"
(make-string (* 2 level) ?\s)
(buttercup-spec-description spec))
@@ -598,27 +606,5 @@ Do not change the global value.")
(dolist (f buttercup--after-each)
(funcall f))))
-(defun buttercup-run-at-point ()
- (let ((buttercup-suites nil)
- (lexical-binding t))
- (eval-defun nil)
- (buttercup-run)))
-
-(defun buttercup-markdown-runner ()
- (let ((lisp-buffer (generate-new-buffer "elisp")))
- (dolist (file command-line-args-left)
- (with-current-buffer (find-file-noselect file)
- (goto-char (point-min))
- (while (re-search-forward "```lisp\n\\(\\(?:.\\|\n\\)*?\\)```"
- nil t)
- (let ((code (match-string 1)))
- (with-current-buffer lisp-buffer
- (insert code))))))
- (with-current-buffer lisp-buffer
- (setq lexical-binding t)
- (eval-region (point-min)
- (point-max)))
- (buttercup-run)))
-
(provide 'buttercup)
;;; buttercup.el ends here
