[elpa] master b9bc7f0 05/13: Tests and stubs

[Dmitry Gutov]

branch: master
commit b9bc7f0ed6e316604f74b45d0d7c38f5f4fabe56
Author: Ingo Lohmar <address@hidden>
Commit: Ingo Lohmar <address@hidden>

    Tests and stubs
---
 company-statistics-tests.el |  282 +++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 282 insertions(+), 0 deletions(-)

diff --git a/company-statistics-tests.el b/company-statistics-tests.el
new file mode 100644
index 0000000..6e0b460
--- /dev/null
+++ b/company-statistics-tests.el
@@ -0,0 +1,282 @@
+;;; company-statistics-tests.el --- company-statistics tests
+
+;; Copyright (C) 2014  Free Software Foundation, Inc.
+
+;; Author: Ingo Lohmar
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;; emacs -batch -L . -l ert -l company-statistics-tests.el  -f 
ert-run-tests-batch-and-exit
+
+;;; Code:
+
+(require 'ert)
+
+(require 'company-statistics)
+(setq company-statistics-auto-restore nil
+      company-statistics-auto-save nil)
+
+(company-statistics-mode)
+
+;;; Core
+
+(defun my/hash-compare (h1 h2 &optional pred)
+  "Check that hashes H1 and H2 use the same test, contain the same keys (as
+per that test), and that their stored values agree (as per PRED, which
+defaults to `equal')."
+  (let ((key-test (hash-table-test h1))
+        (pred (or pred 'equal)))
+    (and (eq key-test (hash-table-test h2))
+         (eq (hash-table-count h1) (hash-table-count h2))
+         (let ((keys nil))
+           (maphash (lambda (k v) (push k keys)) h1) ;get keys
+           (null                                     ;expect no mismatch
+            (catch 'mismatch
+              (while keys               ;if this finishes, it's nil
+                (let* ((k (car keys))
+                       (v1 (gethash k h1))
+                       (v2 (gethash k h2)))
+                  (setq keys (cdr keys))
+                  (unless (funcall pred v1 v2)
+                    (throw 'mismatch k))))))))))
+
+(defun my/vector-slice-compare (v1 i1 v2 i2 count &optional pred)
+  "Check that COUNT vector entries of V1 (starting at index I1) and
+V2 (starting at index I2) satisfy the binary predicate PRED, default
+`equal'.  Wraps around if index exceeds corresponding vector length."
+  (let ((pred (or pred 'equal)))
+    (null
+     (let ((l1 (length v1))
+           (l2 (length v2)))
+       (catch 'mismatch
+         (dolist (i (number-sequence 0 (1- count)))
+           (unless (funcall pred
+                            (aref v1 (mod (+ i1 i) l1))
+                            (aref v2 (mod (+ i2 i) l2)))
+             (throw 'mismatch t))))))))
+
+(defmacro cs-fixture (&rest body)
+  "Set up a completion history."
+  `(unwind-protect
+       ;; some setup to get a completion history
+       (let ((company-statistics-size 5))
+         (company-statistics--init)
+         (let ((major-mode 'foo-mode)
+               (buffer-file-name nil))
+           (company-statistics--finished "foo"))
+         (let ((major-mode 'foo-mode)
+               (buffer-file-name "bar-file"))
+           (company-statistics--finished "bar"))
+         (let ((major-mode 'baz-mode)
+               (buffer-file-name nil))
+           (company-statistics--finished "baz"))
+         (let ((major-mode 'baz-mode)
+               (buffer-file-name "quux-file"))
+           (company-statistics--finished "quux"))
+         ,@body)
+     ;; tear down to clean slate
+     (company-statistics--init)))
+
+(defmacro cs-persistence-fixture (&rest body)
+  "Check and prepare for persistence, clean up."
+  `(let ((company-statistics-file "./cs-test-tmp"))
+     (when (and (file-exists-p company-statistics-file)
+                (file-writable-p company-statistics-file))
+       (unwind-protect
+           (progn ,@body)
+         ;; clean up file system
+         (when (file-exists-p company-statistics-file)
+           (delete-file company-statistics-file))))))
+
+;; tests themselves
+
+(ert-deftest c-s-history-resize ()
+  "Test history-resize for shrinking and enlarging."
+  (cs-fixture
+   ;; resize several times
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp)))
+     (company-statistics--log-resize 'dummy 10)
+     ;; scores unaffected?
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     ;; find all 4 old entries
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 4)
+                                      cs-history 0
+                                      4))
+     ;; index at "old-size"
+     (should (equal company-statistics--index 5))
+     (company-statistics--log-resize 'dummy 5)
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 4)
+                                      cs-history 0
+                                      4))
+     ;; after shrink: index at 0
+     (should (equal company-statistics--index 0))
+     ;; lose oldest entry "foo"
+     (company-statistics--log-resize 'dummy 3)
+     ;; score should be removed
+     (should-not (gethash "foo" company-statistics--scores))
+     ;; find *3* latest entries
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 3)
+                                      cs-history 1
+                                      3))
+     (should (equal company-statistics--index 0)))))
+
+(ert-deftest c-s-persistence ()
+  "Test that all statistics are properly saved and restored."
+  (cs-persistence-fixture
+   (cs-fixture
+    (let ((cs-scores (copy-sequence company-statistics--scores))
+          (cs-history (copy-sequence company-statistics--log))
+          (cs-index company-statistics--index))
+      (company-statistics--save)
+      (company-statistics--init)        ;hence shallow copies suffice
+      (company-statistics--load)
+      ;; (should (equal company-statistics--scores cs-scores))
+      (should (my/hash-compare company-statistics--scores cs-scores))
+      (should (equal company-statistics--log cs-history))
+      (should (equal company-statistics--index cs-index))))))
+
+(ert-deftest c-s-score-change-default ()
+  "Test a few things about the default score updates."
+  (let ((major-mode 'foobar-mode)
+        (buffer-file-name nil))         ;must not generate context entries
+    (should (equal (company-statistics-score-change-default "dummy")
+                   '((nil . 1) (foobar-mode . 1))))
+    (let ((buffer-file-name "test-file.XYZ"))
+      (should (equal (company-statistics-score-change-default "dummy")
+                     '((nil . 1) (foobar-mode . 1) ("test-file.XYZ" . 1)))))))
+
+(ert-deftest c-s-score-calc-default ()
+  "Test score calculation default."
+  (cs-fixture
+   (let ((major-mode 'foo-mode)
+         (buffer-file-name nil))
+     (should (eq (company-statistics-score-calc-default "foo") 2))
+     (should (eq (company-statistics-score-calc-default "bar") 2))
+     (should (eq (company-statistics-score-calc-default "baz") 1))
+     (should (eq (company-statistics-score-calc-default "quux") 1)))
+   (let ((major-mode 'foo-mode)
+         (buffer-file-name "bar-file"))
+     (should (eq (company-statistics-score-calc-default "foo") 2))
+     (should (eq (company-statistics-score-calc-default "bar") 3))
+     (should (eq (company-statistics-score-calc-default "baz") 1))
+     (should (eq (company-statistics-score-calc-default "quux") 1)))
+   (let ((major-mode 'baz-mode)
+         (buffer-file-name nil))
+     (should (eq (company-statistics-score-calc-default "foo") 1))
+     (should (eq (company-statistics-score-calc-default "bar") 1))
+     (should (eq (company-statistics-score-calc-default "baz") 2))
+     (should (eq (company-statistics-score-calc-default "quux") 2)))
+   (let ((major-mode 'baz-mode)
+         (buffer-file-name "quux-file"))
+     (should (eq (company-statistics-score-calc-default "foo") 1))
+     (should (eq (company-statistics-score-calc-default "bar") 1))
+     (should (eq (company-statistics-score-calc-default "baz") 2))
+     (should (eq (company-statistics-score-calc-default "quux") 3)))))
+
+(ert-deftest c-s-alist-update ()
+  "Test central helper function for context/score alist update."
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '+)
+                   '((nil . 0) ("a" . 2) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  ;; filter only checks on merged, so nil entry remains, and symbol should not 
pose a problem:
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '+ 'zerop)
+                   '((nil . 0) ("a" . 2) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '-)
+                   '((nil . 0) ("a" . 0) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '- 'zerop)
+                   '((nil . 0) ("b" . 2) ("d" . some-symbol) ("c" . 3))))))
+
+(ert-deftest c-s-scores-add ()
+  "Test adding scores."
+  (cs-fixture
+   ;; new entry
+   (company-statistics--scores-add "zufpah" '((nil . 27)))
+   (should (equal (gethash "zufpah" company-statistics--scores)
+                  '((nil . 27))))
+   ;; update existing entry
+   (company-statistics--scores-add "foo" '((nil . 2)))
+   (let ((h (gethash "foo" company-statistics--scores)))
+     (should (equal (assoc nil h) '(nil . 3)))
+     (should (equal (assoc 'foo-mode h) '(foo-mode . 1))))))
+
+(ert-deftest c-s-history-revert ()
+  "Test reverting a score update stored in history."
+  ;; deep copies throughout!
+  (cs-fixture
+   ;; pointing to nil, should not change anything
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (company-statistics--log-revert)
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))))
+  (cs-fixture
+   ;; remove existing item 2: should vanish from scores
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (company-statistics--log-revert 2)
+     (should-not (gethash "baz" company-statistics--scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))))
+  (cs-fixture
+   ;; remove just inserted item 3 (scores should be same)
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (let ((major-mode 'extra-mode))
+       (company-statistics--finished "foo")) ;adds to scores, history, index
+     (company-statistics--log-revert 4) ;reverts scores only, so...
+     (aset cs-history 4 '("foo" (nil . 1) (extra-mode . 1)))
+     (setq cs-index (mod (1+ cs-index) company-statistics-size))
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index)))))
+
+(ert-deftest c-s-history-store ()
+  "Test insert/overwrite of history item."
+  (cs-fixture
+   (let ((cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     ;; only changes history and index
+     (company-statistics--log-store "foo" '((nil . 27)))
+     (aset cs-history cs-index '("foo" (nil . 27)))
+     (setq cs-index 0)                  ;wraps around
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))
+     ;; now wrap around to overwrite an entry
+     (company-statistics--log-store "tagyok" '((bla . 42)))
+     (aset cs-history cs-index '("tagyok" (bla . 42)))
+     (setq cs-index 1)
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index)))))
+
+;; test finished and sort functions?  if the above is ok, they are trivial...