[nongnu] elpa/buttercup b75b3e9 036/340: Add a discovery test runner.

[ELPA Syncer]

branch: elpa/buttercup
commit b75b3e98b8d65096b614e77a96e503a5f7b11d8c
Author: Jorgen Schaefer <contact@jorgenschaefer.de>
Commit: Jorgen Schaefer <contact@jorgenschaefer.de>

    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 <contact@jorgenschaefer.de>
+
+;; Author: Jorgen Schaefer <contact@jorgenschaefer.de>
+
+;; 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