;;; sequences-tests.el --- Tests for sequences.el

;; Copyright (C) 2014 Free Software Foundation, Inc.

;; Author: Nicolas Petton <address@hidden>
;; Maintainer: address@hidden

;; 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:

;; Tests for sequences.el

;;; Code:

(require 'ert)
(require 'sequences)

(defmacro with-test-sequences (spec &rest body)
  "Successively bind VAR to a list, vector, and string built from SEQ.
Evaluate BODY for each created sequence.

\(fn (var seq) body)"
  (declare (indent 1) (debug ((symbolp form) body)))
  (let ((initial-seq (make-symbol "initial-seq")))
    `(let ((,initial-seq ,(cadr spec))) 
       ,@(mapcar (lambda (s)
                   `(let ((,(car spec) (apply (function ,s) ,initial-seq)))
                      ,@body))
                 '(list vector string)))))

(defun same-contents-p (seq1 seq2)
  "Return t if SEQ1 and SEQ2 have the same contents, nil otherwise."
  (equal (append seq1 '()) (append seq2 '())))

(ert-deftest test-sequences-first ()
  (with-test-sequences (seq '(2 4 6))
    (should (= (first seq) 2)))
  (with-test-sequences (seq '())
    (should (eq (first seq) nil))))

(ert-deftest test-sequences-rest ()
  (with-test-sequences (seq '(2 4 6))
    (should (same-contents-p (rest seq) '(4 6))))
  (with-test-sequences (seq '())
    (should (eq (rest seq) nil))))

(ert-deftest test-sequences-drop ()
  (with-test-sequences (seq '(1 2 3 4))
    (should (equal (drop 0 seq) seq))
    (should (equal (drop 1 seq) (rest seq)))
    (should (equal (drop 2 seq) (rest (rest seq))))
    (should (empty-p (drop 4 seq)))
    (should (empty-p (drop 10 seq))))
  (with-test-sequences (seq '())
    (should (empty-p (drop 0 seq)))
    (should (empty-p (drop 1 seq)))))

(ert-deftest test-sequences-take ()
  (with-test-sequences (seq '(2 3 4 5))
    (should (empty-p (take 0 seq)))
    (should (= (length (take 1 seq)) 1))
    (should (= (first (take 1 seq)) 2))
    (should (same-contents-p (take 3 seq) '(2 3 4)))
    (should (equal (take 10 seq) seq))))

(ert-deftest test-sequences-filter ()
  (with-test-sequences (seq '(6 7 8 9 10))
    (should (equal (filter #'evenp seq) '(6 8 10)))
    (should (equal (filter #'oddp seq) '(7 9)))
    (should (equal (filter (lambda (elt) nil) seq) '())))
  (with-test-sequences (seq '())
    (should (equal (filter #'evenp seq) '()))))

(ert-deftest test-sequences-reduce ()
  (with-test-sequences (seq '(1 2 3 4))
    (should (= (reduce #'+ seq) 10))
    (should (= (reduce #'+ seq 5) 15)))
  (with-test-sequences (seq '())
    (should (eq (reduce #'+ seq) 0))
    (should (eq (reduce #'+ seq 7) 7))))

(ert-deftest test-sequences-some-p ()
  (with-test-sequences (seq '(4 3 2 1))
    (should (= (some-p #'evenp seq) 4))
    (should (= (some-p #'oddp seq) 3))
    (should-not (some-p (lambda (elt) (> elt 10)) seq)))
  (with-test-sequences (seq '())
    (should-not (some-p #'oddp seq))))

(ert-deftest test-sequences-every-p ()
  (with-test-sequences (seq '(43 54 22 1))
    (should (every-p (lambda (elt) t) seq))
    (should-not (every-p #'oddp seq))
    (should-not (every-p #'evenp seq)))
  (with-test-sequences (seq '(42 54 22 2))
    (should (every-p #'evenp seq))
    (should-not (every-p #'oddp seq)))
  (with-test-sequences (seq '())
    (should (every-p #'identity seq))
    (should (every-p #'evenp seq))))

(ert-deftest test-sequences-empty-p ()
  (with-test-sequences (seq '(0))
    (should-not (empty-p seq)))
  (with-test-sequences (seq '(0 1 2))
    (should-not (empty-p seq)))
  (with-test-sequences (seq '())
    (should (empty-p seq))))

(ert-deftest test-sequences-sort-seq ()
  (with-test-sequences (seq '(89 32 12 3 5 1 1))
    (should (equal (sort-seq seq #'<) '(1 1 3 5 12 32 89))))
  (with-test-sequences (seq '())
    (should (equal (sort-seq seq #'<) '()))))

(ert-deftest test-sequences-subseq ()
  (with-test-sequences (seq '(2 3 4 5))
    (should (equal (subseq seq 0 4) seq))
    (should (equal (subseq seq 2 4) (rest (rest seq))))
    (should (same-contents-p (subseq seq 1 3) '(3 4)))
    (should (same-contents-p (subseq seq 1 -1) '(3 4))))
  (should (vectorp (subseq [2 3 4 5] 2)))
  (should (stringp (subseq "foo" 2 3)))
  (should (listp (subseq '(2 3 4 4) 2 3))))

(ert-deftest test-sequences-concatenate ()
  (with-test-sequences (seq '(2 4 6))
    (should (equal (concatenate 'string seq [8]) (string 2 4 6 8)))
    (should (equal (concatenate 'list seq '(8 10)) '(2 4 6 8 10)))
    (should (equal (concatenate 'vector seq '(8 10)) [2 4 6 8 10]))
    (should (equal (concatenate 'vector nil '(8 10)) [8 10]))
    (should (equal (concatenate 'vector seq nil) [2 4 6]))))

(provide 'sequences-tests)
;;; sequences-tests.el ends here