Merge pull request #185 from vermiculus/ert-refactor

Refactor tests

6 files changed, 170 insertions, 194 deletions

diff --git a/sx.el b/sx.el
index 8fe31ac..73d1a40 100644
--- a/sx.el
+++ b/sx.el
@@ -239,50 +239,6 @@ and sequences of strings."
                            (funcall first-f sequence-sep)
                          ";"))))))
 
-(defun sx--filter-data (data desired-tree)
-  "Filter DATA and return the DESIRED-TREE.
-
-For example:
-
-  (sx--filter-data
-    '((prop1 . value1)
-      (prop2 . value2)
-      (prop3
-       (test1 . 1)
-       (test2 . 2))
-      (prop4 . t))
-    '(prop1 (prop3 test2)))
-
-would yield
-
-  ((prop1 . value1)
-   (prop3
-    (test2 . 2)))"
-  (if (vectorp data)
-      (apply #'vector
-             (mapcar (lambda (entry)
-                       (sx--filter-data
-                        entry desired-tree))
-                     data))
-    (delq
-     nil
-     (mapcar (lambda (cons-cell)
-               ;; @TODO the resolution of `f' is O(2n) in the worst
-               ;; case.  It may be faster to implement the same
-               ;; functionality as a `while' loop to stop looking the
-               ;; list once it has found a match.  Do speed tests.
-               ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e.
-               (let ((f (or (memq (car cons-cell) desired-tree)
-                            (assoc (car cons-cell) desired-tree))))
-                 (when f
-                   (if (and (sequencep (cdr cons-cell))
-                            (sequencep (elt (cdr cons-cell) 0)))
-                       (cons (car cons-cell)
-                             (sx--filter-data
-                              (cdr cons-cell) (cdr f)))
-                     cons-cell))))
-             data))))
-
 (defun sx--shorten-url (url)
   "Shorten URL hiding anything other than the domain.
 Paths after the domain are replaced with \"...\".
diff --git a/test/test-api.el b/test/test-api.el
new file mode 100644
index 0000000..ca775ff
--- /dev/null
+++ b/test/test-api.el
@@ -0,0 +1,13 @@
+(ert-deftest test-basic-request ()
+  "Test basic request functionality"
+  (should (sx-request-make "sites")))
+
+(ert-deftest test-question-retrieve ()
+  "Test the ability to receive a list of questions."
+  (should (sx-question-get-questions 'emacs)))
+
+(ert-deftest test-bad-request ()
+  "Test a method given a bad set of keywords"
+  (should-error
+   (sx-request-make "questions" '(()))))
+
diff --git a/test/test-macros.el b/test/test-macros.el
new file mode 100644
index 0000000..2169088
--- /dev/null
+++ b/test/test-macros.el
@@ -0,0 +1,22 @@
+(defmacro sx-test-with-json-data (cell &rest body)
+  "Run BODY with sample data let-bound to CELL"
+  (declare (indent 1))
+  `(let ((,cell '((test . nil) (test-one . 1) (test-two . 2)
+                  (link . "http://meta.emacs.stackexchange.com/"))))
+     ,@body))
+
+(ert-deftest macro-test--sx-assoc-let ()
+  "Test `sx-assoc-let'"
+  (sx-test-with-json-data data
+    (should
+     (null (let-alist data .site))))
+
+  (sx-test-with-json-data data
+    (should
+     (equal (sx-assoc-let data .site)
+            "meta.emacs")))
+
+  (sx-test-with-json-data data
+    (should
+     (equal (sx-assoc-let data (cons .test-one .test-two))
+            '(1 . 2)))))
diff --git a/test/test-printing.el b/test/test-printing.el
new file mode 100644
index 0000000..2857cb7
--- /dev/null
+++ b/test/test-printing.el
@@ -0,0 +1,73 @@
+
+;;; Setup
+(require 'cl-lib)
+
+(defmacro line-should-match (regexp)
+  "Test if the line at point matches REGEXP"
+  `(let ((line (buffer-substring-no-properties
+                (line-beginning-position)
+                (line-end-position))))
+     (sx-test-message "Line here is: %S" line)
+     (should (string-match ,regexp line))))
+
+(defmacro question-list-regex (title votes answers &rest tags)
+  "Construct a matching regexp for TITLE, VOTES, and ANSWERS.
+Each element of TAGS is appended at the end of the expression
+after being run through `sx-question--tag-format'."
+  `(rx line-start
+       (+ whitespace) ,(number-to-string votes)
+       (+ whitespace) ,(number-to-string answers)
+       (+ whitespace)
+       ,title
+       (+ (any whitespace digit))
+       (or "y" "d" "h" "m" "mo" "s") " ago"
+       (+ whitespace)
+       (eval (mapconcat #'sx-question--tag-format
+                        (list ,@tags) " "))))
+
+
+;;; Tests
+(ert-deftest question-list-tag ()
+  "Test `sx-question--tag-format'."
+  (should
+   (string=
+    (sx-question--tag-format "tag")
+    "[tag]")))
+
+(ert-deftest question-list-display ()
+  (cl-letf (((symbol-function #'sx-request-make)
+             (lambda (&rest _) sx-test-data-questions)))
+    (sx-tab-frontpage nil "emacs")
+    (switch-to-buffer "*question-list*")
+    (goto-char (point-min))
+    (should (equal (buffer-name) "*question-list*"))
+    (line-should-match
+     (question-list-regex
+      "Focus-hook: attenuate colours when losing focus"
+      1 0 "frames" "hooks" "focus"))
+    (sx-question-list-next 5)
+    (line-should-match
+     (question-list-regex
+      "Babel doesn't wrap results in verbatim"
+      0 1 "org-mode" "org-export" "org-babel"))
+    ;; ;; Use this when we have a real sx-question buffer.
+    ;; (call-interactively 'sx-question-list-display-question)
+    ;; (should (equal (buffer-name) "*sx-question*"))
+    (switch-to-buffer "*question-list*")
+    (sx-question-list-previous 4)
+    (line-should-match
+     (question-list-regex
+      ""Making tag completion table" Freezes/Blocks -- how to disable"
+      2 1 "autocomplete" "performance" "ctags"))))
+
+(ert-deftest sx--user-@name ()
+  "Test `sx--user-@name' character substitution"
+  (should
+   (string=
+    (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★")))
+    "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj"))
+  (should
+   (string=
+    (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ")))
+    "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ")))
+
diff --git a/test/test-util.el b/test/test-util.el
new file mode 100644
index 0000000..5db1691
--- /dev/null
+++ b/test/test-util.el
@@ -0,0 +1,31 @@
+(ert-deftest thing-as-string ()
+  "Test `sx--thing-as-string'"
+  (should
+   (string= (sx--thing-as-string
+             '(hello world (this is a test))
+             '(";" "+"))
+            "hello;world;this+is+a+test"))
+  (should
+   (string= (sx--thing-as-string
+             '(this is a test) '(";" "+"))
+            "this;is;a;test"))
+  (should
+   (string= (sx--thing-as-string
+             '(this is a test) "+")
+            "this+is+a+test"))
+  (should
+   (string= (sx--thing-as-string
+             '(this is a test))
+            "this;is;a;test"))
+  (should
+   (string= (sx--thing-as-string
+             'test)
+            "test"))
+  (should
+   (string= (sx--thing-as-string
+             'test&)
+            "test&"))
+  (should
+   (string= (sx--thing-as-string
+             'test& nil t)
+            "test%26")))
diff --git a/test/tests.el b/test/tests.el
index 3c275fd..53e053f 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -1,3 +1,5 @@
+
+;;; SX Settings
 (defun -sx--nuke ()
   (interactive)
   (mapatoms
@@ -5,11 +7,17 @@
      (if (string-prefix-p "sx-" (symbol-name symbol))
          (unintern symbol)))))
 
-;;; Tests
+(setq
+ sx-initialized t
+ sx-request-remaining-api-requests-message-threshold 50000
+ debug-on-error t
+ user-emacs-directory "."
+ sx-test-base-dir (file-name-directory (or load-file-name "./")))
+
+
+;;; Test Data
 (defvar sx-test-data-dir
-  (expand-file-name
-   "data-samples/"
-   (file-name-directory (or load-file-name "./"))))
+  (expand-file-name "data-samples/" sx-test-base-dir))
 
 (defun sx-test-sample-data (method &optional directory)
   (let ((file (concat (when directory (concat directory "/"))
@@ -20,161 +28,34 @@
         (insert-file-contents file)
         (read (buffer-string))))))
 
-(defmacro line-should-match (regexp)
-  ""
-  `(let ((line (buffer-substring-no-properties
-                (line-beginning-position)
-                (line-end-position))))
-     (message "Line here is: %S" line)
-     (should (string-match ,regexp line))))
-
 (setq
- sx-initialized t
- sx-request-remaining-api-requests-message-threshold 50000
- debug-on-error t
- user-emacs-directory "."
-
  sx-test-data-questions
  (sx-test-sample-data "questions")
  sx-test-data-sites
  (sx-test-sample-data "sites"))
 
-(setq package-user-dir
-      (expand-file-name (format "../../.cask/%s/elpa" emacs-version)
-                        sx-test-data-dir))
-(package-initialize)
-
-(require 'cl-lib)
-(require 'sx)
-(require 'sx-question)
-(require 'sx-question-list)
-(require 'sx-tab)
-
-(ert-deftest test-basic-request ()
-  "Test basic request functionality"
-  (should (sx-request-make "sites")))
-
-(ert-deftest test-question-retrieve ()
-  "Test the ability to receive a list of questions."
-  (should (sx-question-get-questions 'emacs)))
-
-(ert-deftest test-bad-request ()
-  "Test a method given a bad set of keywords"
-  (should-error
-   (sx-request-make "questions" '(()))))
-
-(ert-deftest test-tree-filter ()
-  "`sx-core-filter-data'"
-  ;; flat
-  (should
-   (equal
-    '((1 . t) (2 . [1 2]) (3))
-    (sx--filter-data '((0 . 3) (1 . t) (a . five) (2 . [1 2])
-                       ("5" . bop) (3) (p . 4))
-                     '(1 2 3))))
-  ;; complex
-  (should
-   (equal
-    '((1 . [a b c])
-      (2 . [((a . 1) (c . 3))
-            ((a . 4) (c . 6))])
-      (3 . peach))
-    (sx--filter-data '((1 . [a b c])
-                       (2 . [((a . 1) (b . 2) (c . 3))
-                             ((a . 4) (b . 5) (c . 6))])
-                       (3 . peach)
-                       (4 . banana))
-                     '(1 (2 a c) 3))))
-
-  ;; vector
-  (should
-   (equal
-    [((1 . 2) (2 . 3) (3 . 4))
-     ((1 . a) (2 . b) (3 . c))
-     nil ((1 . alpha) (2 . beta))]
-    (sx--filter-data [((1 . 2) (2 . 3) (3 . 4))
-                      ((1 . a) (2 . b) (3 . c) (5 . seven))
-                      ((should-not-go))
-                      ((1 . alpha) (2 . beta))]
-                     '(1 2 3)))))
+
+;;; General Settings
+(setq
+ package-user-dir (expand-file-name
+                   (format "../../.cask/%s/elpa" emacs-version)
+                   sx-test-data-dir))
 
-(ert-deftest question-list-display ()
-  (cl-letf (((symbol-function #'sx-request-make)
-             (lambda (&rest _) sx-test-data-questions)))
-    (sx-tab-frontpage nil "emacs")
-    (switch-to-buffer "*question-list*")
-    (goto-char (point-min))
-    (should (equal (buffer-name) "*question-list*"))
-    (line-should-match
-     "^\\s-+1\\s-+0\\s-+Focus-hook: attenuate colours when losing focus [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[frames\\] \\[hooks\\] \\[focus\\]")
-    (sx-question-list-next 5)
-    (line-should-match
-     "^\\s-+0\\s-+1\\s-+Babel doesn't wrap results in verbatim [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[org-mode\\]")
-    ;; ;; Use this when we have a real sx-question buffer.
-    ;; (call-interactively 'sx-question-list-display-question)
-    ;; (should (equal (buffer-name) "*sx-question*"))
-    (switch-to-buffer "*question-list*")
-    (sx-question-list-previous 4)
-    (line-should-match
-     "^\\s-+2\\s-+1\\s-+"Making tag completion table" Freezes/Blocks -- how to disable [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[autocomplete\\]")))
+(package-initialize)
 
-(ert-deftest macro-test--sx-assoc-let ()
-  "Tests macro expansion for `sx-assoc-let'"
-  (let ((prototype '((test . nil) (test-one . 1) (test-two . 2)
-                     (link . "http://meta.emacs.stackexchange.com/"))))
-    (let ((data (copy-tree prototype)))
-      (should
-       (null (let-alist data .site))))
+(require 'sx-load)
 
-    (let ((data (copy-tree prototype)))
-      (should
-       (equal (sx-assoc-let data .site)
-              "meta.emacs")))
+(defun sx-load-test (test)
+  (load-file
+   (format "%s/test-%s.el"
+           sx-test-base-dir
+           (symbol-name test))))
 
-    (let ((data (copy-tree prototype)))
-      (should
-       (equal (sx-assoc-let data (cons .test-one .test-two))
-              '(1 . 2))))))
+(setq sx-test-enable-messages nil)
 
-(ert-deftest sx--user-@name ()
-  "Tests macro expansion for `sx-assoc-let'"
-  (should
-   (string=
-    (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★")))
-    "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj"))
-  (should
-   (string=
-    (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ")))
-    "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ")))
+(defun sx-test-message (message &rest args)
+  (when sx-test-enable-messages
+    (apply #'message message args)))
 
-(ert-deftest thing-as-string ()
-  "Tests `sx--thing-as-string'"
-  (should
-   (string= (sx--thing-as-string
-             '(hello world (this is a test))
-             '(";" "+"))
-            "hello;world;this+is+a+test"))
-  (should
-   (string= (sx--thing-as-string
-             '(this is a test) '(";" "+"))
-            "this;is;a;test"))
-  (should
-   (string= (sx--thing-as-string
-             '(this is a test) "+")
-            "this+is+a+test"))
-  (should
-   (string= (sx--thing-as-string
-             '(this is a test))
-            "this;is;a;test"))
-  (should
-   (string= (sx--thing-as-string
-             'test)
-            "test"))
-  (should
-   (string= (sx--thing-as-string
-             'test&)
-            "test&"))
-  (should
-   (string= (sx--thing-as-string
-             'test& nil t)
-            "test%26")))
+(mapc #'sx-load-test
+      '(api macros printing util))