[nongnu] elpa/buttercup 238bfa8 082/340: Support --pattern command line argument

[ELPA Syncer]

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

    Support --pattern command line argument
    
    With this argument, buttercup can now restrict the tests to be run to
    a subset matching a given regular expression.
    
    Fixes #21
---
 bin/buttercup | 29 +++++++++++++++++++++++++++--
 buttercup.el  | 43 +++++++++++++++++++++++++++++++++++++------
 2 files changed, 64 insertions(+), 8 deletions(-)

diff --git a/bin/buttercup b/bin/buttercup
index 62a9ba7..71f6740 100755
--- a/bin/buttercup
+++ b/bin/buttercup
@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/bin/bash
 
 if [ -n "$INSIDE_EMACS" ]
 then
@@ -7,4 +7,29 @@ else
     EMACS_BIN="${EMACS:-emacs}"
 fi
 
-exec "$EMACS_BIN" -batch "$@" -l buttercup -f buttercup-run-discover
+EMACS_ARGS=()
+BUTTERCUP_ARGS=()
+
+while [[ "$#" -gt 0 ]]
+do
+    case "$1" in
+        "-L")
+            EMACS_ARGS+=("$1")
+            EMACS_ARGS+=("$2")
+            shift
+            shift
+            ;;
+        "-p"|"--pattern")
+            BUTTERCUP_ARGS+=("$1")
+            BUTTERCUP_ARGS+=("$2")
+            shift
+            shift
+            ;;
+        *)
+            BUTTERCUP_ARGS+=("$1")
+            shift
+            ;;
+    esac
+done
+
+exec "$EMACS_BIN" -batch "${EMACS_ARGS[@]}" -l buttercup -f 
buttercup-run-discover "${BUTTERCUP_ARGS[@]}"
diff --git a/buttercup.el b/buttercup.el
index af38153..6e23e4f 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -631,12 +631,43 @@ KEYWORD can have one of the following values:
 
 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-.*\\.el\\'\\|-test\\.el\\'"))
-      (when (not (string-match "/\\." (file-relative-name file)))
-        (load file nil t))))
-  (buttercup-run))
+  (let ((dirs nil)
+        (patterns nil)
+        (args command-line-args-left))
+    (message "c-l-a-l: %S" args)
+    (while args
+      (cond
+       ((member (car args) '("-p" "--pattern"))
+        (when (not (cdr args))
+          (error "Option requires argument" (car args)))
+        (push (cadr args) patterns)
+        (setq args (cddr args)))
+       (t
+        (push (car args) dirs)
+        (setq args (cdr args)))))
+    (setq command-line-args-left nil)
+    (dolist (dir (or dirs '(".")))
+      (dolist (file (directory-files-recursively
+                     dir "\\`test-.*\\.el\\'\\|-test\\.el\\'"))
+        (when (not (string-match "/\\." (file-relative-name file)))
+          (load file nil t))))
+    (when patterns
+      (let ((suites-or-specs buttercup-suites))
+        (while suites-or-specs
+          (cond
+           ((buttercup-suite-p (car suites-or-specs))
+            (setq suites-or-specs (append suites-or-specs
+                                          (buttercup-suite-children
+                                           (car suites-or-specs)))))
+           ((buttercup-spec-p (car suites-or-specs))
+            (catch 'return
+              (dolist (p patterns)
+                (when (string-match p (buttercup-spec-full-name (car 
suites-or-specs)))
+                  (throw 'return t)))
+              (setf (buttercup-spec-function (car suites-or-specs))
+                    (lambda () (signal 'buttercup-pending t))))))
+          (setq suites-or-specs (cdr suites-or-specs)))))
+    (buttercup-run)))
 
 ;;;###autoload
 (defun buttercup-run-markdown ()