From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Alex Newsgroups: gmane.emacs.bugs Subject: bug#27559: 26.0.50; [PATCH] Add tests for cl-macs.el Date: Fri, 11 Aug 2017 18:02:39 -0600 Message-ID: <87inhtirfk.fsf@lylat> References: <87zicmxdyl.fsf@lylat> <87o9t1c0vm.fsf@calancha-pc> <874luti81g.fsf@lylat> <87wp7oaj3l.fsf@calancha-pc> <87bmp0c794.fsf@lylat> <871soi3nt1.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1502496199 20476 195.159.176.226 (12 Aug 2017 00:03:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 12 Aug 2017 00:03:19 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 27559@debbugs.gnu.org, Tino Calancha To: npostavs@users.sourceforge.net Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Sat Aug 12 02:03:12 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@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 1dgJtV-0004fJ-0U for geb-bug-gnu-emacs@m.gmane.org; Sat, 12 Aug 2017 02:03:09 +0200 Original-Received: from localhost ([::1]:33219 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dgJtb-0003d2-3s for geb-bug-gnu-emacs@m.gmane.org; Fri, 11 Aug 2017 20:03:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:55502) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dgJtR-0003bN-NF for bug-gnu-emacs@gnu.org; Fri, 11 Aug 2017 20:03:08 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dgJtO-0003s1-Dg for bug-gnu-emacs@gnu.org; Fri, 11 Aug 2017 20:03:05 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:47451) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dgJtO-0003ra-72 for bug-gnu-emacs@gnu.org; Fri, 11 Aug 2017 20:03:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dgJtN-0007pI-Mq for bug-gnu-emacs@gnu.org; Fri, 11 Aug 2017 20:03:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Alex Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 12 Aug 2017 00:03:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27559 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 27559-submit@debbugs.gnu.org id=B27559.150249617330069 (code B ref 27559); Sat, 12 Aug 2017 00:03:01 +0000 Original-Received: (at 27559) by debbugs.gnu.org; 12 Aug 2017 00:02:53 +0000 Original-Received: from localhost ([127.0.0.1]:56132 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dgJtD-0007ou-Mq for submit@debbugs.gnu.org; Fri, 11 Aug 2017 20:02:52 -0400 Original-Received: from mail-io0-f180.google.com ([209.85.223.180]:34678) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dgJtB-0007oe-3c for 27559@debbugs.gnu.org; Fri, 11 Aug 2017 20:02:49 -0400 Original-Received: by mail-io0-f180.google.com with SMTP id o9so25355679iod.1 for <27559@debbugs.gnu.org>; Fri, 11 Aug 2017 17:02:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=WJHlyUqtqjDriWLCU/yRBb/sfHyoJaDFaumH+nyfDI0=; b=cOVwk0hnwhTzrjVcfGJ0hVGgmQUqON018nI9GlFLBOoVrNcKEJpwBv/uAUNE342bRn 0wFTfPWkrSGwM9UKDUUW4L6l3/AQlB6cI/zv1k3usq0zNjo2ioy7LnkHIJGTPzfoksf1 GOcjkmkg7iSx3bj+49kiYkucxBUBTjKS3pikeYtfTfN+I99dMzIA4H2JUxo+VlvlD9g/ f6Huz1L4C3KKC0K5Wi3T2iR7zkDAdNixX85eC+YB6hyoY6FFx0czY+WwkcaqsZTsXOuE fTFUEmjKDE6t2xHyM+Kgbe6tk9tVkw9zFs+2F+0BUVtbjMlHiHfP5aZVIuKOogf6fYQF 7MOA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=WJHlyUqtqjDriWLCU/yRBb/sfHyoJaDFaumH+nyfDI0=; b=o8y1+J/sbZq/MkmKXUHUg69Fq7dor+Ulm9heBF9Gj06DlqRXyFEdZd9Luf5a6PujnU WCMvlRXDz589L6/5xhctAdQGZvvoXuBUGi4nDRLYBbpG+Kc4wNN+4vPxxYiMwE4NQxSj n9vuvGrxBImaGumZT6zlO5DzYdyyZFpslaNMOdeHc4hrXXiK7NDJ2romVANgWuBvWPRj HOxqF1LazZKqtRjyRB/0TKwOwbri/MB0dxoLHDoC8dht585irazGQ7MCWhOmlgcHLm4i 4IBQhEGsFckZtSIGgVK3EDlZ4Hj5F3oH6TB4r8YFHu1FGojMWcR/884vBckPREXCHnXJ jHCQ== X-Gm-Message-State: AHYfb5h1XxcpqInO8Sy/fcA1qHq8hLKsAJPjnwWmo8VughQ9VES38cOO 8Lh+4bVhSr0NdF12 X-Received: by 10.107.59.69 with SMTP id i66mr14239745ioa.202.1502496163454; Fri, 11 Aug 2017 17:02:43 -0700 (PDT) Original-Received: from lylat (S010664777d9cebe3.ss.shawcable.net. [70.64.85.59]) by smtp.gmail.com with ESMTPSA id n12sm167908itn.16.2017.08.11.17.02.41 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Fri, 11 Aug 2017 17:02:42 -0700 (PDT) In-Reply-To: <871soi3nt1.fsf@users.sourceforge.net> (npostavs's message of "Thu, 10 Aug 2017 21:17:46 -0400") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:135665 Archived-At: --=-=-= Content-Type: text/plain npostavs@users.sourceforge.net writes: > So now that #24402 is done, where are we on this? Here's a patch without any use of eval. All results are as expected with and without TEST_LOAD_EL=no. --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Add-tests-for-cl-macs.el.patch Content-Description: cl-macs tests sans eval >From 7e7fdea81ac6803942889f0f46345591638dacfa Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Fri, 11 Aug 2017 17:53:27 -0600 Subject: [PATCH] Add tests for cl-macs.el * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-loop): Remove duplicate. (cl-loop-destructuring-with): Move to cl-macs-tests.el. * test/lisp/emacs-lisp/cl-macs-tests.el: New file. --- test/lisp/emacs-lisp/cl-lib-tests.el | 10 +- test/lisp/emacs-lisp/cl-macs-tests.el | 500 ++++++++++++++++++++++++++++++++++ 2 files changed, 502 insertions(+), 8 deletions(-) create mode 100644 test/lisp/emacs-lisp/cl-macs-tests.el diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 9e68dceb8f..7763d062a0 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -1,4 +1,4 @@ -;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*- +;;; cl-lib-tests.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*- ;; Copyright (C) 2013-2017 Free Software Foundation, Inc. @@ -195,9 +195,6 @@ (should (eql (cl-mismatch "Aa" "aA") 0)) (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) -(ert-deftest cl-lib-test-loop () - (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) - (ert-deftest cl-lib-keyword-names-versus-values () (should (equal (funcall (cl-function (lambda (&key a b) (list a b))) @@ -480,9 +477,6 @@ (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) (should (= -123 (cl-parse-integer " -123 ")))) -(ert-deftest cl-loop-destructuring-with () - (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) - (ert-deftest cl-flet-test () (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) @@ -556,4 +550,4 @@ cl-lib-tests--dummy-function (should cl-old-struct-compat-mode) (cl-old-struct-compat-mode (if saved 1 -1)))) -;;; cl-lib.el ends here +;;; cl-lib-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el new file mode 100644 index 0000000000..16cb4fb40c --- /dev/null +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -0,0 +1,500 @@ +;;; cl-macs-tests.el --- tests for emacs-lisp/cl-macs.el -*- lexical-binding:t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; 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 'cl-lib) +(require 'cl-macs) +(require 'ert) + + +;;;; cl-loop tests -- many adapted from Steele's CLtL2 + +;;; ANSI 6.1.1.7 Destructuring +(ert-deftest cl-macs-loop-and-assignment () + ;; Bug#6583 + :expected-result :failed + (should (equal (cl-loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + for a = (cl-first numlist) + and b = (cl-second numlist) + and c = (cl-third numlist) + collect (list c b a)) + '((4.0 2 1) (8.3 6 5) (10.4 9 8))))) + +(ert-deftest cl-macs-loop-destructure () + (should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + collect (list c b a)) + '((4.0 2 1) (8.3 6 5) (10.4 9 8))))) + +(ert-deftest cl-macs-loop-destructure-nil () + (should (equal (cl-loop for (a nil b) = '(1 2 3) + do (cl-return (list a b))) + '(1 3)))) + +(ert-deftest cl-macs-loop-destructure-cons () + (should (equal (cl-loop for ((a . b) (c . d)) in + '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6))) + collect (list a b c d)) + '((1.2 2.4 3 4) (3.4 4.6 5 6))))) + +(ert-deftest cl-loop-destructuring-with () + (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) + +;;; 6.1.2.1.1 The for-as-arithmetic subclause +(ert-deftest cl-macs-loop-for-as-arith () + "Test various for-as-arithmetic subclauses." + :expected-result :failed + (should (equal (cl-loop for i to 10 by 3 collect i) + '(0 3 6 9))) + (should (equal (cl-loop for i upto 3 collect i) + '(0 1 2 3))) + (should (equal (cl-loop for i below 3 collect i) + '(0 1 2))) + (should (equal (cl-loop for i below 10 by 2 collect i) + '(0 2 4 6 8))) + (should (equal (cl-loop for i downfrom 10 above 4 by 2 collect i) + '(10 8 6))) + (should (equal (cl-loop for i from 10 downto 1 by 3 collect i) + '(10 7 4 1))) + (should (equal (cl-loop for i above 0 by 2 downfrom 10 collect i) + '(10 8 6 4 2))) + (should (equal (cl-loop for i downto 10 from 15 collect i) + '(15 14 13 12 11 10)))) + +(ert-deftest cl-macs-loop-for-as-arith-order-side-effects () + "Test side effects generated by different arithmetic phrase order." + :expected-result :failed + (should + (equal (let ((x 1)) (cl-loop for i from x to 10 by (cl-incf x) collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i from x by (cl-incf x) to 10 collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i to 10 from x by (cl-incf x) collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i to 10 by (cl-incf x) from x collect i)) + '(2 4 6 8 10))) + (should + (equal (let ((x 1)) (cl-loop for i by (cl-incf x) from x to 10 collect i)) + '(2 4 6 8 10))) + (should + (equal (let ((x 1)) (cl-loop for i by (cl-incf x) to 10 from x collect i)) + '(2 4 6 8 10)))) + +(ert-deftest cl-macs-loop-for-as-arith-invalid () + "Test for invalid phrase combinations." + :expected-result :failed + ;; Mixing arithmetic-up and arithmetic-down* subclauses + (should-error (cl-loop for i downfrom 10 below 20 collect i)) + (should-error (cl-loop for i upfrom 20 above 10 collect i)) + (should-error (cl-loop for i upto 10 by 2 downfrom 5)) + ;; Repeated phrases + (should-error (cl-loop for i from 10 to 20 above 10)) + (should-error (cl-loop for i from 10 to 20 upfrom 0)) + (should-error (cl-loop for i by 2 to 10 by 5)) + ;; negative step + (should-error (cl-loop for i by -1)) + ;; no step given for a downward loop + (should-error (cl-loop for i downto -5 collect i))) + + +;;; 6.1.2.1.2 The for-as-in-list subclause +(ert-deftest cl-macs-loop-for-as-in-list () + (should (equal (cl-loop for x in '(1 2 3 4 5 6) collect (* x x)) + '(1 4 9 16 25 36))) + (should (equal (cl-loop for x in '(1 2 3 4 5 6) by #'cddr collect (* x x)) + '(1 9 25)))) + +;;; 6.1.2.1.3 The for-as-on-list subclause +(ert-deftest cl-macs-loop-for-as-on-list () + (should (equal (cl-loop for x on '(1 2 3 4) collect x) + '((1 2 3 4) (2 3 4) (3 4) (4)))) + (should (equal (cl-loop as (item) on '(1 2 3 4) by #'cddr collect item) + '(1 3)))) + +;;; 6.1.2.1.4 The for-as-equals-then subclause +(ert-deftest cl-macs-loop-for-as-equals-then () + (should (equal (cl-loop for item = 1 then (+ item 10) + repeat 5 + collect item) + '(1 11 21 31 41))) + (should (equal (cl-loop for x below 5 for y = nil then x collect (list x y)) + '((0 nil) (1 1) (2 2) (3 3) (4 4)))) + (should (equal (cl-loop for x below 5 and y = nil then x collect (list x y)) + '((0 nil) (1 0) (2 1) (3 2) (4 3)))) + (should (equal (cl-loop for x below 3 for y = (+ 10 x) nconc (list x y)) + '(0 10 1 11 2 12))) + (should (equal (cl-loop with start = 5 + for x = start then (cl-incf start) + repeat 5 + collect x) + '(5 6 7 8 9)))) + +;;; 6.1.2.1.5 The for-as-across subclause +(ert-deftest cl-macs-loop-for-as-across () + (should (string= (cl-loop for x across "aeiou" + concat (char-to-string x)) + "aeiou")) + (should (equal (cl-loop for v across (vector 1 2 3) vconcat (vector v (+ 10 v))) + [1 11 2 12 3 13]))) + +;;; 6.1.2.1.6 The for-as-hash subclause +(ert-deftest cl-macs-loop-for-as-hash () + ;; example in Emacs manual 4.7.3 + (should (equal (let ((hash (make-hash-table))) + (setf (gethash 1 hash) 10) + (setf (gethash "test" hash) "string") + (setf (gethash 'test hash) 'value) + (cl-loop for k being the hash-keys of hash + using (hash-values v) + collect (list k v))) + '((1 10) ("test" "string") (test value))))) + +;;; 6.1.2.2 Local Variable Initializations +(ert-deftest cl-macs-loop-with () + (should (equal (cl-loop with a = 1 + with b = (+ a 2) + with c = (+ b 3) + return (list a b c)) + '(1 3 6))) + (should (equal (let ((a 5) + (b 10)) + (cl-loop with a = 1 + and b = (+ a 2) + and c = (+ b 3) + return (list a b c))) + '(1 7 13))) + (should (and (equal (cl-loop for i below 3 with loop-with + do (push (* i i) loop-with) + finally (cl-return loop-with)) + '(4 1 0)) + (not (boundp 'loop-with))))) + +;;; 6.1.3 Value Accumulation Clauses +(ert-deftest cl-macs-loop-accum () + (should (equal (cl-loop for name in '(fred sue alice joe june) + for kids in '((bob ken) () () (kris sunshine) ()) + collect name + append kids) + '(fred bob ken sue alice joe kris sunshine june)))) + +(ert-deftest cl-macs-loop-collect () + (should (equal (cl-loop for i in '(bird 3 4 turtle (1 . 4) horse cat) + when (symbolp i) collect i) + '(bird turtle horse cat))) + (should (equal (cl-loop for i from 1 to 10 + if (cl-oddp i) collect i) + '(1 3 5 7 9))) + (should (equal (cl-loop for i in '(a b c d e f g) by #'cddr + collect i into my-list + finally return (nbutlast my-list)) + '(a c e)))) + +(ert-deftest cl-macs-loop-append/nconc () + (should (equal (cl-loop for x in '((a) (b) ((c))) + append x) + '(a b (c)))) + (should (equal (cl-loop for i upfrom 0 + as x in '(a b (c)) + nconc (if (cl-evenp i) (list x) nil)) + '(a (c))))) + +(ert-deftest cl-macs-loop-count () + (should (eql (cl-loop for i in '(a b nil c nil d e) + count i) + 5))) + +(ert-deftest cl-macs-loop-max/min () + (should (eql (cl-loop for i in '(2 1 5 3 4) + maximize i) + 5)) + (should (eql (cl-loop for i in '(2 1 5 3 4) + minimize i) + 1)) + (should (equal (cl-loop with series = '(4.3 1.2 5.7) + for v in series + minimize (round v) into min-result + maximize (round v) into max-result + collect (list min-result max-result)) + '((4 4) (1 4) (1 6))))) + +(ert-deftest cl-macs-loop-sum () + (should (eql (cl-loop for i in '(1 2 3 4 5) + sum i) + 15)) + (should (eql (cl-loop with series = '(1.2 4.3 5.7) + for v in series + sum (* 2.0 v)) + 22.4))) + +;;; 6.1.4 Termination Test Clauses +(ert-deftest cl-macs-loop-repeat () + (should (equal (cl-loop with n = 4 + repeat (1+ n) + collect n) + '(4 4 4 4 4))) + (should (equal (cl-loop for i upto 5 + repeat 3 + collect i) + '(0 1 2)))) + +(ert-deftest cl-macs-loop-always () + (should (cl-loop for i from 0 to 10 + always (< i 11))) + (should-not (cl-loop for i from 0 to 10 + always (< i 9) + finally (cl-return "you won't see this")))) + +(ert-deftest cl-macs-loop-never () + (should (cl-loop for i from 0 to 10 + never (> i 11))) + (should-not (cl-loop never t + finally (cl-return "you won't see this")))) + +(ert-deftest cl-macs-loop-thereis () + (should (eql (cl-loop for i from 0 + thereis (when (> i 10) i)) + 11)) + (should (string= (cl-loop thereis "Here is my value" + finally (cl-return "you won't see this")) + "Here is my value")) + (should (cl-loop for i to 10 + thereis (> i 11) + finally (cl-return i)))) + +(ert-deftest cl-macs-loop-anon-collection-conditional () + "Always/never/thereis should error when used with an anonymous +collection clause." + :expected-result :failed + (should-error (cl-loop always nil collect t)) + (should-error (cl-loop never t nconc t)) + (should-error (cl-loop thereis t append t))) + +(ert-deftest cl-macs-loop-while () + (should (equal (let ((stack '(a b c d e f))) + (cl-loop while stack + for item = (length stack) then (pop stack) + collect item)) + '(6 a b c d e f)))) + +(ert-deftest cl-macs-loop-until () + (should (equal (cl-loop for i to 100 + collect 10 + until (= i 3) + collect i) + '(10 0 10 1 10 2 10)))) + +;;; 6.1.5 Unconditional Execution Clauses +(ert-deftest cl-macs-loop-do () + (should (equal (cl-loop with list + for i from 1 to 3 + do + (push 10 list) + (push i list) + finally (cl-return list)) + '(3 10 2 10 1 10))) + (should (equal (cl-loop with res = 0 + for i from 1 to 10 + doing (cl-incf res i) + finally (cl-return res)) + 55)) + (should (equal (cl-loop for i from 10 + do (when (= i 15) + (cl-return i)) + finally (cl-return 0)) + 15))) + +;;; 6.1.6 Conditional Execution Clauses +(ert-deftest cl-macs-loop-when () + (should (equal (cl-loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + collect it) + '(4 5 6))) + (should (eql (cl-loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + return it) + 4)) + + (should (equal (cl-loop for elt in '(1 a 2 "a" (3 4) 5 6) + when (numberp elt) + when (cl-evenp elt) collect elt into even + else collect elt into odd + else + when (symbolp elt) collect elt into syms + else collect elt into other + finally return (list even odd syms other)) + '((2 6) (1 5) (a) ("a" (3 4)))))) + +(ert-deftest cl-macs-loop-if () + (should (equal (cl-loop for i to 5 + if (cl-evenp i) + collect i + and when (and (= i 2) 'two) + collect it + and if (< i 3) + collect "low") + '(0 2 two "low" 4))) + (should (equal (cl-loop for i to 5 + if (cl-evenp i) + collect i + and when (and (= i 2) 'two) + collect it + end + and if (< i 3) + collect "low") + '(0 "low" 2 two "low" 4))) + (should (equal (cl-loop with funny-numbers = '(6 13 -1) + for x below 10 + if (cl-evenp x) + collect x into evens + else + collect x into odds + and if (memq x funny-numbers) return (cdr it) + finally return (vector odds evens)) + [(1 3 5 7 9) (0 2 4 6 8)]))) + +(ert-deftest cl-macs-loop-unless () + (should (equal (cl-loop for i to 5 + unless (= i 3) + collect i + else + collect 'three) + '(0 1 2 three 4 5)))) + + +;;; 6.1.7.1 Control Transfer Clauses +(ert-deftest cl-macs-loop-named () + (should (eql (cl-loop named finished + for i to 10 + when (> (* i i) 30) + do (cl-return-from finished i)) + 6))) + +;;; 6.1.7.2 Initial and Final Execution +(ert-deftest cl-macs-loop-initially () + (should (equal (let ((var (list 1 2 3 4 5))) + (cl-loop for i in var + collect i + initially + (setf (car var) 10) + (setf (cadr var) 20))) + '(10 20 3 4 5)))) + +(ert-deftest cl-macs-loop-finally () + (should (eql (cl-loop for i from 10 + finally + (cl-incf i 10) + (cl-return i) + while (< i 20)) + 30))) + +;;; Emacs extensions to loop +(ert-deftest cl-macs-loop-in-ref () + (should (equal (cl-loop with my-list = (list 1 2 3 4 5) + for x in-ref my-list + do (cl-incf x) + finally return my-list) + '(2 3 4 5 6)))) + +(ert-deftest cl-macs-loop-across-ref () + (should (equal (cl-loop with my-vec = ["one" "two" "three"] + for x across-ref my-vec + do (setf (aref x 0) (upcase (aref x 0))) + finally return my-vec) + ["One" "Two" "Three"]))) + +(ert-deftest cl-macs-loop-being-elements () + (should (equal (let ((var "StRiNG")) + (cl-loop for x being the elements of var + collect (downcase x))) + (string-to-list "string")))) + +(ert-deftest cl-macs-loop-being-elements-of-ref () + (should (equal (let ((var (list 1 2 3 4 5))) + (cl-loop for x being the elements of-ref var + do (cl-incf x) + finally return var)) + '(2 3 4 5 6)))) + +(ert-deftest cl-macs-loop-being-symbols () + (should (eq (cl-loop for sym being the symbols + when (eq sym 'cl-loop) + return 'cl-loop) + 'cl-loop))) + +(ert-deftest cl-macs-loop-being-keymap () + (should (equal (let ((map (make-sparse-keymap)) + (parent (make-sparse-keymap)) + res) + (define-key map "f" #'forward-char) + (define-key map "b" #'backward-char) + (define-key parent "n" #'next-line) + (define-key parent "p" #'previous-line) + (set-keymap-parent map parent) + (cl-loop for b being the key-bindings of map + using (key-codes c) + do (push (list c b) res)) + (cl-loop for s being the key-seqs of map + using (key-bindings b) + do (push (list (cl-copy-seq s) b) res)) + res) + '(([?n] next-line) ([?p] previous-line) + ([?f] forward-char) ([?b] backward-char) + (?n next-line) (?p previous-line) + (?f forward-char) (?b backward-char))))) + +(ert-deftest cl-macs-loop-being-overlays () + (should (equal (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'prop "test") + (cl-loop for o being the overlays + when (eq o ov) + return (overlay-get o 'prop))) + "test"))) + +(ert-deftest cl-macs-loop-being-frames () + (should (eq (cl-loop with selected = (selected-frame) + for frame being the frames + when (eq frame selected) + return frame) + (selected-frame)))) + +(ert-deftest cl-macs-loop-being-windows () + (should (eq (cl-loop with selected = (selected-window) + for window being the windows + when (eq window selected) + return window) + (selected-window)))) + +(ert-deftest cl-macs-loop-being-buffers () + (should (eq (cl-loop with current = (current-buffer) + for buffer being the buffers + when (eq buffer current) + return buffer) + (current-buffer)))) + +(ert-deftest cl-macs-loop-vconcat () + (should (equal (cl-loop for x in (list 1 2 3 4 5) + vconcat (vector (1+ x))) + [2 3 4 5 6]))) + +;;; cl-macs-tests.el ends here -- 2.13.2 --=-=-=--