1 ;;; gnustest-registry.el --- Registry and Gnus registry testing for Gnus
2 ;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
4 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
6 ;; This file is not part of GNU Emacs.
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 3, or (at your option)
13 ;; GNU Emacs is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 (when (null (ignore-errors (require 'ert)))
27 (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
33 (require 'gnus-registry)
35 (ert-deftest gnustest-registry-instantiation-test ()
36 (should (registry-db "Testing")))
38 (ert-deftest gnustest-registry-match-test ()
39 (let ((entry '((hello "goodbye" "bye") (blank))))
41 (message "Testing :regex matching")
42 (should (registry--match :regex entry '((hello "nye" "bye"))))
43 (should (registry--match :regex entry '((hello "good"))))
44 (should-not (registry--match :regex entry '((hello "nye"))))
45 (should-not (registry--match :regex entry '((hello))))
47 (message "Testing :member matching")
48 (should (registry--match :member entry '((hello "bye"))))
49 (should (registry--match :member entry '((hello "goodbye"))))
50 (should-not (registry--match :member entry '((hello "good"))))
51 (should-not (registry--match :member entry '((hello "nye"))))
52 (should-not (registry--match :member entry '((hello)))))
53 (message "Done with matching testing."))
55 (defun gnustest-registry-sort-function (l r)
56 "Sort lower values of sort-field earlier."
57 (< (cadr (assq 'sort-field l))
58 (cadr (assq 'sort-field r))))
60 (defun gnustest-registry-make-testable-db (n &optional prune-factor name file)
61 (let* ((db (registry-db
63 :file (or file "unused")
65 :prune-factor (or prune-factor 0.1)
66 :precious '(extra more-extra)
67 :tracked '(sender subject groups))))
69 (registry-insert db i `((sender "me")
71 (more-extra) ; Empty data key should be pruned.
72 ;; First 5 entries will NOT have this extra data.
73 ,@(when (< 4 i) (list (list 'extra "more data")))
75 (groups ,(number-to-string i)))))
78 (ert-deftest gnustest-registry-usage-test ()
80 (db (gnustest-registry-make-testable-db n)))
82 (should (= n (registry-size db)))
83 (message "max-hard test")
84 (should-error (registry-insert db "new" '()))
85 (message "Individual lookup")
86 (should (= 58 (caadr (registry-lookup db '(1 58 99)))))
87 (message "Grouped individual lookup")
88 (should (= 3 (length (registry-lookup db '(1 58 99)))))
89 (when (boundp 'lexical-binding)
90 (message "Individual lookup (breaks before lexbind)")
92 (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
93 (message "Grouped individual lookup (breaks before lexbind)")
95 (length (registry-lookup-breaks-before-lexbind db
98 (should (= n (length (registry-search db :all t))))
99 (should (= n (length (registry-search db :member '((sender "me"))))))
100 (message "Secondary index search")
101 (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
102 (should (equal '(74) (registry-lookup-secondary-value db 'groups "74")))
104 (should (registry-delete db '(1) t))
106 (message "Search after delete")
107 (should (= n (length (registry-search db :all t))))
108 (message "Secondary search after delete")
109 (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
110 (message "Done with usage testing.")))
112 (ert-deftest gnustest-registry-pruning-test ()
113 "Check that precious entries are never pruned."
115 ;; Can prune fully without touching precious entries.
116 (gnustest-registry-make-testable-db 10 0.1)
117 ;; Pruning limited by precious entries.
118 (gnustest-registry-make-testable-db 10 0.6))))
121 (let* ((size (registry-size db))
122 (limit (- (oref db :max-size)
123 (* (oref db :max-size)
124 (oref db :prune-factor))))
125 (keepers (registry-search db :member '((extra "more data"))))
126 (expected-prune-count (min (- size (length keepers))
128 (actual-prune-count (registry-prune db)))
130 ((format "Expected to prune %d entries but pruned %d"
131 expected-prune-count actual-prune-count)
133 (should (= expected-prune-count actual-prune-count)))))))
135 (ert-deftest gnustest-registry-pruning-sort-test ()
136 "Check that entries are sorted properly before pruning."
137 (let ((db (gnustest-registry-make-testable-db 10 0.4))
138 ;; These entries have the highest 'sort-field values. Pruning
139 ;; sorts by lowest values first, then prunes from the front of
140 ;; the list, so these entries survive
141 (expected-survivors '(5 6 7 8 9 0))
142 actual-survivors disjunct)
144 db #'gnustest-registry-sort-function)
145 (maphash (lambda (k v) (push k actual-survivors))
147 (setq disjunct (cl-set-exclusive-or
151 ((format "Incorrect pruning: %s" disjunct)
153 (should (null disjunct)))))
155 (ert-deftest gnustest-registry-persistence-test ()
157 (tempfile (make-temp-file "registry-persistence-"))
158 (name "persistence tester")
159 (db (gnustest-registry-make-testable-db n nil name tempfile))
161 (message "Saving to %s" tempfile)
162 (eieio-persistent-save db)
163 (setq size (nth 7 (file-attributes tempfile)))
164 (message "Saved to %s: size %d" tempfile size)
167 (insert-file-contents-literally tempfile)
168 (should (looking-at (concat ";; Object "
170 "\n;; EIEIO PERSISTENT OBJECT"))))
171 (message "Reading object back")
172 (setq back (eieio-persistent-read tempfile))
174 (message "Read object back: %d keys, expected %d==%d"
175 (registry-size back) n (registry-size db))
176 (should (= (registry-size back) n))
177 (should (= (registry-size back) (registry-size db)))
178 (delete-file tempfile))
179 (message "Done with persistence testing."))
181 (ert-deftest gnustest-gnus-registry-misc-test ()
182 (should-error (gnus-registry-extract-addresses '("" "")))
184 (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
186 "noname <cyd@stupidchicken.com>"
187 "noname <tzz@lifelogs.com>")
188 (gnus-registry-extract-addresses
189 (concat "Ted Zlatanov <tzz@lifelogs.com>, "
190 "ed <ed@you.me>, " ; "ed" is not a valid name here
191 "cyd@stupidchicken.com, "
192 "tzz@lifelogs.com")))))
194 (ert-deftest gnustest-gnus-registry-usage-test ()
196 (tempfile (make-temp-file "gnus-registry-persist"))
197 (db (gnus-registry-make-db tempfile))
198 (gnus-registry-db db)
200 (message "Adding %d keys to the test Gnus registry" n)
202 (let ((id (number-to-string i)))
203 (gnus-registry-handle-action id
204 (if (>= 50 i) "fromgroup" nil)
207 (format "subject %d" (mod i 10)))
209 (format "sender %d" (mod i 10))))))
210 (message "Testing Gnus registry size is %d" n)
211 (should (= n (registry-size db)))
212 (message "Looking up individual keys (registry-lookup)")
213 (should (equal (loop for e
215 (registry-lookup db '("20" "83" "72")))
216 collect (assq 'subject e)
217 collect (assq 'sender e)
218 collect (assq 'group e))
219 '((subject "subject 0") (sender "sender 0") (group "togroup")
220 (subject) (sender) (group "togroup")
221 (subject) (sender "sender 2") (group "togroup"))))
223 (message "Looking up individual keys (gnus-registry-id-key)")
224 (should (equal (gnus-registry-get-id-key "34" 'group) '("togroup")))
225 (should (equal (gnus-registry-get-id-key "34" 'subject) '("subject 4")))
226 (message "Trying to insert a duplicate key")
227 (should-error (gnus-registry-insert db "55" '()))
228 (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
229 (should (gnus-registry-get-or-make-entry "22"))
230 (message "Saving the Gnus registry to %s" tempfile)
231 (should (gnus-registry-save tempfile db))
232 (setq size (nth 7 (file-attributes tempfile)))
233 (message "Saving the Gnus registry to %s: size %d" tempfile size)
236 (insert-file-contents-literally tempfile)
237 (should (looking-at (concat ";; Object "
239 "\n;; EIEIO PERSISTENT OBJECT"))))
240 (message "Reading Gnus registry back")
241 (setq back (eieio-persistent-read tempfile))
243 (message "Read Gnus registry back: %d keys, expected %d==%d"
244 (registry-size back) n (registry-size db))
245 (should (= (registry-size back) n))
246 (should (= (registry-size back) (registry-size db)))
247 (delete-file tempfile)
248 (message "Pruning Gnus registry to 0 by setting :max-size")
249 (oset db :max-size 0)
251 (should (= (registry-size db) 0)))
252 (message "Done with Gnus registry usage testing."))
254 (provide 'gnustest-registry)
257 ;; no-byte-compile: t
258 ;; no-update-autoloads: t