From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Michael Heerdegen Newsgroups: gmane.emacs.devel Subject: Re: if-let/if-let*/and-let/.. Date: Sat, 03 Mar 2018 15:12:53 +0100 Message-ID: <874llx9riy.fsf@web.de> References: <87wozijhpk.fsf@web.de> <87mv0crbp3.fsf@web.de> <20180213193126.7ifsybvdx7cnjb4f@logos.localdomain> <87wozgph70.fsf@udel.edu> <87y3jv186x.fsf@web.de> <87sh9t4yrj.fsf@web.de> <877er5e9vx.fsf@web.de> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1520086296 17755 195.159.176.226 (3 Mar 2018 14:11:36 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 3 Mar 2018 14:11:36 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.91 (gnu/linux) Cc: Mark Oteiza , emacs-devel@gnu.org, npostavs@users.sourceforge.net To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Mar 03 15:11:32 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1es7so-0003hn-3g for ged-emacs-devel@m.gmane.org; Sat, 03 Mar 2018 15:11:30 +0100 Original-Received: from localhost ([::1]:40402 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1es7uo-0006jz-KP for ged-emacs-devel@m.gmane.org; Sat, 03 Mar 2018 09:13:34 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53613) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1es7ud-0006jc-Ix for emacs-devel@gnu.org; Sat, 03 Mar 2018 09:13:26 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1es7uY-0004jP-Hz for emacs-devel@gnu.org; Sat, 03 Mar 2018 09:13:23 -0500 Original-Received: from mout.web.de ([212.227.17.12]:38733) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1es7uX-0004jD-UU for emacs-devel@gnu.org; Sat, 03 Mar 2018 09:13:18 -0500 Original-Received: from drachen.dragon ([188.99.169.170]) by smtp.web.de (mrweb101 [213.165.67.124]) with ESMTPSA (Nemesis) id 0LmcnP-1eIWAe1tmF-00aIIZ; Sat, 03 Mar 2018 15:12:56 +0100 In-Reply-To: <877er5e9vx.fsf@web.de> (Michael Heerdegen's message of "Thu, 22 Feb 2018 08:55:30 +0100") X-Provags-ID: V03:K0:8c031JBD7lqkKmHI6FIzaffLQIQqdiGAffelxaVwubbwV84FT1c AUV0t2BHtbMJEd2taKUHlfF3N4Iq0+40VWm/CVYzhoyff7KvyFm1TmsK1Ck2VNscvbllgwj AfWh6OZIIrXJ5Yecar3uQJe6oViVA2m8rUmjPe6fUdg9mTqsybsfhYH9sCWbgjfCXiK4MN1 oqevd/nI1jZrpEb81zegw== X-UI-Out-Filterresults: notjunk:1;V01:K0:yC6r7mX7iCc=:QVKDqVaFFYVXL+9qGfUhm1 tBNUrM1hflvbpZmuFdYyhA4I58ssvCM4V4fUgxj0eNE0CuXBHaOHpbCJwgYwyUmYEH9puldLE ByRUfwwqn1PTJf4VU28UEuwDa+DcjqKkM2bsboTVSxCCWUA2aWwjzXAy0JurM0hICl8HY/2Mv WItNZYJf9hgL9xMA/m+2w63mCKevbSrMx832tA022yHisLYZ9yzL5UP6pYMuB3WQDZh7UsNgo 0PoF1m6nAcb6sQmBklEKrzMokPdnc2yhO9AIatgWpigela4A+3xCSD0pgWLmEfe61PPWBsh5N T+5fuUIrOEcLD62i3HqJAV1L2iIPNbO+HQqXAHYc63ZVV34THf39cYL+yICtVVxiU79I4GHaq R/OU2rMYQZxJcv48Z/7Tok063F74rofBZf1tQw7+WE0SF9YHlk+RLZhaG9YwAy8vgTP670B8O hmYtbyQk6r0RYDc3Iom9Vi1mjITJGkbfYUI0287PiToX6fLsoxpwsW6ue9a04DJxtdicDTols +GY8nSZA9GRqyRNuema0grRADVUCkW8ZCjkaZnxuB1rVBTIlFVYJYXYQ4PdnpHGpfyrvJLxIQ +vU2Jt6A5PvdGzKeLgoz/xxw2MsM9LKt+DXtQeKuISWreeFUm68nbxw/cbtilpnzesPcqchkp ALyRVsGL29ZTXSLWVyW9Z+TDCGFewpsQW4+Fwch/3avR7Zi1b9tQ1IXAIGbjZdt5cq5ZfYFli YpUXUlIz+vwP2HvHbOxg7CAvEgFs6o6ATgcNqphr+EcXQo+yYGkYY93lX29r8cKMORW+27cr X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 212.227.17.12 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:223240 Archived-At: --=-=-= Content-Type: text/plain Michael Heerdegen writes: > Hmm - maybe it would be even better to make `foo-let*' just do what > `foo-let' does currently - only handle a SPEC (SYMBOL EXPR) specially, > and don't signal any errors. Sorry for the delay. I've done that now - the new patch is attached. In a subsequent commit we need to add to the documentation that an element of the VARLIST can also be a symbol - that case is currently undocumented. This is independent from this issue here, so I'll do it in a separate commit. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Define-if-let-and-derivatives-as-aliases-of-if-let.patch >From 69d1375dd100f46100c0bbf2cff42846a8cdd139 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Wed, 21 Feb 2018 11:15:37 +0100 Subject: [PATCH] Define if-let* and derivatives as aliases of if-let This commit reverts declaring `if-let' and `when-let' obsolete in favor of the new `if-let* and `when-let*' versions because of the compiler warning mess (Bug#30039). Instead we make foo-let and foo-let* aliases. The old single-tuple variable spec case is still supported for backward compatibility. * lisp/emacs-lisp/subr-x.el (if-let, when-let): Don't declare obsolete. Tweak edebug specs. (and-let): Renamed from `and-let*' for compatibility with the names `if-let' and `when-let'. (if-let*, when-let*, and-let*): Define as aliases of `if-let', `when-let' and `and-let'. * test/lisp/emacs-lisp/subr-x-tests.el (if-let-single-tuple-case-test) (when-let-single-tuple-case-test): New tests for the single-binding tuple case. In the whole file, prefer the names without "*". --- etc/NEWS | 10 +- lisp/emacs-lisp/subr-x.el | 55 ++++----- test/lisp/emacs-lisp/subr-x-tests.el | 232 ++++++++++++++++++----------------- 3 files changed, 148 insertions(+), 149 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index eded00e655..c88bec5a56 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1301,12 +1301,10 @@ current buffer or the self-insertion takes place within a comment. ** The alist 'ucs-names' is now a hash table. --- -** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. -The incumbent 'if-let' and 'when-let' are now marked obsolete. -'if-let*' and 'when-let*' do not accept the single tuple special case. -New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax -of the same name. 'if-let*' and 'when-let*' now accept the same -binding syntax as 'and-let*'. +** The new macro 'and-let' is an implementation of the Scheme SRFI-2 +syntax. 'if-let' and 'when-let' now also accept the same binding +syntax as 'and-let'. 'if-let*', 'when-let*' and 'and-let*' are new +aliases for 'if-let', 'when-let' and 'and-let'. --- ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 21dba377bf..b2d7f0dec4 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -121,7 +121,7 @@ internal--build-bindings binding)) bindings))) -(defmacro if-let* (varlist then &rest else) +(defmacro if-let (varlist then &rest else) "Bind variables according to VARLIST and eval THEN or ELSE. Each binding is evaluated in turn, and evaluation stops if a binding value is nil. If all are non-nil, the value of THEN is @@ -131,10 +131,18 @@ if-let* SYMBOL to the value of VALUEFORM. An element can additionally be of the form (VALUEFORM), which is evaluated and checked for nil; i.e. SYMBOL can be omitted if only the test result is of -interest." +interest. + +As a special case, a VARLIST of the form (SYMBOL SOMETHING) is +treated like ((SYMBOL SOMETHING))." (declare (indent 2) - (debug ((&rest [&or symbolp (symbolp form) (form)]) + (debug ([&or (symbolp form) + (&rest [&or symbolp (symbolp form) (form)])] form body))) + (pcase varlist + (`(,(pred symbolp) ,_) + ;; the single-tuple syntax case, for backward compatibility + (cl-callf list varlist))) (if varlist `(let* ,(setq varlist (internal--build-bindings varlist)) (if ,(caar (last varlist)) @@ -142,23 +150,23 @@ if-let* ,@else)) `(let* () ,then))) -(defmacro when-let* (varlist &rest body) +(defmacro when-let (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. Each binding is evaluated in turn, and evaluation stops if a binding value is nil. If all are non-nil, the value of the last form in BODY is returned. -VARLIST is the same as in `if-let*'." - (declare (indent 1) (debug if-let*)) - (list 'if-let* varlist (macroexp-progn body))) +VARLIST is the same as in `if-let'." + (declare (indent 1) (debug ([&or (symbolp form) + (&rest [&or symbolp (symbolp form) (form)])] + body))) + (list 'if-let varlist (macroexp-progn body))) -(defmacro and-let* (varlist &rest body) +(defmacro and-let (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. -Like `when-let*', except if BODY is empty and all the bindings +Like `when-let', except if BODY is empty and all the bindings are non-nil, then the result is non-nil." - (declare (indent 1) - (debug ((&rest [&or symbolp (symbolp form) (form)]) - body))) + (declare (indent 1) (debug when-let)) (let (res) (if varlist `(let* ,(setq varlist (internal--build-bindings varlist)) @@ -166,26 +174,9 @@ and-let* ,@(or body `(,res)))) `(let* () ,@(or body '(t)))))) -(defmacro if-let (spec then &rest else) - "Bind variables according to SPEC and eval THEN or ELSE. -Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." - (declare (indent 2) - (debug ([&or (&rest [&or symbolp (symbolp form) (form)]) - (symbolp form)] - form body)) - (obsolete "use `if-let*' instead." "26.1")) - (when (and (<= (length spec) 2) - (not (listp (car spec)))) - ;; Adjust the single binding case - (setq spec (list spec))) - (list 'if-let* spec then (macroexp-progn else))) - -(defmacro when-let (spec &rest body) - "Bind variables according to SPEC and conditionally eval BODY. -Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)." - (declare (indent 1) (debug if-let) - (obsolete "use `when-let*' instead." "26.1")) - (list 'if-let spec (macroexp-progn body))) +(defalias 'if-let* #'if-let) +(defalias 'when-let* #'when-let) +(defalias 'and-let* #'and-let) (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index c9618f3c37..a361718c9e 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -28,13 +28,13 @@ (require 'subr-x) -;; `if-let*' tests +;; `if-let' tests -(ert-deftest subr-x-test-if-let*-single-binding-expansion () +(ert-deftest subr-x-test-if-let-single-binding-expansion () "Test single bindings are expanded properly." (should (equal (macroexpand - '(if-let* ((a 1)) + '(if-let ((a 1)) (- a) "no")) '(let* ((a (and t 1))) @@ -43,7 +43,7 @@ "no")))) (should (equal (macroexpand - '(if-let* (a) + '(if-let (a) (- a) "no")) '(let* ((a (and t a))) @@ -51,11 +51,11 @@ (- a) "no"))))) -(ert-deftest subr-x-test-if-let*-single-symbol-expansion () +(ert-deftest subr-x-test-if-let-single-symbol-expansion () "Test single symbol bindings are expanded properly." (should (equal (macroexpand - '(if-let* (a) + '(if-let (a) (- a) "no")) '(let* ((a (and t a))) @@ -64,7 +64,7 @@ "no")))) (should (equal (macroexpand - '(if-let* (a b c) + '(if-let (a b c) (- a) "no")) '(let* ((a (and t a)) @@ -75,7 +75,7 @@ "no")))) (should (equal (macroexpand - '(if-let* (a (b 2) c) + '(if-let (a (b 2) c) (- a) "no")) '(let* ((a (and t a)) @@ -85,11 +85,11 @@ (- a) "no"))))) -(ert-deftest subr-x-test-if-let*-nil-related-expansion () +(ert-deftest subr-x-test-if-let-nil-related-expansion () "Test nil is processed properly." (should (equal (macroexpand - '(if-let* (nil) + '(if-let (nil) (- a) "no")) '(let* ((nil (and t nil))) @@ -98,7 +98,7 @@ "no")))) (should (equal (macroexpand - '(if-let* ((a 1) nil (b 2)) + '(if-let ((a 1) nil (b 2)) (- a) "no")) '(let* ((a (and t 1)) @@ -108,106 +108,106 @@ (- a) "no"))))) -(ert-deftest subr-x-test-if-let*-malformed-binding () +(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) + '(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) + '(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) + '(if-let (_ (a 1) (b 2) (c 3 3) d) (- a) "no")) :type 'error) (should-error (macroexpand - '(if-let* ((a 1 1)) + '(if-let ((a 1 1)) (- a) "no")) :type 'error)) -(ert-deftest subr-x-test-if-let*-true () +(ert-deftest subr-x-test-if-let-true () "Test `if-let' with truthy bindings." (should (equal - (if-let* ((a 1)) + (if-let ((a 1)) a "no") 1)) (should (equal - (if-let* ((a 1) (b 2) (c 3)) + (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 () +(ert-deftest subr-x-test-if-let-false () "Test `if-let' with falsie bindings." (should (equal - (if-let* ((a nil)) + (if-let ((a nil)) (list a b c) "no") "no")) (should (equal - (if-let* ((a nil) (b 2) (c 3)) + (if-let ((a nil) (b 2) (c 3)) (list a b c) "no") "no")) (should (equal - (if-let* ((a 1) (b nil) (c 3)) + (if-let ((a 1) (b nil) (c 3)) (list a b c) "no") "no")) (should (equal - (if-let* ((a 1) (b 2) (c nil)) + (if-let ((a 1) (b 2) (c nil)) (list a b c) "no") "no")) (should (equal (let (z) - (if-let* (z (a 1) (b 2) (c 3)) + (if-let (z (a 1) (b 2) (c 3)) (list a b c) "no")) "no")) (should (equal (let (d) - (if-let* ((a 1) (b 2) (c 3) d) + (if-let ((a 1) (b 2) (c 3) d) (list a b c) "no")) "no"))) -(ert-deftest subr-x-test-if-let*-bound-references () +(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))) + (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-laziness-is-preserved () +(ert-deftest subr-x-test-if-let-and-laziness-is-preserved () "Test `if-let' respects `and' laziness." (let (a-called b-called c-called) (should (equal - (if-let* ((a nil) - (b (setq b-called t)) - (c (setq c-called t))) + (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))) + (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)) + (if-let ((a (setq a-called t)) (b (setq b-called t)) (c nil) (d (setq c-called t))) @@ -215,14 +215,19 @@ (list a-called b-called c-called)) (list t t nil))))) +(defun if-let-single-tuple-case-test () + "Test the BINDING-SPEC == (SYMBOL SOMETHING) case." + (should (equal (if-let (a 1) (1+ a)) 2)) + (should (equal (let ((b 2)) (if-let (a b) a)) 2))) + -;; `when-let*' tests +;; `when-let' tests -(ert-deftest subr-x-test-when-let*-body-expansion () +(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)) + '(when-let ((a 1)) (message "opposite") (- a))) '(let* ((a (and t 1))) @@ -231,18 +236,18 @@ (message "opposite") (- a))))))) -(ert-deftest subr-x-test-when-let*-single-symbol-expansion () +(ert-deftest subr-x-test-when-let-single-symbol-expansion () "Test single symbol bindings are expanded properly." (should (equal (macroexpand - '(when-let* (a) + '(when-let (a) (- a))) '(let* ((a (and t a))) (if a (- a))))) (should (equal (macroexpand - '(when-let* (a b c) + '(when-let (a b c) (- a))) '(let* ((a (and t a)) (b (and a b)) @@ -251,7 +256,7 @@ (- a))))) (should (equal (macroexpand - '(when-let* (a (b 2) c) + '(when-let (a (b 2) c) (- a))) '(let* ((a (and t a)) (b (and a 2)) @@ -259,18 +264,18 @@ (if c (- a)))))) -(ert-deftest subr-x-test-when-let*-nil-related-expansion () +(ert-deftest subr-x-test-when-let-nil-related-expansion () "Test nil is processed properly." (should (equal (macroexpand - '(when-let* (nil) + '(when-let (nil) (- a))) '(let* ((nil (and t nil))) (if nil (- a))))) (should (equal (macroexpand - '(when-let* ((a 1) nil (b 2)) + '(when-let ((a 1) nil (b 2)) (- a))) '(let* ((a (and t 1)) (nil (and a nil)) @@ -278,173 +283,178 @@ (if b (- a)))))) -(ert-deftest subr-x-test-when-let*-malformed-binding () +(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) + '(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) + '(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) + '(when-let (_ (a 1) (b 2) (c 3 3) d) (- a))) :type 'error) (should-error (macroexpand - '(when-let* ((a 1 1)) + '(when-let ((a 1 1)) (- a))) :type 'error)) -(ert-deftest subr-x-test-when-let*-true () +(ert-deftest subr-x-test-when-let-true () "Test `when-let' with truthy bindings." (should (equal - (when-let* ((a 1)) + (when-let ((a 1)) a) 1)) (should (equal - (when-let* ((a 1) (b 2) (c 3)) + (when-let ((a 1) (b 2) (c 3)) (list a b c)) (list 1 2 3)))) -(ert-deftest subr-x-test-when-let*-false () +(ert-deftest subr-x-test-when-let-false () "Test `when-let' with falsie bindings." (should (equal - (when-let* ((a nil)) + (when-let ((a nil)) (list a b c) "no") nil)) (should (equal - (when-let* ((a nil) (b 2) (c 3)) + (when-let ((a nil) (b 2) (c 3)) (list a b c) "no") nil)) (should (equal - (when-let* ((a 1) (b nil) (c 3)) + (when-let ((a 1) (b nil) (c 3)) (list a b c) "no") nil)) (should (equal - (when-let* ((a 1) (b 2) (c nil)) + (when-let ((a 1) (b 2) (c nil)) (list a b c) "no") nil)) (should (equal (let (z) - (when-let* (z (a 1) (b 2) (c 3)) + (when-let (z (a 1) (b 2) (c 3)) (list a b c) "no")) nil)) (should (equal (let (d) - (when-let* ((a 1) (b 2) (c 3) d) + (when-let ((a 1) (b 2) (c 3) d) (list a b c) "no")) nil))) -(ert-deftest subr-x-test-when-let*-bound-references () +(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))) + (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-laziness-is-preserved () +(ert-deftest subr-x-test-when-let-and-laziness-is-preserved () "Test `when-let' respects `and' laziness." (let (a-called b-called c-called) (should (equal (progn - (when-let* ((a nil) - (b (setq b-called t)) - (c (setq c-called t))) + (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))) + (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))) + (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))))) +(defun when-let-single-tuple-case-test () + "Test the BINDING-SPEC == (SYMBOL SOMETHING) case." + (should (equal (when-let (a 1) (1+ a)) 2)) + (should (equal (let ((b 2)) (when-let (a b) a)) 2))) + -;; `and-let*' tests +;; `and-let' tests ;; Adapted from the Guile tests ;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test -(ert-deftest subr-x-and-let*-test-empty-varlist () - (should (equal 1 (and-let* () 1))) - (should (equal 2 (and-let* () 1 2))) - (should (equal t (and-let* ())))) +(ert-deftest subr-x-and-let-test-empty-varlist () + (should (equal 1 (and-let () 1))) + (should (equal 2 (and-let () 1 2))) + (should (equal t (and-let ())))) -(ert-deftest subr-x-and-let*-test-group-1 () - (should (equal nil (let ((x nil)) (and-let* (x))))) - (should (equal 1 (let ((x 1)) (and-let* (x))))) - (should (equal nil (and-let* ((x nil))))) - (should (equal 1 (and-let* ((x 1))))) +(ert-deftest subr-x-and-let-test-group-1 () + (should (equal nil (let ((x nil)) (and-let (x))))) + (should (equal 1 (let ((x 1)) (and-let (x))))) + (should (equal nil (and-let ((x nil))))) + (should (equal 1 (and-let ((x 1))))) ;; The error doesn't trigger when compiled: the compiler will give ;; a warning and then drop the erroneous code. Therefore, use ;; `eval' to avoid compilation. - (should-error (eval '(and-let* (nil (x 1))) lexical-binding) + (should-error (eval '(and-let (nil (x 1))) lexical-binding) :type 'setting-constant) - (should (equal nil (and-let* ((nil) (x 1))))) - (should-error (eval '(and-let* (2 (x 1))) lexical-binding) + (should (equal nil (and-let ((nil) (x 1))))) + (should-error (eval '(and-let (2 (x 1))) lexical-binding) :type 'wrong-type-argument) - (should (equal 1 (and-let* ((2) (x 1))))) - (should (equal 2 (and-let* ((x 1) (2))))) - (should (equal nil (let ((x nil)) (and-let* (x) x)))) - (should (equal "" (let ((x "")) (and-let* (x) x)))) - (should (equal "" (let ((x "")) (and-let* (x))))) - (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) - (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) - (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) - (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) - (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) + (should (equal 1 (and-let ((2) (x 1))))) + (should (equal 2 (and-let ((x 1) (2))))) + (should (equal nil (let ((x nil)) (and-let (x) x)))) + (should (equal "" (let ((x "")) (and-let (x) x)))) + (should (equal "" (let ((x "")) (and-let (x))))) + (should (equal 2 (let ((x 1)) (and-let (x) (+ x 1))))) + (should (equal nil (let ((x nil)) (and-let (x) (+ x 1))))) + (should (equal 2 (let ((x 1)) (and-let (((> x 0))) (+ x 1))))) + (should (equal t (let ((x 1)) (and-let (((> x 0))))))) + (should (equal nil (let ((x 0)) (and-let (((> x 0))) (+ x 1))))) (should (equal 3 - (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) + (let ((x 1)) (and-let (((> x 0)) (x (+ x 1))) (+ x 1)))))) -(ert-deftest subr-x-and-let*-test-rebind () +(ert-deftest subr-x-and-let-test-rebind () (should (equal 4 (let ((x 1)) - (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) + (and-let (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) -(ert-deftest subr-x-and-let*-test-group-2 () +(ert-deftest subr-x-and-let-test-group-2 () (should - (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) + (equal 2 (let ((x 1)) (and-let (x ((> x 0))) (+ x 1))))) (should - (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) - (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) - (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) + (equal 2 (let ((x 1)) (and-let (((progn x)) ((> x 0))) (+ x 1))))) + (should (equal nil (let ((x 0)) (and-let (x ((> x 0))) (+ x 1))))) + (should (equal nil (let ((x nil)) (and-let (x ((> x 0))) (+ x 1))))) (should - (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) + (equal nil (let ((x nil)) (and-let (((progn x)) ((> x 0))) (+ x 1)))))) -(ert-deftest subr-x-and-let*-test-group-3 () +(ert-deftest subr-x-and-let-test-group-3 () (should - (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (equal nil (let ((x 1)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (should - (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (equal nil (let ((x 0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (should (equal nil - (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (let ((x nil)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y))))) (should (equal (/ 3.0 2) - (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))) + (let ((x 3.0)) (and-let (x (y (- x 1)) ((> y 0))) (/ x y)))))) -- 2.16.1 --=-=-= Content-Type: text/plain Regards, Michael. --=-=-=--