Remove nnml-retrieve-groups that is unnecessary and somewhat problematic
[gnus] / lisp / tests / gnustest-registry.el
index 512fab4..475391c 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnustest-registry.el --- Registry and Gnus registry testing for Gnus
-;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
 
 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
 
@@ -16,9 +16,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
     (should-not (registry--match :member entry '((hello)))))
   (message "Done with matching testing."))
 
-(defun gnustest-registry-make-testable-db (n &optional name file)
+(defun gnustest-registry-sort-function (l r)
+  "Sort lower values of sort-field earlier."
+  (< (cadr (assq 'sort-field l))
+     (cadr (assq 'sort-field r))))
+
+(defun gnustest-registry-make-testable-db (n &optional prune-factor name file)
   (let* ((db (registry-db
               (or name "Testing")
               :file (or file "unused")
-              :max-hard n
-              :max-soft 0               ; keep nothing not precious
+              :max-size n
+             :prune-factor (or prune-factor 0.1)
               :precious '(extra more-extra)
               :tracked '(sender subject groups))))
     (dotimes (i n)
       (registry-insert db i `((sender "me")
                               (subject "about you")
-                              (more-extra) ; empty data key should be pruned
-                              ;; first 5 entries will NOT have this extra data
-                              ,@(when (< 5 i) (list (list 'extra "more data")))
+                              (more-extra) ; Empty data key should be pruned.
+                              ;; First 5 entries will NOT have this extra data.
+                              ,@(when (< 4 i) (list (list 'extra "more data")))
+                             (sort-field ,(- n i))
                               (groups ,(number-to-string i)))))
     db))
 
     (should (= n (length (registry-search db :all t))))
     (message "Secondary search after delete")
     (should (= n (length (registry-lookup-secondary-value db 'sender "me"))))
-    ;; (message "Pruning")
-    ;; (let* ((tokeep (registry-search db :member '((extra "more data"))))
-    ;;        (count (- n (length tokeep)))
-    ;;        (pruned (registry-prune db))
-    ;;        (prune-count (length pruned)))
-    ;;   (message "Expecting to prune %d entries and pruned %d"
-    ;;            count prune-count)
-    ;;   (should (and (= count 5)
-    ;;                (= count prune-count))))
     (message "Done with usage testing.")))
 
+(ert-deftest gnustest-registry-pruning-test ()
+  "Check that precious entries are never pruned."
+  (let ((dbs (list
+             ;; Can prune fully without touching precious entries.
+             (gnustest-registry-make-testable-db 10 0.1)
+             ;; Pruning limited by precious entries.
+             (gnustest-registry-make-testable-db 10 0.6))))
+    (dolist (db dbs)
+      (message "Pruning")
+      (let* ((size (registry-size db))
+            (limit (- (oref db :max-size)
+                      (* (oref db :max-size)
+                         (oref db :prune-factor))))
+            (keepers (registry-search db :member '((extra "more data"))))
+            (expected-prune-count (min (- size (length keepers))
+                                       (- size limit)))
+            (actual-prune-count (registry-prune db)))
+       (ert-info
+           ((format "Expected to prune %d entries but pruned %d"
+                    expected-prune-count actual-prune-count)
+            :prefix "Error: ")
+         (should (= expected-prune-count actual-prune-count)))))))
+
+(ert-deftest gnustest-registry-pruning-sort-test ()
+  "Check that entries are sorted properly before pruning."
+  (let ((db (gnustest-registry-make-testable-db 10 0.4))
+       ;; These entries have the highest 'sort-field values.  Pruning
+       ;; sorts by lowest values first, then prunes from the front of
+       ;; the list, so these entries survive
+       (expected-survivors '(5 6 7 8 9 0))
+       actual-survivors disjunct)
+    (registry-prune
+     db #'gnustest-registry-sort-function)
+    (maphash (lambda (k v) (push k actual-survivors))
+            (oref db :data))
+    (setq disjunct (cl-set-exclusive-or
+                   expected-survivors
+                   actual-survivors))
+    (ert-info
+       ((format "Incorrect pruning: %s" disjunct)
+        :prefix "Error: ")
+      (should (null disjunct)))))
+
 (ert-deftest gnustest-registry-persistence-test ()
   (let* ((n 100)
          (tempfile (make-temp-file "registry-persistence-"))
          (name "persistence tester")
-         (db (gnustest-registry-make-testable-db n name tempfile))
+         (db (gnustest-registry-make-testable-db n nil name tempfile))
          size back)
     (message "Saving to %s" tempfile)
     (eieio-persistent-save db)
     (should (= (registry-size back) n))
     (should (= (registry-size back) (registry-size db)))
     (delete-file tempfile)
-    (message "Pruning Gnus registry to 0 by setting :max-soft")
-    (oset db :max-soft 0)
+    (message "Pruning Gnus registry to 0 by setting :max-size")
+    (oset db :max-size 0)
     (registry-prune db)
     (should (= (registry-size db) 0)))
   (message "Done with Gnus registry usage testing."))
 
 (provide 'gnustest-registry)
+
+;; Local Variables:
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End: