Explorar el Código

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 hace 10 años
padre
commit
e73b397010
Se han modificado 1 ficheros con 40 adiciones y 29 borrados
  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 ()