diff options
| -rw-r--r-- | doc/lispref/ChangeLog | 36 | ||||
| -rw-r--r-- | doc/lispref/sequences.texi | 360 | ||||
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/seq.el | 269 | ||||
| -rw-r--r-- | test/ChangeLog | 4 | ||||
| -rw-r--r-- | test/automated/seq-tests.el | 196 |
6 files changed, 853 insertions, 16 deletions
diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index bc9e991bb10..a48289c3b80 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2014-12-16 Nicolas Petton <petton.nicolas@gmail.com> + + * sequences.texi (Seq Library): Add documentation for seq.el. + 2014-12-15 Alan Mackenzie <acm@muc.de> "Advice" is a mass noun. Amend text accordingly. @@ -16,21 +20,21 @@ 2014-12-09 Lars Magne Ingebrigtsen <larsi@gnus.org> - * files.texi (Contents of Directories): Document - directory-files-recursively. + * files.texi (Contents of Directories): + Document directory-files-recursively. 2014-12-04 Eli Zaretskii <eliz@gnu.org> - * display.texi (Bidirectional Display): Document - 'buffer-substring-with-bidi-context'. + * display.texi (Bidirectional Display): + Document 'buffer-substring-with-bidi-context'. - * text.texi (Buffer Contents): Mention - 'buffer-substring-with-bidi-context' with a cross-reference. + * text.texi (Buffer Contents): + Mention 'buffer-substring-with-bidi-context' with a cross-reference. 2014-12-02 Eli Zaretskii <eliz@gnu.org> - * display.texi (Bidirectional Display): Document - 'bidi-find-overridden-directionality'. + * display.texi (Bidirectional Display): + Document 'bidi-find-overridden-directionality'. 2014-11-29 Paul Eggert <eggert@cs.ucla.edu> @@ -51,7 +55,7 @@ * processes.texi (Network Security): Made into its own section and fleshed out. (Network Security): Mention more NSM variables. - (Processes): Moved the Network Security Manager stuff to the Emacs + (Processes): Move the Network Security Manager stuff to the Emacs manual. 2014-11-23 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -67,8 +71,8 @@ 2014-11-18 Leo Liu <sdl.web@gmail.com> - * functions.texi (Advising Named Functions): Document - define-advice. + * functions.texi (Advising Named Functions): + Document define-advice. 2014-11-17 Paul Eggert <eggert@cs.ucla.edu> @@ -233,8 +237,8 @@ 2014-08-29 Dmitry Antipov <dmantipov@yandex.ru> - * lists.texi (Functions that Rearrange Lists): Remove - description of sort ... + * lists.texi (Functions that Rearrange Lists): + Remove description of sort ... * sequences.texi (Sequence Functions): ... and generalize it for sequences. Add an example. @@ -382,8 +386,8 @@ 2014-05-15 Dmitry Antipov <dmantipov@yandex.ru> - * lists.texi (Building Cons Cells and Lists): Remove - description of `reverse' and `'nreverse' to generalize them... + * lists.texi (Building Cons Cells and Lists): + Remove description of `reverse' and `'nreverse' to generalize them... * sequences.texi (Sequences): ...for sequences here. 2014-05-14 Glenn Morris <rgm@gnu.org> @@ -13525,7 +13529,7 @@ 1998-01-30 Richard Stallman <rms@psilocin.gnu.org> - * Makefile (SHELL): Defined. + * Makefile (SHELL): Define. 1998-01-27 Richard Stallman <rms@psilocin.gnu.org> diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index d3a6792c1ba..8f8cfe72fa3 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -419,6 +419,366 @@ See @code{documentation} in @ref{Accessing Documentation}, for a useful example of @code{sort}. @end defun +@cindex sequence functions in seq +@cindex seq library + The @file{seq} library provides the following additional sequence +manipulation macros and functions, prefixed with @code{seq-}. To use +them, you need to load the @file{seq} library first. + + All functions defined in the @code{seq} library are free of +side-effects, meaning that sequence(s) passed as argument(s) to +functions defined in @code{seq} are not modified. + +@defun seq-drop seq n + This function returns a sequence of all but the first @var{n} +elements of the sequence @var{seq}. + +@var{seq} may be a list, vector or string and @var{n} must be an +integer. The result is the same type of sequence as @var{seq}. + +If @var{n} is a negative integer or zero, @var{seq} is returned. + +@example +@group +(seq-drop [1 2 3 4 5 6] 3) +@result{} [4 5 6] +@end group +@group +(seq-drop "hello world" -4) +@result{} "hello world" +@end group +@end example +@end defun + +@defun seq-take seq n + This function returns a sequence of the first @var{n} elements of +@var{seq}. + +@var{seq} may be a list, vector or string and @var{n} must be an +integer. The result is the same type of sequence as @var{seq}. + +If @var{n} is a negative integer or zero, an empty sequence is returned. + +@example +@group +(seq-take '(1 2 3 4) 3) +@result{} (1 2 3) +@end group +@group +(seq-take [1 2 3 4] 0) +@result{} [] +@end group +@end example +@end defun + +@defun seq-take-while pred seq + This function returns a sub-sequence of the successive elements of +@var{seq} for which calling @code{pred} with that element returns +non-nil. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. The result is the same type of sequence as +@var{seq}. + +If evaluating @var{pred} with the first element of @var{seq} as argument +returns @code{nil}, an empty sequence is returned. + +@example +@group +(seq-take-while (lambda (elt) (> elt 0)) '(1 2 3 -1 -2)) +@result{} (1 2 3) +@end group +@group +(seq-take-while (lambda (elt) (> elt 0)) [-1 4 6]) +@result{} [] +@end group +@end example +@end defun + +@defun seq-drop-while pred seq + This function returns a sub-sequence of @var{seq} from the first +element for which calling @var{pred} with that element returns +@code{nil}. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. The result is the same type of sequence as +@var{seq}. + +If evaluating @var{pred} with every element of @var{seq} returns +@code{nil}, @var{seq} is returned. + +@example +@group +(seq-drop-while (lambda (elt) (> elt 0)) '(1 2 3 -1 -2)) +@result{} (-1 -2) +@end group +@group +(seq-drop-while (lambda (elt) (< elt 0)) [1 4 6]) +@result{} [1 4 6] +@end group +@end example +@end defun + +@defun seq-filter pred seq +@cindex filtering sequences + This function returns a list of all the elements in @var{seq} for +which calling @var{pred} with that element returns non-nil. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. + +@example +@group +(seq-filter (lambda (elt) (> elt 0)) [1 -1 3 -3 5]) +@result{} (1 3 5) +@end group +@group +(seq-filter (lambda (elt) (> elt 0)) '(-1 -3 -5)) +@result{} nil +@end group +@end example +@end defun + +@defun seq-remove pred seq +@cindex removing from sequences + This function returns a list of all the elements in @var{seq} for +which calling @var{pred} with that element returns @code{nil}. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. + +@example +@group +(seq-remove (lambda (elt) (> elt 0)) [1 -1 3 -3 5]) +@result{} (-1 -3) +@end group +@group +(seq-remove (lambda (elt) (< elt 0)) '(-1 -3 -5)) +@result{} nil +@end group +@end example +@end defun + +@defun seq-reduce function seq initial-value +@cindex reducing sequences + This function returns the result of calling @var{function} with +@var{initial-value} and the first element of @var{seq}, then calling +@var{function} with that result and the second element of @var{seq}, +then with that result and the third element of @var{seq}, etc. + +@var{function} must be a two-arguments function and @var{seq} may be a +list, vector or string. + +If @var{seq} is empty, @var{initial-value} is returned and +@var{function} is not called. + +@example +@group +(seq-reduce #'+ [1 2 3 4] 0) +@result{} 10 +@end group +@group +(seq-reduce #'+ '(1 2 3 4) 5) +@result{} 15 +@end group +@group +(seq-reduce #'+ '() 3) +@result{} 3 +@end group +@end example +@end defun + +@defun seq-some-p pred seq + This function returns any element in @var{seq} for which calling +@var{pred} with that element returns non-nil. If successively calling +@var{pred} with each element of @var{seq} always returns @code{nil}, +@code{nil} is returned. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. + +@example +@group +(seq-some-p #'numberp ["abc" 1 nil]) +@result{} 1 +@end group +@group +(seq-some-p #'numberp ["abc" "def"]) +@result{} nil +@end group +@end example +@end defun + +@defun seq-every-p pred seq + This function returns non-nil if successively calling @var{pred} with +each element of @var{seq} always returns non-nil, @code{nil} otherwise. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. + +@example +@group +(seq-every-p #'numberp [2 4 6]) +@result{} t +@end group +@group +(seq-some-p #'numberp [2 4 "6"]) +@result{} nil +@end group +@end example +@end defun + +@defun seq-empty-p seq + This function returns non-nil if the sequence @var{seq} is empty, +@code{nil} otherwise. + +@var{seq} may be a list, vector or string. + +@example +@group +(seq-empty-p "not empty") +@result{} nil +@end group +@group +(seq-empty-p "") +@result{} t +@end group +@end example +@end defun + +@defun seq-count pred seq + This function returns the number of elements in @var{seq} for which +calling @var{pred} with that element returns non-nil. + +@var{pred} must be a one-argument function and @var{seq} may be a +list, vector or string. + +@example +(seq-count (lambda (elt) (> elt 0)) [-1 2 0 3 -2]) +@result{} 2 +@end example +@end defun + +@defun seq-sort pred seq + This function returns a sorted sequence of the elements of +@var{seq}, comparing its elements with @var{pred}. Called with two +elements of @var{seq}, @var{pred} should return non-nil if the first +element should sort before the second. + +@var{pred} must be a two-arguments function, @var{seq} may be a list, +vector or string. + +The result is a sequence of the same type as SEQ. +@cindex sorting sequences +@end defun + +@defun seq-contains-p seq elt testfn + This function returns the first element in @var{seq} that equals to +@var{elt}. + +Equality is defined by @var{testfn} if non-nil or by @code{equal} if +@code{nil}. + +@var{seq} may be a list, vector or string. + +@example +@group +(seq-contains-p '(symbol1 symbol2) 'symbol1) +@result{} symbol1 +@end group +@group +(seq-contains-p '(symbol1 symbol2) 'symbol3) +@result{} nil +@end group +@end example + +@end defun + +@defun seq-uniq seq testfn + This function returns a list of the elements of @var{seq} with +duplicates removed. @var{testfn} is used to compare elements, or +@code{equal} if @var{testfn} is @code{nil}. + +@var{testfn} must be a two-argument function or @code{nil} and +@var{seq} may be a list, vector or string. + +@example +@group +(seq-uniq '(1 2 2 1 3)) +@result{} (1 2 3) +@end group +@group +(seq-uniq '(1 2 2.0 1.0) #'=) +@result{} [3 4] +@end group +@end example +@end defun + +@defun seq-subseq seq start &optional end + This function returns a sub-sequence of @var{seq} from @var{start} +to @var{end}. If @var{end} is omitted, it default to the length of +@var{seq}. If @var{start} or @var{end} is negative, it counts from +the end of @var{seq}. + +@var{seq} may be a list, vector or string. +The result is the same type of sequence as @var{seq}. + +@example +@group +(seq-subseq '(1 2 3 4 5) 1) +@result{} (2 3 4 5) +@end group +@group +(seq-subseq '[1 2 3 4 5] 1 3) +@result{} [2 3] +@end group +@group +(seq-subseq '[1 2 3 4 5] -3 -1) +@result{} [3 4] +@end group +@end example +@end defun + +@defun seq-concatenate type &rest seqs + This function returns a sequence made of the concatenation of +@var{seqs}. The result is a sequence of type @var{type}. @var{type} +may be one of the following symbols: @code{vector}, @code{list} or +@code{string}. + +@example +@group +(seq-concatenate 'list '(1 2) '(3 4) [5 6]) +@result{} (1 2 3 5 6) +@end group +@group +(seq-concatenate 'string "Hello " "world") +@result{} "Hello world" +@end group +@end example +@end defun + +@defmac seq-doseq (var seq [result]) body@dots{} +@cindex sequence iteration +This macro is like @code{dolist}, except that @var{seq} can be a list, +vector or string (@pxref{Iteration} for more information about the +@code{dolist} macro). + +@var{seq-doseq} is primarily useful for side-effects. + +@example +(seq-doseq (elt [1 2 3]) + (print (* 2 elt))) + @print{} + @print{} 2 + @print{} + @print{} 4 + @print{} + @print{} 6 + @result{} nil + +@end example +@end defmac + @node Arrays @section Arrays @cindex array diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e7a44e8e59c..f28dd6d449f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2014-12-16 Nicolas Petton <petton.nicolas@gmail.com> + + * emacs-lisp/seq.el: New file. + 2014-12-16 Stefan Monnier <monnier@iro.umontreal.ca> * jit-lock.el (jit-lock-function): Don't defer if jit-lock-defer-time diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el new file mode 100644 index 00000000000..01a3bd3fc50 --- /dev/null +++ b/lisp/emacs-lisp/seq.el @@ -0,0 +1,269 @@ +;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Nicolas Petton <petton.nicolas@gmail.com> +;; Keywords: sequences +;; Version: 1.0 + +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; Sequence-manipulation functions that complement basic functions +;; provided by subr.el. +;; +;; All functions are prefixed with "seq-". +;; +;; All provided functions work on lists, strings and vectors. +;; +;; Functions taking a predicate or a function iterating over the +;; sequence as argument take the function as their first argument and +;; the sequence as their second argument. All other functions take +;; the sequence as their first argument. +;; +;; All functions are tested in test/automated/seq-tests.el + +;;; Code: + +(defmacro seq-doseq (spec &rest body) + "Loop over a sequence. +Similar to `dolist' but can be applied lists, strings and vectors. + +Evaluate BODY with VAR bound to each element of SEQ, in turn. +Then evaluate RESULT to get return value, default nil. + +\(fn (VAR SEQ [RESULT]) BODY...)" + (declare (indent 1) (debug ((symbolp form &optional form) body))) + (let ((is-list (make-symbol "is-list")) + (seq (make-symbol "seq")) + (index (make-symbol "index"))) + `(let* ((,seq ,(cadr spec)) + (,is-list (listp ,seq)) + (,index (if ,is-list ,seq 0))) + (while (if ,is-list + (consp ,index) + (< ,index (seq-length ,seq))) + (let ((,(car spec) (if ,is-list + (car ,index) + (seq-elt ,seq ,index)))) + ,@body + (setq ,index (if ,is-list + (cdr ,index) + (+ ,index 1))))) + ,@(if (cddr spec) + `((setq ,(car spec) nil) ,@(cddr spec)))))) + +(defun seq-drop (seq n) + "Return a subsequence of SEQ without its first N elements. +The result is a sequence of the same type as SEQ. + +If N is a negative integer or zero, SEQ is returned." + (if (<= n 0) + seq + (if (listp seq) + (seq--drop-list seq n) + (let ((length (seq-length seq))) + (seq-subseq seq (min n length) length))))) + +(defun seq-take (seq n) + "Return a subsequence of SEQ with its first N elements. +The result is a sequence of the same type as SEQ. + +If N is a negative integer or zero, an empty sequence is +returned." + (if (listp seq) + (seq--take-list seq n) + (seq-subseq seq 0 (min (max n 0) (seq-length seq))))) + +(defun seq-drop-while (pred seq) + "Return a sequence, from the first element for which (PRED element) is nil, of SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (seq--drop-while-list pred seq) + (seq-drop seq (seq--count-successive pred seq)))) + +(defun seq-take-while (pred seq) + "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (seq--take-while-list pred seq) + (seq-take seq (seq--count-successive pred seq)))) + +(defun seq-filter (pred seq) + "Return a list of all the elements for which (PRED element) is non-nil in SEQ." + (let ((exclude (make-symbol "exclude"))) + (delq exclude (seq-map (lambda (elt) + (if (funcall pred elt) + elt + exclude)) + seq)))) + +(defun seq-remove (pred seq) + "Return a list of all the elements for which (PRED element) is nil in SEQ." + (seq-filter (lambda (elt) (not (funcall pred elt))) + seq)) + +(defun seq-reduce (function seq initial-value) + "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE. + +Return the result of calling FUNCTION with INITIAL-VALUE and the +first element of SEQ, then calling FUNCTION with that result and +the second element of SEQ, then with that result and the third +element of SEQ, etc. + +If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." + (if (seq-empty-p seq) + initial-value + (let ((acc initial-value)) + (seq-doseq (elt seq) + (setq acc (funcall function acc elt))) + acc))) + +(defun seq-some-p (pred seq) + "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise." + (catch 'seq--break + (seq-doseq (elt seq) + (when (funcall pred elt) + (throw 'seq--break elt))) + nil)) + +(defun seq-every-p (pred seq) + "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ." + (catch 'seq--break + (seq-doseq (elt seq) + (or (funcall pred elt) + (throw 'seq--break nil))) + t)) + +(defun seq-count (pred seq) + "Return the number of elements for which (PRED element) returns non-nil in seq." + (let ((count 0)) + (seq-doseq (elt seq) + (when (funcall pred elt) + (setq count (+ 1 count)))) + count)) + +(defun seq-empty-p (seq) + "Return non-nil if the sequence SEQ is empty, nil otherwise." + (if (listp seq) + (null seq) + (= 0 (seq-length seq)))) + +(defun seq-sort (pred seq) + "Return a sorted sequence comparing using PRED the elements of SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (sort (seq-copy seq) pred) + (let ((result (seq-sort pred (append seq nil)))) + (cond ((stringp seq) (concat result)) + ((vectorp seq) (vconcat result)) + (t (error "Unsupported sequence: %s" seq)))))) + +(defun seq-contains-p (seq elt &optional testfn) + "Return the first element in SEQ that equals to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-some-p (lambda (e) + (funcall (or testfn #'equal) elt e)) + seq)) + +(defun seq-uniq (seq &optional testfn) + "Return a list of the elements of SEQ with duplicates removed. +TESTFN is used to compare elements, or `equal' if TESTFN is nil." + (let ((result '())) + (seq-doseq (elt seq) + (unless (seq-contains-p result elt testfn) + (setq result (cons elt result)))) + (nreverse result))) + +(defun seq-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) + ((listp seq) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (push (pop seq) res)) + (nreverse res)) + (seq-copy seq)))) + (t (error "Unsupported sequence: %s" seq)))) + +(defun seq-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the sequences SEQS. +TYPE must be one of following symbols: vector, string or list. + +\n(fn TYPE SEQUENCE...)" + (pcase type + (`vector (apply #'vconcat seqs)) + (`string (apply #'concat seqs)) + (`list (apply #'append (append seqs '(nil)))) + (t (error "Not a sequence type name: %s" type)))) + +(defun seq--drop-list (list n) + "Optimized version of `seq-drop' for lists." + (while (and list (> n 0)) + (setq list (cdr list) + n (1- n))) + list) + +(defun seq--take-list (list n) + "Optimized version of `seq-take' for lists." + (let ((result '())) + (while (and list (> n 0)) + (setq n (1- n)) + (push (pop list) result)) + (nreverse result))) + +(defun seq--drop-while-list (pred list) + "Optimized version of `seq-drop-while' for lists." + (while (and list (funcall pred (car list))) + (setq list (cdr list))) + list) + +(defun seq--take-while-list (pred list) + "Optimized version of `seq-take-while' for lists." + (let ((result '())) + (while (and list (funcall pred (car list))) + (push (pop list) result)) + (nreverse result))) + +(defun seq--count-successive (pred seq) + "Return the number of successive elements for which (PRED element) is non-nil in SEQ." + (let ((n 0) + (len (seq-length seq))) + (while (and (< n len) + (funcall pred (seq-elt seq n))) + (setq n (+ 1 n))) + n)) + +(defalias 'seq-copy #'copy-sequence) +(defalias 'seq-elt #'elt) +(defalias 'seq-reverse #'reverse) +(defalias 'seq-length #'length) +(defalias 'seq-do #'mapc) +(defalias 'seq-each #'seq-do) +(defalias 'seq-map #'mapcar) + +(provide 'seq) +;;; seq.el ends here diff --git a/test/ChangeLog b/test/ChangeLog index 78a03d1b335..86703d569f4 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2014-12-16 Nicolas Petton <petton.nicolas@gmail.com> + + * automated/seq-tests.el: New file. + 2014-12-16 Glenn Morris <rgm@gnu.org> * automated/data/flymake/Makefile (check-syntax): diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el new file mode 100644 index 00000000000..a46438e53eb --- /dev/null +++ b/test/automated/seq-tests.el @@ -0,0 +1,196 @@ +;;; seq-tests.el --- Tests for sequences.el + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Nicolas Petton <petton.nicolas@gmail.com> +;; Maintainer: emacs-devel@gnu.org + +;; 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 'seq) + +(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 '()))) + +(defun test-sequences-evenp (integer) + "Return t if INTEGER is even." + (eq (logand integer 1) 0)) + +(defun test-sequences-oddp (integer) + "Return t if INTEGER is odd." + (not (test-sequences-evenp integer))) + +(ert-deftest test-seq-drop () + (with-test-sequences (seq '(1 2 3 4)) + (should (equal (seq-drop seq 0) seq)) + (should (equal (seq-drop seq 1) (seq-subseq seq 1))) + (should (equal (seq-drop seq 2) (seq-subseq seq 2))) + (should (seq-empty-p (seq-drop seq 4))) + (should (seq-empty-p (seq-drop seq 10)))) + (with-test-sequences (seq '()) + (should (seq-empty-p (seq-drop seq 0))) + (should (seq-empty-p (seq-drop seq 1))))) + +(ert-deftest test-seq-take () + (with-test-sequences (seq '(2 3 4 5)) + (should (seq-empty-p (seq-take seq 0))) + (should (= (seq-length (seq-take seq 1)) 1)) + (should (= (seq-elt (seq-take seq 1) 0) 2)) + (should (same-contents-p (seq-take seq 3) '(2 3 4))) + (should (equal (seq-take seq 10) seq)))) + +(ert-deftest test-seq-drop-while () + (with-test-sequences (seq '(1 3 2 4)) + (should (equal (seq-drop-while #'test-sequences-oddp seq) + (seq-drop seq 2))) + (should (equal (seq-drop-while #'test-sequences-evenp seq) + seq)) + (should (seq-empty-p (seq-drop-while #'numberp seq)))) + (with-test-sequences (seq '()) + (should (seq-empty-p (seq-drop-while #'test-sequences-oddp seq))))) + +(ert-deftest test-seq-take-while () + (with-test-sequences (seq '(1 3 2 4)) + (should (equal (seq-take-while #'test-sequences-oddp seq) + (seq-take seq 2))) + (should (seq-empty-p (seq-take-while #'test-sequences-evenp seq))) + (should (equal (seq-take-while #'numberp seq) seq))) + (with-test-sequences (seq '()) + (should (seq-empty-p (seq-take-while #'test-sequences-oddp seq))))) + +(ert-deftest test-seq-filter () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10))) + (should (equal (seq-filter #'test-sequences-oddp seq) '(7 9))) + (should (equal (seq-filter (lambda (elt) nil) seq) '()))) + (with-test-sequences (seq '()) + (should (equal (seq-filter #'test-sequences-evenp seq) '())))) + +(ert-deftest test-seq-remove () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-remove #'test-sequences-evenp seq) '(7 9))) + (should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10))) + (should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq))) + (with-test-sequences (seq '()) + (should (equal (seq-remove #'test-sequences-evenp seq) '())))) + +(ert-deftest test-seq-count () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-count #'test-sequences-evenp seq) 3)) + (should (equal (seq-count #'test-sequences-oddp seq) 2)) + (should (equal (seq-count (lambda (elt) nil) seq) 0))) + (with-test-sequences (seq '()) + (should (equal (seq-count #'test-sequences-evenp seq) 0)))) + +(ert-deftest test-seq-reduce () + (with-test-sequences (seq '(1 2 3 4)) + (should (= (seq-reduce #'+ seq 0) 10)) + (should (= (seq-reduce #'+ seq 5) 15))) + (with-test-sequences (seq '()) + (should (eq (seq-reduce #'+ seq 0) 0)) + (should (eq (seq-reduce #'+ seq 7) 7)))) + +(ert-deftest test-seq-some-p () + (with-test-sequences (seq '(4 3 2 1)) + (should (= (seq-some-p #'test-sequences-evenp seq) 4)) + (should (= (seq-some-p #'test-sequences-oddp seq) 3)) + (should-not (seq-some-p (lambda (elt) (> elt 10)) seq))) + (with-test-sequences (seq '()) + (should-not (seq-some-p #'test-sequences-oddp seq)))) + +(ert-deftest test-seq-contains-p () + (with-test-sequences (seq '(3 4 5 6)) + (should (seq-contains-p seq 3)) + (should-not (seq-contains-p seq 7))) + (with-test-sequences (seq '()) + (should-not (seq-contains-p seq 3)) + (should-not (seq-contains-p seq nil)))) + +(ert-deftest test-seq-every-p () + (with-test-sequences (seq '(43 54 22 1)) + (should (seq-every-p (lambda (elt) t) seq)) + (should-not (seq-every-p #'test-sequences-oddp seq)) + (should-not (seq-every-p #'test-sequences-evenp seq))) + (with-test-sequences (seq '(42 54 22 2)) + (should (seq-every-p #'test-sequences-evenp seq)) + (should-not (seq-every-p #'test-sequences-oddp seq))) + (with-test-sequences (seq '()) + (should (seq-every-p #'identity seq)) + (should (seq-every-p #'test-sequences-evenp seq)))) + +(ert-deftest test-seq-empty-p () + (with-test-sequences (seq '(0)) + (should-not (seq-empty-p seq))) + (with-test-sequences (seq '(0 1 2)) + (should-not (seq-empty-p seq))) + (with-test-sequences (seq '()) + (should (seq-empty-p seq)))) + +(ert-deftest test-seq-sort () + (should (equal (seq-sort #'< "cbaf") "abcf")) + (should (equal (seq-sort #'< '(2 1 9 4)) '(1 2 4 9))) + (should (equal (seq-sort #'< [2 1 9 4]) [1 2 4 9])) + (should (equal (seq-sort #'< "") ""))) + +(ert-deftest test-seq-uniq () + (with-test-sequences (seq '(2 4 6 8 6 4 3)) + (should (equal (seq-uniq seq) '(2 4 6 8 3)))) + (with-test-sequences (seq '(3 3 3 3 3)) + (should (equal (seq-uniq seq) '(3)))) + (with-test-sequences (seq '()) + (should (equal (seq-uniq seq) '())))) + +(ert-deftest test-seq-subseq () + (with-test-sequences (seq '(2 3 4 5)) + (should (equal (seq-subseq seq 0 4) seq)) + (should (same-contents-p (seq-subseq seq 2 4) '(4 5))) + (should (same-contents-p (seq-subseq seq 1 3) '(3 4))) + (should (same-contents-p (seq-subseq seq 1 -1) '(3 4)))) + (should (vectorp (seq-subseq [2 3 4 5] 2))) + (should (stringp (seq-subseq "foo" 2 3))) + (should (listp (seq-subseq '(2 3 4 4) 2 3)))) + +(ert-deftest test-seq-concatenate () + (with-test-sequences (seq '(2 4 6)) + (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8))) + (should (equal (seq-concatenate 'list seq '(8 10)) '(2 4 6 8 10))) + (should (equal (seq-concatenate 'vector seq '(8 10)) [2 4 6 8 10])) + (should (equal (seq-concatenate 'vector nil '(8 10)) [8 10])) + (should (equal (seq-concatenate 'vector seq nil) [2 4 6])))) + +(provide 'seq-tests) +;;; seq-tests.el ends here |