[nongnu] elpa/buttercup acccc0f 179/340: Modify xdescribe to keep all contained specs as pending

[ELPA Syncer]

branch: elpa/buttercup
commit acccc0f043375f3840e7f108a85a5d9432e8f1f7
Author: Ola Nilsson <ola.nilsson@gmail.com>
Commit: Ola Nilsson <ola.nilsson@gmail.com>

    Modify xdescribe to keep all contained specs as pending
    
    Fixes #116
---
 buttercup.el            | 48 ++++++++++++++++++++++++++++++++++++++++++++----
 tests/test-buttercup.el | 39 +++++++++++++++++++++++++++++++++++++--
 2 files changed, 81 insertions(+), 6 deletions(-)

diff --git a/buttercup.el b/buttercup.el
index c199f16..80380fc 100644
--- a/buttercup.el
+++ b/buttercup.el
@@ -915,15 +915,55 @@ FUNCTION is a function containing the body instructions 
passed to
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Disabled Suites: xdescribe
 
-(defmacro xdescribe (description &rest body)
-  "Like `describe', but mark the suite as disabled.
+(defun buttercup--disable-specs (forms)
+  "Process FORMS to make any suites or specs pending."
+  (when (eq (car forms) :var)
+    (setq forms (cddr forms)))
+  (let (retained inner)
+    (dolist (form forms (nreverse retained))
+      (pcase form
+        ;; Make it pending by just keeping the description
+        (`(it ,description . ,_)
+         (push (list 'it description) retained))
+        (`(xit ,description . ,_)
+         (push (list 'it description) retained))
+        ;; Just make nested describes into xdescribes and handle them
+        ;; in another macro invocation
+        (`(describe . ,tail)
+         (push (cons 'xdescribe tail) retained))
+        (`(xdescribe . ,tail)
+         (push (cons 'xdescribe tail) retained))
+        ;; Special case to ignore before-* and after-* forms
+        (`(before-each . ,_)) ; nop
+        (`(after-each . ,_)) ; nop
+        (`(before-all . ,_)) ; nop
+        (`(after-all . ,_)) ; nop
+        ;; Any list starting with a list, like a let varlist.
+        ((and (pred consp)
+              ls
+              (guard (consp (car ls))))
+         (dolist (elt (buttercup--disable-specs ls))
+           (push elt retained)))
+        ;; Any function call list
+        (`(,_ . ,tail)
+         (dolist (elt (buttercup--disable-specs tail))
+           (push elt retained)))
+        ;; non-cons items
+        ((and elt (guard (not (consp elt))))) ; nop
+        (_
+         (error "Unrecognized form in `xdescribe': `%s'" (pp-to-string form)))
+        ))))
 
-A disabled suite is not run.
+(defmacro xdescribe (description &rest body)
+  "Like `describe', but mark any specs as disabled.
 
 DESCRIPTION is a string. BODY is a sequence of instructions,
 mainly calls to `describe', `it' and `before-each'."
   (declare (indent 1))
-  `(buttercup-xdescribe ,description (lambda () ,@body)))
+  `(describe ,description
+     ,@(buttercup--disable-specs body)
+     ;; make sure the suite is marked as pending
+     (signal 'buttercup-pending "PENDING")))
 
 (defun buttercup-xdescribe (description function)
   "Like `buttercup-describe', but mark the suite as disabled.
diff --git a/tests/test-buttercup.el b/tests/test-buttercup.el
index 81b72e1..94f3ad3 100644
--- a/tests/test-buttercup.el
+++ b/tests/test-buttercup.el
@@ -306,7 +306,7 @@
 ;;; Suites: describe
 
 (describe "The `describe' macro"
-  (it "should expand to a simple call to the describe function"
+  (it "should expand to a simple call to the buttercup-describe function"
     (expect (macroexpand '(describe "description" (+ 1 1)))
             :to-equal
             '(buttercup-describe "description" (lambda () (+ 1 1)))))
@@ -461,7 +461,42 @@
   (it "expands directly to a function call"
     (expect (macroexpand '(xdescribe "bla bla" (+ 1 1)))
             :to-equal
-            '(buttercup-xdescribe "bla bla" (lambda () (+ 1 1))))))
+            '(buttercup-describe "bla bla"
+                                 (lambda ()
+                                   (signal 'buttercup-pending "PENDING")))))
+
+  (it "changes contained it-specs to pending specs"
+    (expect (macroexpand-all
+             '(xdescribe "bla bla"
+                (let ((a 1) b (c 2) (d (it "nested" (+ 1 1))))
+                  (it "spec1" (+ 1 1))
+                  (describe "inner suite"
+                    (it "inner spec"))
+                  (xit "spec2" (+ 1 1)))))
+            :to-equal
+            '(buttercup-describe
+              "bla bla"
+              #'(lambda ()
+                  (buttercup-xit "nested")
+                  (buttercup-xit "spec1")
+                  (buttercup-describe
+                   "inner suite"
+                   #'(lambda ()
+                       (buttercup-xit "inner spec")
+                       (signal 'buttercup-pending "PENDING")))
+                  (buttercup-xit "spec2")
+                  (signal 'buttercup-pending "PENDING")))))
+
+  (it "should add a pending suite"
+    (let ((buttercup--current-suite nil)
+          (buttercup-suites nil))
+      (xdescribe
+       "bla bla"
+       (lambda () nil))
+      (expect (buttercup-suite-status (car buttercup-suites))
+              :to-be
+              'pending))))
+
 
 (describe "The `buttercup-xdescribe' function"
   (it "should be a no-op"