aboutsummaryrefslogtreecommitdiff
path: root/test/tests.el
blob: a66394c63d1c5094f78fee7fd4374ca06094e6d0 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
(defun -sx--nuke ()
  (interactive)
  (mapatoms
   (lambda (symbol)
     (if (string-prefix-p "sx-" (symbol-name symbol))
         (unintern symbol)))))

;;; Tests
(defvar sx-test-data-dir
  (expand-file-name
   "data-samples/"
   (or (file-name-directory load-file-name) "./")))

(defun sx-test-sample-data (method &optional directory)
  (let ((file (concat (when directory (concat directory "/"))
                      sx-test-data-dir
                      method ".el")))
    (when (file-exists-p file)
      (with-temp-buffer
        (insert-file-contents file)
        (read (buffer-string))))))

(setq
 sx-request-remaining-api-requests-message-threshold 50000
 debug-on-error t
 sx-request-silent-p nil
 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)

(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)))))

(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))))

(ert-deftest question-list-display ()
  (cl-letf (((symbol-function #'sx-request-make)
             (lambda (&rest _) sx-test-data-questions)))
    (list-questions nil)
    (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]+[ydhms] 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]+[ydhms] 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]+[ydhms] ago\\s-+\\[autocomplete\\]")))