Browse Source

Major fixes to custom testing macros

"should-with-tag", "should-error-with-tag", and "collection-as-function"
are now implemented in a way that won't break with lexical binding
enabled. This commit also turns lexical binding back on in the test
file.
Ryan C. Thompson 9 years ago
parent
commit
e73b397010
1 changed files with 40 additions and 29 deletions
  1. 40 29
      test/ido-ubiquitous-test.el

+ 40 - 29
test/ido-ubiquitous-test.el

@@ -1,4 +1,4 @@
-;;; ido-ubiquitous-test.el ---  -*- lexical-binding: nil -*-
+;;; ido-ubiquitous-test.el ---  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2015 Ryan C. Thompson
 
@@ -112,27 +112,32 @@ for activation and deactivation."
     `(with-mode ido-ubiquitous-mode 1
        (let ,idu-bindings ,@body))))
 
-(defun collection-as-function (collection)
+(defmacro collection-as-function (collection)
   "Return a function equivalent to COLLECTION.
 
 The returned function will work equivalently to COLLECTION when
 passed to `all-completions' and `try-completion'."
-  (completion-table-dynamic (lambda (string) (all-completions string collection))))
-
-(defun should-with-tag-internal (form tag)
-  (let ((complete-form (list 'and tag form)))
-    (eval (list 'should complete-form))))
+  `(completion-table-dynamic (lambda (string) (all-completions string ,collection))))
 
 (cl-defmacro should-with-tag (form &key tag)
-  "Equivalent to `(should FORM)' but with a tag on the output.
+  "Equivalent to `(should FORM)' but with a TAG on the output.
 
 This is useful if the same `should' form will be called multiple
 times in different contexts. Each test can pass a different tag
 so it's clear in the ERT output which context is causing the
-failure."
-  `(if ,tag
-       (should-with-tag-internal ',form ,tag)
-     (should ,form)))
+failure.
+
+Note that although this is a macro, the TAG argument is evaluated normally."
+  `(let ((tagvalue ,tag))
+     (condition-case err
+         (should ,form)
+       (ert-test-failed
+        (message "Error symbol: %S" (car err))
+        (message "Error data: %S" (cdr err))
+        (when tagvalue
+          (setf (cadr err) (append (cadr err) (list :tag tagvalue))))
+        (message "New error data: %S" (cdr err))
+        (signal (car err) (cdr err))))))
 
 (defun plist-delete (plist property)
   "Delete PROPERTY from PLIST.
@@ -144,18 +149,22 @@ This is in contrast to merely setting it to 0."
       (setq plist (cddr plist)))
     p))
 
-(defun should-error-with-tag-internal (form other-args tag)
-  (let ((complete-form (list 'and tag form)))
-    (eval (nconc (list 'should-error complete-form)
-                 other-args))))
-
 (cl-defmacro should-error-with-tag (form &rest other-keys &key tag &allow-other-keys)
-  "Equivalent to `(should FORM)' but with a tag on the output.
-See `should-with-tag'."
+  "Equivalent to `(should FORM)' but with a TAG on the output.
+See `should-with-tag'.
+
+Note that although this is a macro, the TAG argument is evaluated normally."
   (setq other-keys (plist-delete other-keys :tag))
-  `(if ,tag
-       (should-error-with-tag-internal ',form ',other-keys ,tag)
-     (should-error ,form ,@other-keys)))
+  `(let ((tagvalue ,tag))
+     (condition-case err
+         (should-error ,form ,@other-keys)
+       (ert-test-failed
+        (message "Error symbol: %S" (car err))
+        (message "Error data: %S" (cdr err))
+        (when tagvalue
+          (setf (cadr err) (append (cadr err) (list :tag tagvalue))))
+        (message "New error data: %S" (cdr err))
+        (signal (car err) (cdr err))))))
 
 (defun test-ido-ubiquitous-expected-mode (override &optional tag)
   "Test whether observed ido-ubiquitous behavior matches OVERRIDE."
@@ -260,18 +269,20 @@ See `should-with-tag'."
         :tag tag))
       (otherwise (error "Unknown override %S" override)))))
 
+(defvar original-completing-read (symbol-function #'completing-read))
+
 (defun test-ido-ubiquitous-expected-mode-on-functional-collection (override &optional tag)
   "Test whether observed ido-ubiquitous behavior on functional collection matches OVERRIDE."
   (declare (indent 1))
   ;; This just temporarily replaces `completing-read' with a wrapper
   ;; that always converts the collection argument to an equivalent
-  ;; function.
-  (cl-letf* ((original-completing-read (symbol-function #'completing-read))
-             ((symbol-function #'completing-read)
-              (lambda (prompt collection &rest args)
-                (apply original-completing-read prompt
-                       (collection-as-function collection)
-                       args))))
+  ;; function. That way, any use of `completing-read' will always see
+  ;; a functional collection.
+  (cl-letf (((symbol-function 'completing-read)
+             (lambda (prompt collection &rest args)
+               (apply original-completing-read prompt
+                      (collection-as-function collection)
+                      args))))
     (test-ido-ubiquitous-expected-mode override tag)))
 
 (ert-deftest ido-ubiquitous-test-simple ()