New if-let, when-let, thread-first and thread-last macros.
* lisp/emacs-lisp/subr-x.el (internal--listify, internal--check-binding) (internal--build-binding-value-form, internal--build-binding) (internal--build-bindings): New functions. (internal--thread-argument, thread-first, thread-last) (if-let, when-let): New macros. * test/automated/subr-x-tests.el (subr-x-test-if-let-single-binding-expansion) (subr-x-test-if-let-single-symbol-expansion) (subr-x-test-if-let-nil-related-expansion) (subr-x-test-if-let-malformed-binding, subr-x-test-if-let-true) (subr-x-test-if-let-false, subr-x-test-if-let-bound-references) (subr-x-test-if-let-and-lazyness-is-preserved) (subr-x-test-when-let-body-expansion) (subr-x-test-when-let-single-binding-expansion) (subr-x-test-when-let-single-symbol-expansion) (subr-x-test-when-let-nil-related-expansion) (subr-x-test-when-let-malformed-binding) (subr-x-test-when-let-true, subr-x-test-when-let-false) (subr-x-test-when-let-bound-references) (subr-x-test-when-let-and-lazyness-is-preserved) (subr-x-test-thread-first-no-forms) (subr-x-test-thread-first-function-names-are-threaded) (subr-x-test-thread-first-expansion) (subr-x-test-thread-last-no-forms) (subr-x-test-thread-last-function-names-are-threaded) (subr-x-test-thread-last-expansion): New tests.
This commit is contained in:
Fabián Ezequiel Gallina
8
etc/NEWS
8
etc/NEWS
@@ -178,6 +178,14 @@ permissions set to temporary values (e.g., for creating private files).
|
||||
** Functions `rmail-delete-forward' and `rmail-delete-backward' take an
|
||||
optional repeat-count argument.
|
||||
|
||||
---
|
||||
** New macros `if-let' and `when-let' allow defining bindings and to
|
||||
execute code depending whether all values are a true.
|
||||
|
||||
---
|
||||
** New macros `thread-first' and `thread-last' allow threading a form
|
||||
as the first or last argument of subsequent forms.
|
||||
|
||||
|
||||
* Changes in Emacs 24.5 on Non-Free Operating Systems
|
||||
|
||||
|
||||
@@ -1,3 +1,14 @@
|
||||
2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
|
||||
|
||||
New if-let, when-let, thread-first and thread-last macros.
|
||||
|
||||
* emacs-lisp/subr-x.el
|
||||
(internal--listify, internal--check-binding)
|
||||
(internal--build-binding-value-form, internal--build-binding)
|
||||
(internal--build-bindings): New functions.
|
||||
(internal--thread-argument, thread-first, thread-last)
|
||||
(if-let, when-let): New macros.
|
||||
|
||||
2014-06-30 Grégoire Jadi <daimrod@gmail.com>
|
||||
|
||||
* net/rcirc.el (rcirc-buffer-process): Restore previous
|
||||
|
||||
@@ -32,6 +32,113 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'pcase)
|
||||
|
||||
|
||||
(defmacro internal--thread-argument (first? &rest forms)
|
||||
"Internal implementation for `thread-first' and `thread-last'.
|
||||
When Argument FIRST? is non-nil argument is threaded first, else
|
||||
last. FORMS are the expressions to be threaded."
|
||||
(pcase forms
|
||||
(`(,x (,f . ,args) . ,rest)
|
||||
`(internal--thread-argument
|
||||
,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
|
||||
(`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
|
||||
(_ (car forms))))
|
||||
|
||||
(defmacro thread-first (&rest forms)
|
||||
"Thread FORMS elements as the first argument of their succesor.
|
||||
Example:
|
||||
(thread-first
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40))
|
||||
Is equivalent to:
|
||||
(+ (- (/ (+ 5 20) 25)) 40)
|
||||
Note how the single `-' got converted into a list before
|
||||
threading."
|
||||
(declare (indent 1)
|
||||
(debug (form &rest [&or symbolp (sexp &rest form)])))
|
||||
`(internal--thread-argument t ,@forms))
|
||||
|
||||
(defmacro thread-last (&rest forms)
|
||||
"Thread FORMS elements as the last argument of their succesor.
|
||||
Example:
|
||||
(thread-last
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40))
|
||||
Is equivalent to:
|
||||
(+ 40 (- (/ 25 (+ 20 5))))
|
||||
Note how the single `-' got converted into a list before
|
||||
threading."
|
||||
(declare (indent 1) (debug thread-first))
|
||||
`(internal--thread-argument nil ,@forms))
|
||||
|
||||
(defsubst internal--listify (elt)
|
||||
"Wrap ELT in a list if it is not one."
|
||||
(if (not (listp elt))
|
||||
(list elt)
|
||||
elt))
|
||||
|
||||
(defsubst internal--check-binding (binding)
|
||||
"Check BINDING is properly formed."
|
||||
(when (> (length binding) 2)
|
||||
(signal
|
||||
'error
|
||||
(cons "`let' bindings can have only one value-form" binding)))
|
||||
binding)
|
||||
|
||||
(defsubst internal--build-binding-value-form (binding prev-var)
|
||||
"Build the conditional value form for BINDING using PREV-VAR."
|
||||
`(,(car binding) (and ,prev-var ,(cadr binding))))
|
||||
|
||||
(defun internal--build-binding (binding prev-var)
|
||||
"Check and build a single BINDING with PREV-VAR."
|
||||
(thread-first
|
||||
binding
|
||||
internal--listify
|
||||
internal--check-binding
|
||||
(internal--build-binding-value-form prev-var)))
|
||||
|
||||
(defun internal--build-bindings (bindings)
|
||||
"Check and build conditional value forms for BINDINGS."
|
||||
(let ((prev-var t))
|
||||
(mapcar (lambda (binding)
|
||||
(let ((binding (internal--build-binding binding prev-var)))
|
||||
(setq prev-var (car binding))
|
||||
binding))
|
||||
bindings)))
|
||||
|
||||
(defmacro if-let (bindings then &rest else)
|
||||
"Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
|
||||
Argument BINDINGS is a list of tuples whose car is a symbol to be
|
||||
bound and (optionally) used in THEN, and its cadr is a sexp to be
|
||||
evaled to set symbol's value. In the special case you only want
|
||||
to bind a single value, BINDINGS can just be a plain tuple."
|
||||
(declare (indent 2) (debug ((&rest (symbolp form)) form body)))
|
||||
(when (and (<= (length bindings) 2)
|
||||
(not (listp (car bindings))))
|
||||
;; Adjust the single binding case
|
||||
(setq bindings (list bindings)))
|
||||
`(let* ,(internal--build-bindings bindings)
|
||||
(if ,(car (internal--listify (car (last bindings))))
|
||||
,then
|
||||
,@else)))
|
||||
|
||||
(defmacro when-let (bindings &rest body)
|
||||
"Process BINDINGS and if all values are non-nil eval BODY.
|
||||
Argument BINDINGS is a list of tuples whose car is a symbol to be
|
||||
bound and (optionally) used in BODY, and its cadr is a sexp to be
|
||||
evaled to set symbol's value. In the special case you only want
|
||||
to bind a single value, BINDINGS can just be a plain tuple."
|
||||
(declare (indent 1) (debug if-let))
|
||||
(list 'if-let bindings (macroexp-progn body)))
|
||||
|
||||
(defsubst hash-table-keys (hash-table)
|
||||
"Return a list of keys in HASH-TABLE."
|
||||
(let ((keys '()))
|
||||
|
||||
@@ -1,3 +1,27 @@
|
||||
2014-06-30 Fabián Ezequiel Gallina <fgallina@gnu.org>
|
||||
|
||||
* automated/subr-x-tests.el
|
||||
(subr-x-test-if-let-single-binding-expansion)
|
||||
(subr-x-test-if-let-single-symbol-expansion)
|
||||
(subr-x-test-if-let-nil-related-expansion)
|
||||
(subr-x-test-if-let-malformed-binding, subr-x-test-if-let-true)
|
||||
(subr-x-test-if-let-false, subr-x-test-if-let-bound-references)
|
||||
(subr-x-test-if-let-and-lazyness-is-preserved)
|
||||
(subr-x-test-when-let-body-expansion)
|
||||
(subr-x-test-when-let-single-binding-expansion)
|
||||
(subr-x-test-when-let-single-symbol-expansion)
|
||||
(subr-x-test-when-let-nil-related-expansion)
|
||||
(subr-x-test-when-let-malformed-binding)
|
||||
(subr-x-test-when-let-true, subr-x-test-when-let-false)
|
||||
(subr-x-test-when-let-bound-references)
|
||||
(subr-x-test-when-let-and-lazyness-is-preserved)
|
||||
(subr-x-test-thread-first-no-forms)
|
||||
(subr-x-test-thread-first-function-names-are-threaded)
|
||||
(subr-x-test-thread-first-expansion)
|
||||
(subr-x-test-thread-last-no-forms)
|
||||
(subr-x-test-thread-last-function-names-are-threaded)
|
||||
(subr-x-test-thread-last-expansion): New tests.
|
||||
|
||||
2014-06-29 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* automated/tramp-tests.el (tramp--instrument-test-case):
|
||||
|
||||
526
test/automated/subr-x-tests.el
Normal file
526
test/automated/subr-x-tests.el
Normal file
@@ -0,0 +1,526 @@
|
||||
;;; subr-x-tests.el --- Testing the extended lisp routines
|
||||
|
||||
;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Fabián E. Gallina <fgallina@gnu.org>
|
||||
;; Keywords:
|
||||
|
||||
;; This program 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.
|
||||
|
||||
;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'subr-x)
|
||||
|
||||
|
||||
;; if-let tests
|
||||
|
||||
(ert-deftest subr-x-test-if-let-single-binding-expansion ()
|
||||
"Test single bindings are expanded properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a 1)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1)))
|
||||
(if a
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil)))
|
||||
(if a
|
||||
(- a)
|
||||
"no")))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-single-symbol-expansion ()
|
||||
"Test single symbol bindings are expanded properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil)))
|
||||
(if a
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a b c)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a nil))
|
||||
(c (and b nil)))
|
||||
(if c
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (a (b 2) c)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a 2))
|
||||
(c (and b nil)))
|
||||
(if c
|
||||
(- a)
|
||||
"no")))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-nil-related-expansion ()
|
||||
"Test nil is processed properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let (nil)
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((nil))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((a 1) (nil) (b 2))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a)
|
||||
"no"))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(if-let ((a 1) nil (b 2))
|
||||
(- a)
|
||||
"no"))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a)
|
||||
"no")))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-malformed-binding ()
|
||||
"Test malformed bindings trigger errors."
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1 1) (b 2) (c 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1) (b 2 2) (c 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let (_ (a 1) (b 2) (c 3 3) d)
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(if-let ((a 1 1))
|
||||
(- a)
|
||||
"no"))
|
||||
:type 'error))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-true ()
|
||||
"Test `if-let' with truthy bindings."
|
||||
(should (equal
|
||||
(if-let (a 1)
|
||||
a
|
||||
"no")
|
||||
1))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
(list 1 2 3))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-false ()
|
||||
"Test `if-let' with falsey bindings."
|
||||
(should (equal
|
||||
(if-let (a nil)
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a nil) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b nil) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
"no"))
|
||||
(should (equal
|
||||
(if-let ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"no")
|
||||
"no")))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-bound-references ()
|
||||
"Test `if-let' bindings can refer to already bound symbols."
|
||||
(should (equal
|
||||
(if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
|
||||
(list a b c)
|
||||
"no")
|
||||
(list 1 2 3))))
|
||||
|
||||
(ert-deftest subr-x-test-if-let-and-lazyness-is-preserved ()
|
||||
"Test `if-let' respects `and' lazyness."
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
"yes"
|
||||
(list a-called b-called c-called))
|
||||
(list nil nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
"yes"
|
||||
(list a-called b-called c-called))
|
||||
(list t nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(if-let ((a (setq a-called t))
|
||||
(b (setq b-called t))
|
||||
(c nil)
|
||||
(d (setq c-called t)))
|
||||
"yes"
|
||||
(list a-called b-called c-called))
|
||||
(list t t nil)))))
|
||||
|
||||
|
||||
;; when-let tests
|
||||
|
||||
(ert-deftest subr-x-test-when-let-body-expansion ()
|
||||
"Test body allows for multiple sexps wrapping with progn."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a 1)
|
||||
(message "opposite")
|
||||
(- a)))
|
||||
'(let* ((a (and t 1)))
|
||||
(if a
|
||||
(progn
|
||||
(message "opposite")
|
||||
(- a)))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-single-binding-expansion ()
|
||||
"Test single bindings are expanded properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a 1)
|
||||
(- a)))
|
||||
'(let* ((a (and t 1)))
|
||||
(if a
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil)))
|
||||
(if a
|
||||
(- a))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-single-symbol-expansion ()
|
||||
"Test single symbol bindings are expanded properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil)))
|
||||
(if a
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a b c)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a nil))
|
||||
(c (and b nil)))
|
||||
(if c
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (a (b 2) c)
|
||||
(- a)))
|
||||
'(let* ((a (and t nil))
|
||||
(b (and a 2))
|
||||
(c (and b nil)))
|
||||
(if c
|
||||
(- a))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-nil-related-expansion ()
|
||||
"Test nil is processed properly."
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let (nil)
|
||||
(- a)))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((nil))
|
||||
(- a)))
|
||||
'(let* ((nil (and t nil)))
|
||||
(if nil
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((a 1) (nil) (b 2))
|
||||
(- a)))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a)))))
|
||||
(should (equal
|
||||
(macroexpand
|
||||
'(when-let ((a 1) nil (b 2))
|
||||
(- a)))
|
||||
'(let* ((a (and t 1))
|
||||
(nil (and a nil))
|
||||
(b (and nil 2)))
|
||||
(if b
|
||||
(- a))))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-malformed-binding ()
|
||||
"Test malformed bindings trigger errors."
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1 1) (b 2) (c 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1) (b 2 2) (c 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let (_ (a 1) (b 2) (c 3 3) d)
|
||||
(- a)))
|
||||
:type 'error)
|
||||
(should-error (macroexpand
|
||||
'(when-let ((a 1 1))
|
||||
(- a)))
|
||||
:type 'error))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-true ()
|
||||
"Test `when-let' with truthy bindings."
|
||||
(should (equal
|
||||
(when-let (a 1)
|
||||
a)
|
||||
1))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c 3))
|
||||
(list a b c))
|
||||
(list 1 2 3))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-false ()
|
||||
"Test `when-let' with falsey bindings."
|
||||
(should (equal
|
||||
(when-let (a nil)
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a nil) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b nil) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c nil))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let (z (a 1) (b 2) (c 3))
|
||||
(list a b c)
|
||||
"no")
|
||||
nil))
|
||||
(should (equal
|
||||
(when-let ((a 1) (b 2) (c 3) d)
|
||||
(list a b c)
|
||||
"no")
|
||||
nil)))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-bound-references ()
|
||||
"Test `when-let' bindings can refer to already bound symbols."
|
||||
(should (equal
|
||||
(when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
|
||||
(list a b c))
|
||||
(list 1 2 3))))
|
||||
|
||||
(ert-deftest subr-x-test-when-let-and-lazyness-is-preserved ()
|
||||
"Test `when-let' respects `and' lazyness."
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a nil)
|
||||
(b (setq b-called t))
|
||||
(c (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list nil nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a (setq a-called t))
|
||||
(b nil)
|
||||
(c (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list t nil nil))))
|
||||
(let (a-called b-called c-called)
|
||||
(should (equal
|
||||
(progn
|
||||
(when-let ((a (setq a-called t))
|
||||
(b (setq b-called t))
|
||||
(c nil)
|
||||
(d (setq c-called t)))
|
||||
"yes")
|
||||
(list a-called b-called c-called))
|
||||
(list t t nil)))))
|
||||
|
||||
|
||||
;; Thread first tests
|
||||
|
||||
(ert-deftest subr-x-test-thread-first-no-forms ()
|
||||
"Test `thread-first' with no forms expands to the first form."
|
||||
(should (equal (macroexpand '(thread-first 5)) 5))
|
||||
(should (equal (macroexpand '(thread-first (+ 1 2))) '(+ 1 2))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-first-function-names-are-threaded ()
|
||||
"Test `thread-first' wraps single function names."
|
||||
(should (equal (macroexpand
|
||||
'(thread-first 5
|
||||
-))
|
||||
'(- 5)))
|
||||
(should (equal (macroexpand
|
||||
'(thread-first (+ 1 2)
|
||||
-))
|
||||
'(- (+ 1 2)))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-first-expansion ()
|
||||
"Test `thread-first' expands correctly."
|
||||
(should (equal
|
||||
(macroexpand '(thread-first
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40)))
|
||||
'(+ (- (/ (+ 5 20) 25)) 40))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-first-examples ()
|
||||
"Test several `thread-first' examples."
|
||||
(should (equal (thread-first (+ 40 2)) 42))
|
||||
(should (equal (thread-first
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40)) 39))
|
||||
(should (equal (thread-first
|
||||
"this-is-a-string"
|
||||
(split-string "-")
|
||||
(nbutlast 2)
|
||||
(append (list "good")))
|
||||
(list "this" "is" "good"))))
|
||||
|
||||
;; Thread last tests
|
||||
|
||||
(ert-deftest subr-x-test-thread-last-no-forms ()
|
||||
"Test `thread-last' with no forms expands to the first form."
|
||||
(should (equal (macroexpand '(thread-last 5)) 5))
|
||||
(should (equal (macroexpand '(thread-last (+ 1 2))) '(+ 1 2))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-last-function-names-are-threaded ()
|
||||
"Test `thread-last' wraps single function names."
|
||||
(should (equal (macroexpand
|
||||
'(thread-last 5
|
||||
-))
|
||||
'(- 5)))
|
||||
(should (equal (macroexpand
|
||||
'(thread-last (+ 1 2)
|
||||
-))
|
||||
'(- (+ 1 2)))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-last-expansion ()
|
||||
"Test `thread-last' expands correctly."
|
||||
(should (equal
|
||||
(macroexpand '(thread-last
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40)))
|
||||
'(+ 40 (- (/ 25 (+ 20 5)))))))
|
||||
|
||||
(ert-deftest subr-x-test-thread-last-examples ()
|
||||
"Test several `thread-last' examples."
|
||||
(should (equal (thread-last (+ 40 2)) 42))
|
||||
(should (equal (thread-last
|
||||
5
|
||||
(+ 20)
|
||||
(/ 25)
|
||||
-
|
||||
(+ 40)) 39))
|
||||
(should (equal (thread-last
|
||||
(list 1 -2 3 -4 5)
|
||||
(mapcar #'abs)
|
||||
(cl-reduce #'+)
|
||||
(format "abs sum is: %s"))
|
||||
"abs sum is: 15")))
|
||||
|
||||
|
||||
(provide 'subr-x-tests)
|
||||
;;; subr-x-tests.el ends here
|
||||
Reference in New Issue
Block a user