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-make-testable-db (n &optional name file
)
56 (let* ((db (registry-db
58 :file
(or file
"unused")
60 :max-soft
0 ; keep nothing not precious
61 :precious
'(extra more-extra
)
62 :tracked
'(sender subject groups
))))
64 (registry-insert db i
`((sender "me")
66 (more-extra) ; empty data key should be pruned
67 ;; first 5 entries will NOT have this extra data
68 ,@(when (< 5 i
) (list (list 'extra
"more data")))
69 (groups ,(number-to-string i
)))))
72 (ert-deftest gnustest-registry-usage-test
()
74 (db (gnustest-registry-make-testable-db n
)))
76 (should (= n
(registry-size db
)))
77 (message "max-hard test")
78 (should-error (registry-insert db
"new" '()))
79 (message "Individual lookup")
80 (should (= 58 (caadr (registry-lookup db
'(1 58 99)))))
81 (message "Grouped individual lookup")
82 (should (= 3 (length (registry-lookup db
'(1 58 99)))))
83 (when (boundp 'lexical-binding
)
84 (message "Individual lookup (breaks before lexbind)")
86 (caadr (registry-lookup-breaks-before-lexbind db
'(1 58 99)))))
87 (message "Grouped individual lookup (breaks before lexbind)")
89 (length (registry-lookup-breaks-before-lexbind db
92 (should (= n
(length (registry-search db
:all t
))))
93 (should (= n
(length (registry-search db
:member
'((sender "me"))))))
94 (message "Secondary index search")
95 (should (= n
(length (registry-lookup-secondary-value db
'sender
"me"))))
96 (should (equal '(74) (registry-lookup-secondary-value db
'groups
"74")))
98 (should (registry-delete db
'(1) t
))
100 (message "Search after delete")
101 (should (= n
(length (registry-search db
:all t
))))
102 (message "Secondary search after delete")
103 (should (= n
(length (registry-lookup-secondary-value db
'sender
"me"))))
104 ;; (message "Pruning")
105 ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
106 ;; (count (- n (length tokeep)))
107 ;; (pruned (registry-prune db))
108 ;; (prune-count (length pruned)))
109 ;; (message "Expecting to prune %d entries and pruned %d"
110 ;; count prune-count)
111 ;; (should (and (= count 5)
112 ;; (= count prune-count))))
113 (message "Done with usage testing.")))
115 (ert-deftest gnustest-registry-persistence-test
()
117 (tempfile (make-temp-file "registry-persistence-"))
118 (name "persistence tester")
119 (db (gnustest-registry-make-testable-db n name tempfile
))
121 (message "Saving to %s" tempfile
)
122 (eieio-persistent-save db
)
123 (setq size
(nth 7 (file-attributes tempfile
)))
124 (message "Saved to %s: size %d" tempfile size
)
127 (insert-file-contents-literally tempfile
)
128 (should (looking-at (concat ";; Object "
130 "\n;; EIEIO PERSISTENT OBJECT"))))
131 (message "Reading object back")
132 (setq back
(eieio-persistent-read tempfile
))
134 (message "Read object back: %d keys, expected %d==%d"
135 (registry-size back
) n
(registry-size db
))
136 (should (= (registry-size back
) n
))
137 (should (= (registry-size back
) (registry-size db
)))
138 (delete-file tempfile
))
139 (message "Done with persistence testing."))
141 (ert-deftest gnustest-gnus-registry-misc-test
()
142 (should-error (gnus-registry-extract-addresses '("" "")))
144 (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
146 "noname <cyd@stupidchicken.com>"
147 "noname <tzz@lifelogs.com>")
148 (gnus-registry-extract-addresses
149 (concat "Ted Zlatanov <tzz@lifelogs.com>, "
150 "ed <ed@you.me>, " ; "ed" is not a valid name here
151 "cyd@stupidchicken.com, "
152 "tzz@lifelogs.com")))))
154 (ert-deftest gnustest-gnus-registry-usage-test
()
156 (tempfile (make-temp-file "gnus-registry-persist"))
157 (db (gnus-registry-make-db tempfile
))
158 (gnus-registry-db db
)
160 (message "Adding %d keys to the test Gnus registry" n
)
162 (let ((id (number-to-string i
)))
163 (gnus-registry-handle-action id
164 (if (>= 50 i
) "fromgroup" nil
)
167 (format "subject %d" (mod i
10)))
169 (format "sender %d" (mod i
10))))))
170 (message "Testing Gnus registry size is %d" n
)
171 (should (= n
(registry-size db
)))
172 (message "Looking up individual keys (registry-lookup)")
173 (should (equal (loop for e
175 (registry-lookup db
'("20" "83" "72")))
176 collect
(assq 'subject e
)
177 collect
(assq 'sender e
)
178 collect
(assq 'group e
))
179 '((subject "subject 0") (sender "sender 0") (group "togroup")
180 (subject) (sender) (group "togroup")
181 (subject) (sender "sender 2") (group "togroup"))))
183 (message "Looking up individual keys (gnus-registry-id-key)")
184 (should (equal (gnus-registry-get-id-key "34" 'group
) '("togroup")))
185 (should (equal (gnus-registry-get-id-key "34" 'subject
) '("subject 4")))
186 (message "Trying to insert a duplicate key")
187 (should-error (gnus-registry-insert db
"55" '()))
188 (message "Looking up individual keys (gnus-registry-get-or-make-entry)")
189 (should (gnus-registry-get-or-make-entry "22"))
190 (message "Saving the Gnus registry to %s" tempfile
)
191 (should (gnus-registry-save tempfile db
))
192 (setq size
(nth 7 (file-attributes tempfile
)))
193 (message "Saving the Gnus registry to %s: size %d" tempfile size
)
196 (insert-file-contents-literally tempfile
)
197 (should (looking-at (concat ";; Object "
199 "\n;; EIEIO PERSISTENT OBJECT"))))
200 (message "Reading Gnus registry back")
201 (setq back
(eieio-persistent-read tempfile
))
203 (message "Read Gnus registry back: %d keys, expected %d==%d"
204 (registry-size back
) n
(registry-size db
))
205 (should (= (registry-size back
) n
))
206 (should (= (registry-size back
) (registry-size db
)))
207 (delete-file tempfile
)
208 (message "Pruning Gnus registry to 0 by setting :max-soft")
209 (oset db
:max-soft
0)
211 (should (= (registry-size db
) 0)))
212 (message "Done with Gnus registry usage testing."))
214 (provide 'gnustest-registry
)
217 ;; no-byte-compile: t
218 ;; no-update-autoloads: t