cgit.sxemacs.org Git - gnus/blob - lisp/tests/gnustest-registry.el

   1 ;;; gnustest-registry.el --- Registry and Gnus registry testing for Gnus
   2 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
   3
   4 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   5
   6 ;; This file is not part of GNU Emacs.
   7
   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)
  11 ;; any later version.
  12
  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.
  17
  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/>.
  20
  21 ;;; Commentary:
  22
  23 ;;; Code:
  24
  25 (eval-when-compile
  26   (when (null (ignore-errors (require 'ert)))
  27     (defmacro* ert-deftest (name () &body docstring-keys-and-body))))
  28
  29 (ignore-errors
  30   (require 'ert))
  31
  32 (require 'registry)
  33 (require 'gnus-registry)
  34
  35 (ert-deftest gnustest-registry-instantiation-test ()
  36   (should (registry-db "Testing")))
  37
  38 (ert-deftest gnustest-registry-match-test ()
  39   (let ((entry '((hello "goodbye" "bye") (blank))))
  40
  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))))
  46
  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."))
  54
  55 (defun gnustest-registry-make-testable-db (n &optional name file)
  56   (let* ((db (registry-db
  57               (or name "Testing")
  58               :file (or file "unused")
  59               :max-hard n
  60               :max-soft 0               ; keep nothing not precious
  61               :precious '(extra more-extra)
  62               :tracked '(sender subject groups))))
  63     (dotimes (i n)
  64       (registry-insert db i `((sender "me")
  65                               (subject "about you")
  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)))))
  70     db))
  71
  72 (ert-deftest gnustest-registry-usage-test ()
  73   (let* ((n 100)
  74          (db (gnustest-registry-make-testable-db n)))
  75     (message "size %d" 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)")
  85       (should (= 58
  86                  (caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
  87       (message "Grouped individual lookup (breaks before lexbind)")
  88       (should (= 3
  89                  (length (registry-lookup-breaks-before-lexbind db
  90                                                                 '(1 58 99))))))
  91     (message "Search")
  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")))
  97     (message "Delete")
  98     (should (registry-delete db '(1) t))
  99     (decf n)
 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.")))
 114
 115 (ert-deftest gnustest-registry-persistence-test ()
 116   (let* ((n 100)
 117          (tempfile (make-temp-file "registry-persistence-"))
 118          (name "persistence tester")
 119          (db (gnustest-registry-make-testable-db n name tempfile))
 120          size back)
 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)
 125     (should (< 0 size))
 126     (with-temp-buffer
 127       (insert-file-contents-literally tempfile)
 128       (should (looking-at (concat ";; Object "
 129                                   name
 130                                   "\n;; EIEIO PERSISTENT OBJECT"))))
 131     (message "Reading object back")
 132     (setq back (eieio-persistent-read tempfile))
 133     (should back)
 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."))
 140
 141 (ert-deftest gnustest-gnus-registry-misc-test ()
 142   (should-error (gnus-registry-extract-addresses '("" "")))
 143
 144   (should (equal '("Ted Zlatanov <tzz@lifelogs.com>"
 145                    "noname <ed@you.me>"
 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")))))
 153
 154 (ert-deftest gnustest-gnus-registry-usage-test ()
 155   (let* ((n 100)
 156          (tempfile (make-temp-file "gnus-registry-persist"))
 157          (db (gnus-registry-make-db tempfile))
 158          (gnus-registry-db db)
 159          back size)
 160     (message "Adding %d keys to the test Gnus registry" n)
 161     (dotimes (i n)
 162       (let ((id (number-to-string i)))
 163         (gnus-registry-handle-action id
 164                                      (if (>= 50 i) "fromgroup" nil)
 165                                      "togroup"
 166                                      (when (>= 70 i)
 167                                        (format "subject %d" (mod i 10)))
 168                                      (when (>= 80 i)
 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
 174                          in (mapcar 'cadr
 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"))))
 182
 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)
 194     (should (< 0 size))
 195     (with-temp-buffer
 196       (insert-file-contents-literally tempfile)
 197       (should (looking-at (concat ";; Object "
 198                                   "Gnus Registry"
 199                                   "\n;; EIEIO PERSISTENT OBJECT"))))
 200     (message "Reading Gnus registry back")
 201     (setq back (eieio-persistent-read tempfile))
 202     (should back)
 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)
 210     (registry-prune db)
 211     (should (= (registry-size db) 0)))
 212   (message "Done with Gnus registry usage testing."))
 213
 214 (provide 'gnustest-registry)
 215
 216 ;; Local Variables:
 217 ;; no-byte-compile: t
 218 ;; no-update-autoloads: t
 219 ;; End: