[elpa] externals/mines 7660b39 21/43: Add test suite

[Stefan Monnier]

branch: externals/mines
commit 7660b39ca6ac353bb5d423e36eb452f7036cbf13
Author: Tino Calancha <tino.calancha@gmail.com>
Commit: Tino Calancha <tino.calancha@gmail.com>

    Add test suite
    
    * mines-tests.el
    * Makefile
    * .travis.yml: Add file.
---
 .travis.yml    |  22 ++++++
 Makefile       |  16 ++++
 mines-tests.el | 234 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 272 insertions(+)

diff --git a/.travis.yml b/.travis.yml
new file mode 100644
index 0000000..098eca7
--- /dev/null
+++ b/.travis.yml
@@ -0,0 +1,22 @@
+language: emacs-lisp
+
+notifications:
+  email:
+    on_success: never
+    on_failure: always
+
+env:
+  - EVM_EMACS=emacs-24.3-travis
+  - EVM_EMACS=emacs-24.4-travis
+  - EVM_EMACS=emacs-24.5-travis
+  - EVM_EMACS=emacs-git-snapshot-travis
+
+before_install:
+  - git clone https://github.com/rejeep/evm.git $HOME/.evm
+  - export PATH=$HOME/.evm/bin:$PATH
+
+  - evm config path /tmp
+  - evm install $EVM_EMACS --use --skip
+
+script:
+  - make test
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..97718b7
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,16 @@
+emacs ?= emacs
+
+LOAD = -l mines.el
+
+all: test
+
+test:
+       $(emacs) -batch $(LOAD) -l mines-tests.el -f 
ert-run-tests-batch-and-exit
+
+compile:
+       $(emacs) -batch --eval "(progn (add-to-list 'load-path 
default-directory) (byte-compile-file \"mines.el\"))"
+
+clean:
+       rm -f *.elc
+
+.PHONY: all compile clean test
diff --git a/mines-tests.el b/mines-tests.el
new file mode 100644
index 0000000..e19c557
--- /dev/null
+++ b/mines-tests.el
@@ -0,0 +1,234 @@
+;;; mines-tests.el --- Tests for mines.el  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha@gmail.com>,
+;; Keywords:
+
+;; 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:
+
+;;
+
+;;; code:
+
+(require 'ert)
+(require 'mines)
+(require 'cl-lib)
+
+(ert-deftest mines-test-gameover ()
+  (mines)
+  (let ((buf (get-buffer "*Mines*"))
+        (grid-orig (copy-sequence mines-grid))
+        (idx-bomb (cl-position t mines-grid))
+        idx-ok grid-new)
+    (with-current-buffer buf
+      (mines-goto idx-bomb) ; Go to first mine.
+      (setq idx-ok (cl-position-if-not (lambda (x) (eq t x)) mines-grid))
+      (should (mines-first-move-p))
+      (should-not (mines-dig)) ; Not gameover in first trial.
+      (setq grid-new (copy-sequence mines-grid))
+      ;; Adjacent cells to bombs must be updated as well.
+      (should-not (equal grid-orig
+                         (cl-rotatef (aref grid-new idx-bomb)
+                                     (aref grid-new idx-ok))))
+      (mines-goto (cl-position t mines-grid))
+      (should-not (mines-first-move-p))
+      ;; 2nd trial might end the game.
+      (cl-letf (((symbol-function 'yes-or-no-p)
+                 (lambda (&rest arg) (error "Fail"))))
+        (should-error (mines-dig))))
+    (when (buffer-live-p buf) (kill-buffer buf))))
+
+(ert-deftest mines-test-find-pos ()
+  (mines)
+  (let* ((buf (get-buffer "*Mines*"))
+         (empty-pos (mines--find-pos nil mines-grid))
+         (non-empty-pos (cl-set-difference
+                         (number-sequence 0 (1- mines-number-cells))
+                         empty-pos)))
+    (with-current-buffer buf
+      (dolist (idx empty-pos)
+        (should-not (aref mines-grid idx)))
+      (dolist (idx non-empty-pos)
+        (should (aref mines-grid idx))))
+    (when (buffer-live-p buf) (kill-buffer buf))))
+
+(ert-deftest mines-test-game-completed ()
+  (mines)
+  (let ((buf (get-buffer "*Mines*"))
+        (empty-pos (mines--find-pos nil mines-grid))
+        uncover-pos)
+    (with-current-buffer buf
+      (should (mines-mines-mode-p))
+      ;; Uncover all empty cells.
+      (dolist (idx empty-pos)
+        (mines-goto idx)
+        (mines-dig))
+      (setq uncover-pos (mines--find-pos nil mines-state))
+      ;; Exclude mines from `uncover-pos'.
+      (dolist (idx mines-mine-positions)
+        (setq uncover-pos (delete idx uncover-pos)))
+      ;; Uncover all but the first element in `uncover-pos'.
+      (dolist (idx (cdr uncover-pos))
+        (mines-goto idx)
+        (mines-dig))
+      (should-not (mines-end-p))
+      (mines-goto (car uncover-pos))
+      (mines-dig) ; Uncover the last one.
+      (should (mines-end-p)) ; Game completed.
+      (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest mines-test-indices ()
+  (= 0 (mines-matrix-2-index 0 0))
+  (= 1 (mines-matrix-2-index 0 1))
+  (= (1- mines-number-cols)
+     (mines-matrix-2-index 0 (1- mines-number-cols)))
+  (= (* mines-number-cols (1- mines-number-rows))
+     (mines-matrix-2-index (1- mines-number-rows) 0))
+  (= (1- mines-number-cells)
+     (mines-matrix-2-index (1- mines-number-rows) (1- mines-number-cols)))
+  ;; `mines-matrix-2-index' consistent with `mines-index-2-matrix'.
+  (dolist (idx (list 0 1 (1- mines-number-cols)
+                     (* mines-number-cols (1- mines-number-rows))
+                     (1- mines-number-cells)))
+    (= idx (apply #'mines-matrix-2-index (mines-index-2-matrix idx)))))
+
+(ert-deftest mines-test-neighbours ()
+  (cl-flet ((set-equalp (x y)
+                        (and (null (cl-set-difference x y))
+                             (= (length x) (length y)))))
+    (set-equalp (list 1 mines-number-cols (1+ mines-number-cols))
+                (mines-get-neighbours 0))
+    (set-equalp (list 0 2 mines-number-cols (1+ mines-number-cols) (+ 2 
mines-number-cols))
+                (mines-get-neighbours 1))
+    (set-equalp (list 1 2 3 mines-number-cols (1+ mines-number-cols) (+ 3 
mines-number-cols)
+                      (+ 2 (* 2 mines-number-cols)) (1+ (* 2 
mines-number-cols)) (+ 3 (* 2 mines-number-cols)))
+                (mines-get-neighbours (+ 2 mines-number-cols)))
+    (set-equalp (list (- mines-number-cells 2)
+                      (1- (* (1- mines-number-rows) mines-number-cols))
+                      (- (* (1- mines-number-rows) mines-number-cols) 2))
+                (mines-get-neighbours (1-  mines-number-cells)))))
+
+(ert-deftest mines-test-neighbours ()
+  (mines)
+  (let ((buf (get-buffer "*Mines*")))
+    (with-current-buffer buf
+      (mines-goto (1- mines-number-cols))
+      (should (eq (following-char) mines-uncover-cell-char))
+      (mines-flag-cell) ; First time flag cell.
+      (should (eq (following-char) mines-flagged-cell-char))
+      (mines-flag-cell) ; Second time unflag.
+      (should (eq (following-char) mines-uncover-cell-char))
+      (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest mines-test-goto ()
+  (mines)
+  (let ((buf (get-buffer "*Mines*")))
+    (with-current-buffer buf
+      (dolist (idx (list 0 1 (1- mines-number-cols) (1- mines-number-rows)
+                         (1- mines-number-cells)))
+        (mines-goto idx)
+        (should (= idx (mines-current-pos))))
+      (let ((idx (+ 100 mines-number-cells)))
+        (mines-goto idx) ; No error
+        (should-not (= idx (mines-current-pos))))
+      ;; Test right. left, up, down movements.
+      (dotimes (idx mines-number-cells)
+        (mines-goto idx)
+        (let* ((row (car (mines-index-2-matrix idx)))
+               (col (cadr (mines-index-2-matrix idx)))
+               (idx-right (if (= col (1- mines-number-cols))
+                              (mines-matrix-2-index row 0)
+                            (mines-matrix-2-index row (1+ col))))
+               (idx-left (if (zerop col)
+                             (mines-matrix-2-index row (1- mines-number-cols))
+                           (mines-matrix-2-index row (1- col))))
+               (idx-up (if (zerop row)
+                           (mines-matrix-2-index (1- mines-number-rows) col)
+                         (mines-matrix-2-index (1- row) col)))
+               (idx-down (if (= row (1- mines-number-rows))
+                             (mines-matrix-2-index 0 col)
+                           (mines-matrix-2-index (1+ row) col))))
+          (save-excursion ; Right
+            (mines-go-right)
+            (should (= idx-right (mines-current-pos))))
+          (save-excursion ; Left
+            (mines-go-left)
+            (should (= idx-left (mines-current-pos))))
+          (save-excursion ; Up
+            (mines-go-up)
+            (should (= idx-up (mines-current-pos))))
+          (save-excursion ; Down
+            (mines-go-down)
+            (should (= idx-down (mines-current-pos)))))))
+    (when (buffer-live-p buf) (kill-buffer buf))))
+
+;; `mines--near-bombs' is used when `mines-grid' just contains nil or t.
+(ert-deftest mines-test-near-bombs ()
+  (mines)
+  (let ((buf (get-buffer "*Mines*"))
+        (grid (make-vector mines-number-cells nil)))
+    (dolist (idx mines-mine-positions)
+      (aset grid idx t))
+    (with-current-buffer buf
+      (let ((mines-grid grid))
+        (dotimes (idx mines-number-cells)
+          (unless (aref grid idx)
+            (let ((row (car (mines-index-2-matrix idx)))
+                  (col (cadr (mines-index-2-matrix idx)))
+                  (numb 0))
+              (mines-goto idx)
+              ;; Right
+              (when (< col (1- mines-number-cols))
+                (when (aref grid (mines-matrix-2-index row (1+ col)))
+                  (cl-incf numb)))
+              ;; Left
+              (unless (zerop col)
+                (when (aref grid (mines-matrix-2-index row (1- col)))
+                  (cl-incf numb)))
+              ;; Up
+              (unless (zerop row)
+                (when (aref grid (mines-matrix-2-index (1- row) col))
+                  (cl-incf numb)))
+              ;; Up-Right
+              (when (and (not (zerop row)) (< col (1- mines-number-cols)))
+                (when (aref grid (mines-matrix-2-index (1- row) (1+ col)))
+                  (cl-incf numb)))
+              ;; Up-Left
+              (when (and (not (zerop row)) (not (zerop col)))
+                (when (aref grid (mines-matrix-2-index (1- row) (1- col)))
+                  (cl-incf numb)))
+              ;; Down
+              (unless (= row (1- mines-number-rows))
+                (when (aref grid (mines-matrix-2-index (1+ row) col))
+                  (cl-incf numb)))
+              ;; Down-Right
+              (when (and (not (= row (1- mines-number-rows))) (< col (1- 
mines-number-cols)))
+                (when (aref grid (mines-matrix-2-index (1+ row) (1+ col)))
+                  (cl-incf numb)))
+              ;; Down-Left
+              (when (and (not (= row (1- mines-number-rows))) (not (zerop 
col)))
+                (when (aref grid (mines-matrix-2-index (1+ row) (1- col)))
+                  (cl-incf numb)))
+              (should (= numb (mines--near-bombs row col))))))))
+    (when (buffer-live-p buf) (kill-buffer buf))))
+
+
+(provide 'mines-tests)
+;;; mines-tests.el ends here
+