test/lisp/emacs-lisp/cl-macs-tests.el

   1 ;;; cl-macs-tests.el --- tests for emacs-lisp/cl-macs.el  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2017-2018 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `https://www.gnu.org/licenses/'.
  19
  20 ;;; Commentary:
  21
  22 ;;; Code:
  23
  24 (require 'cl-lib)
  25 (require 'cl-macs)
  26 (require 'ert)
  27
  28 \f
  29 ;;;; cl-loop tests -- many adapted from Steele's CLtL2
  30
  31 ;;; ANSI 6.1.1.7 Destructuring
  32 (ert-deftest cl-macs-loop-and-assignment ()
  33   ;; Bug#6583
  34   :expected-result :failed
  35   (should (equal (cl-loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
  36                           for a = (cl-first numlist)
  37                           and b = (cl-second numlist)
  38                           and c = (cl-third numlist)
  39                           collect (list c b a))
  40                  '((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
  41
  42 (ert-deftest cl-macs-loop-destructure ()
  43   (should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
  44                           collect (list c b a))
  45                  '((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
  46
  47 (ert-deftest cl-macs-loop-destructure-nil ()
  48   (should (equal (cl-loop for (a nil b) = '(1 2 3)
  49                           do (cl-return (list a b)))
  50                  '(1 3))))
  51
  52 (ert-deftest cl-macs-loop-destructure-cons ()
  53   (should (equal (cl-loop for ((a . b) (c . d)) in
  54                           '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
  55                           collect (list a b c d))
  56                  '((1.2 2.4 3 4) (3.4 4.6 5 6)))))
  57
  58 (ert-deftest cl-loop-destructuring-with ()
  59   (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
  60
  61 ;;; 6.1.2.1.1 The for-as-arithmetic subclause
  62 (ert-deftest cl-macs-loop-for-as-arith ()
  63   "Test various for-as-arithmetic subclauses."
  64   :expected-result :failed
  65   (should (equal (cl-loop for i to 10 by 3 collect i)
  66                  '(0 3 6 9)))
  67   (should (equal (cl-loop for i upto 3 collect i)
  68                  '(0 1 2 3)))
  69   (should (equal (cl-loop for i below 3 collect i)
  70                  '(0 1 2)))
  71   (should (equal (cl-loop for i below 10 by 2 collect i)
  72                  '(0 2 4 6 8)))
  73   (should (equal (cl-loop for i downfrom 10 above 4 by 2 collect i)
  74                  '(10 8 6)))
  75   (should (equal (cl-loop for i from 10 downto 1 by 3 collect i)
  76                  '(10 7 4 1)))
  77   (should (equal (cl-loop for i above 0 by 2 downfrom 10 collect i)
  78                  '(10 8 6 4 2)))
  79   (should (equal (cl-loop for i downto 10 from 15 collect i)
  80                  '(15 14 13 12 11 10))))
  81
  82 (ert-deftest cl-macs-loop-for-as-arith-order-side-effects ()
  83   "Test side effects generated by different arithmetic phrase order."
  84   :expected-result :failed
  85   (should
  86    (equal (let ((x 1)) (cl-loop for i from x to 10 by (cl-incf x) collect i))
  87           '(1 3 5 7 9)))
  88   (should
  89    (equal (let ((x 1)) (cl-loop for i from x by (cl-incf x) to 10 collect i))
  90           '(1 3 5 7 9)))
  91   (should
  92    (equal (let ((x 1)) (cl-loop for i to 10 from x by (cl-incf x) collect i))
  93           '(1 3 5 7 9)))
  94   (should
  95    (equal (let ((x 1)) (cl-loop for i to 10 by (cl-incf x) from x collect i))
  96           '(2 4 6 8 10)))
  97   (should
  98    (equal (let ((x 1)) (cl-loop for i by (cl-incf x) from x to 10 collect i))
  99           '(2 4 6 8 10)))
 100   (should
 101    (equal (let ((x 1)) (cl-loop for i by (cl-incf x) to 10 from x collect i))
 102           '(2 4 6 8 10))))
 103
 104 (ert-deftest cl-macs-loop-for-as-arith-invalid ()
 105   "Test for invalid phrase combinations."
 106   :expected-result :failed
 107   ;; Mixing arithmetic-up and arithmetic-down* subclauses
 108   (should-error (cl-loop for i downfrom 10 below 20 collect i))
 109   (should-error (cl-loop for i upfrom 20 above 10 collect i))
 110   (should-error (cl-loop for i upto 10 by 2 downfrom 5))
 111   ;; Repeated phrases
 112   (should-error (cl-loop for i from 10 to 20 above 10))
 113   (should-error (cl-loop for i from 10 to 20 upfrom 0))
 114   (should-error (cl-loop for i by 2 to 10 by 5))
 115   ;; negative step
 116   (should-error (cl-loop for i by -1))
 117   ;; no step given for a downward loop
 118   (should-error (cl-loop for i downto -5 collect i)))
 119
 120
 121 ;;; 6.1.2.1.2 The for-as-in-list subclause
 122 (ert-deftest cl-macs-loop-for-as-in-list ()
 123   (should (equal (cl-loop for x in '(1 2 3 4 5 6) collect (* x x))
 124                  '(1 4 9 16 25 36)))
 125   (should (equal (cl-loop for x in '(1 2 3 4 5 6) by #'cddr collect (* x x))
 126                  '(1 9 25))))
 127
 128 ;;; 6.1.2.1.3 The for-as-on-list subclause
 129 (ert-deftest cl-macs-loop-for-as-on-list ()
 130   (should (equal (cl-loop for x on '(1 2 3 4) collect x)
 131                  '((1 2 3 4) (2 3 4) (3 4) (4))))
 132   (should (equal (cl-loop as (item) on '(1 2 3 4) by #'cddr collect item)
 133                  '(1 3))))
 134
 135 ;;; 6.1.2.1.4 The for-as-equals-then subclause
 136 (ert-deftest cl-macs-loop-for-as-equals-then ()
 137   (should (equal (cl-loop for item = 1 then (+ item 10)
 138                           repeat 5
 139                           collect item)
 140                  '(1 11 21 31 41)))
 141   (should (equal (cl-loop for x below 5 for y = nil then x collect (list x y))
 142                  '((0 nil) (1 1) (2 2) (3 3) (4 4))))
 143   (should (equal (cl-loop for x below 5 and y = nil then x collect (list x y))
 144                  '((0 nil) (1 0) (2 1) (3 2) (4 3))))
 145   (should (equal (cl-loop for x below 3 for y = (+ 10 x) nconc (list x y))
 146                  '(0 10 1 11 2 12)))
 147   (should (equal (cl-loop with start = 5
 148                           for x = start then (cl-incf start)
 149                           repeat 5
 150                           collect x)
 151                  '(5 6 7 8 9))))
 152
 153 ;;; 6.1.2.1.5 The for-as-across subclause
 154 (ert-deftest cl-macs-loop-for-as-across ()
 155   (should (string= (cl-loop for x across "aeiou"
 156                             concat (char-to-string x))
 157                    "aeiou"))
 158   (should (equal (cl-loop for v across (vector 1 2 3) vconcat (vector v (+ 10 v)))
 159                  [1 11 2 12 3 13])))
 160
 161 ;;; 6.1.2.1.6 The for-as-hash subclause
 162 (ert-deftest cl-macs-loop-for-as-hash ()
 163   ;; example in Emacs manual 4.7.3
 164   (should (equal (let ((hash (make-hash-table)))
 165                    (setf (gethash 1 hash) 10)
 166                    (setf (gethash "test" hash) "string")
 167                    (setf (gethash 'test hash) 'value)
 168                    (cl-loop for k being the hash-keys of hash
 169                             using (hash-values v)
 170                             collect (list k v)))
 171                  '((1 10) ("test" "string") (test value)))))
 172
 173 ;;; 6.1.2.2 Local Variable Initializations
 174 (ert-deftest cl-macs-loop-with ()
 175   (should (equal (cl-loop with a = 1
 176                           with b = (+ a 2)
 177                           with c = (+ b 3)
 178                           return (list a b c))
 179                  '(1 3 6)))
 180   (should (equal (let ((a 5)
 181                        (b 10))
 182                    (cl-loop with a = 1
 183                             and b = (+ a 2)
 184                             and c = (+ b 3)
 185                             return (list a b c)))
 186                  '(1 7 13)))
 187   (should (and (equal (cl-loop for i below 3 with loop-with
 188                                do (push (* i i) loop-with)
 189                                finally (cl-return loop-with))
 190                       '(4 1 0))
 191                (not (boundp 'loop-with)))))
 192
 193 ;;; 6.1.3 Value Accumulation Clauses
 194 (ert-deftest cl-macs-loop-accum ()
 195   (should (equal (cl-loop for name in '(fred sue alice joe june)
 196                           for kids in '((bob ken) () () (kris sunshine) ())
 197                           collect name
 198                           append kids)
 199                  '(fred bob ken sue alice joe kris sunshine june))))
 200
 201 (ert-deftest cl-macs-loop-collect ()
 202   (should (equal (cl-loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
 203                           when (symbolp i) collect i)
 204                  '(bird turtle horse cat)))
 205   (should (equal (cl-loop for i from 1 to 10
 206                           if (cl-oddp i) collect i)
 207                  '(1 3 5 7 9)))
 208   (should (equal (cl-loop for i in '(a b c d e f g) by #'cddr
 209                           collect i into my-list
 210                           finally return (nbutlast my-list))
 211                  '(a c e))))
 212
 213 (ert-deftest cl-macs-loop-append/nconc ()
 214   (should (equal (cl-loop for x in '((a) (b) ((c)))
 215                           append x)
 216                  '(a b (c))))
 217   (should (equal (cl-loop for i upfrom 0
 218                           as x in '(a b (c))
 219                           nconc (if (cl-evenp i) (list x) nil))
 220                  '(a (c)))))
 221
 222 (ert-deftest cl-macs-loop-count ()
 223   (should (eql (cl-loop for i in '(a b nil c nil d e)
 224                         count i)
 225                5)))
 226
 227 (ert-deftest cl-macs-loop-max/min ()
 228   (should (eql (cl-loop for i in '(2 1 5 3 4)
 229                         maximize i)
 230                5))
 231   (should (eql (cl-loop for i in '(2 1 5 3 4)
 232                         minimize i)
 233                1))
 234   (should (equal (cl-loop with series = '(4.3 1.2 5.7)
 235                           for v in series
 236                           minimize (round v) into min-result
 237                           maximize (round v) into max-result
 238                           collect (list min-result max-result))
 239                  '((4 4) (1 4) (1 6)))))
 240
 241 (ert-deftest cl-macs-loop-sum ()
 242   (should (eql (cl-loop for i in '(1 2 3 4 5)
 243                         sum i)
 244                15))
 245   (should (eql (cl-loop with series = '(1.2 4.3 5.7)
 246                         for v in series
 247                         sum (* 2.0 v))
 248                22.4)))
 249
 250 ;;; 6.1.4 Termination Test Clauses
 251 (ert-deftest cl-macs-loop-repeat ()
 252   (should (equal (cl-loop with n = 4
 253                           repeat (1+ n)
 254                           collect n)
 255                  '(4 4 4 4 4)))
 256   (should (equal (cl-loop for i upto 5
 257                           repeat 3
 258                           collect i)
 259                  '(0 1 2))))
 260
 261 (ert-deftest cl-macs-loop-always ()
 262   (should (cl-loop for i from 0 to 10
 263                    always (< i 11)))
 264   (should-not (cl-loop for i from 0 to 10
 265                        always (< i 9)
 266                        finally (cl-return "you won't see this"))))
 267
 268 (ert-deftest cl-macs-loop-never ()
 269   (should (cl-loop for i from 0 to 10
 270                    never (> i 11)))
 271   (should-not (cl-loop never t
 272                        finally (cl-return "you won't see this"))))
 273
 274 (ert-deftest cl-macs-loop-thereis ()
 275   (should (eql (cl-loop for i from 0
 276                         thereis (when (> i 10) i))
 277                11))
 278   (should (string= (cl-loop thereis "Here is my value"
 279                             finally (cl-return "you won't see this"))
 280                    "Here is my value"))
 281   (should (cl-loop for i to 10
 282                    thereis (> i 11)
 283                    finally (cl-return i))))
 284
 285 (ert-deftest cl-macs-loop-anon-collection-conditional ()
 286   "Always/never/thereis should error when used with an anonymous
 287 collection clause."
 288   :expected-result :failed
 289   (should-error (cl-loop always nil collect t))
 290   (should-error (cl-loop never t nconc t))
 291   (should-error (cl-loop thereis t append t)))
 292
 293 (ert-deftest cl-macs-loop-while ()
 294   (should (equal (let ((stack '(a b c d e f)))
 295                    (cl-loop while stack
 296                             for item = (length stack) then (pop stack)
 297                             collect item))
 298                  '(6 a b c d e f))))
 299
 300 (ert-deftest cl-macs-loop-until ()
 301   (should (equal (cl-loop for i to 100
 302                           collect 10
 303                           until (= i 3)
 304                           collect i)
 305                  '(10 0 10 1 10 2 10))))
 306
 307 ;;; 6.1.5 Unconditional Execution Clauses
 308 (ert-deftest cl-macs-loop-do ()
 309   (should (equal (cl-loop with list
 310                           for i from 1 to 3
 311                           do
 312                           (push 10 list)
 313                           (push i list)
 314                           finally (cl-return list))
 315                  '(3 10 2 10 1 10)))
 316   (should (equal (cl-loop with res = 0
 317                           for i from 1 to 10
 318                           doing (cl-incf res i)
 319                           finally (cl-return res))
 320                  55))
 321   (should (equal (cl-loop for i from 10
 322                           do (when (= i 15)
 323                                (cl-return i))
 324                           finally (cl-return 0))
 325                  15)))
 326
 327 ;;; 6.1.6 Conditional Execution Clauses
 328 (ert-deftest cl-macs-loop-when ()
 329   (should (equal (cl-loop for i in '(1 2 3 4 5 6)
 330                           when (and (> i 3) i)
 331                             collect it)
 332                  '(4 5 6)))
 333   (should (eql (cl-loop for i in '(1 2 3 4 5 6)
 334                         when (and (> i 3) i)
 335                           return it)
 336                4))
 337
 338   (should (equal (cl-loop for elt in '(1 a 2 "a" (3 4) 5 6)
 339                           when (numberp elt)
 340                             when (cl-evenp elt) collect elt into even
 341                             else collect elt into odd
 342                           else
 343                             when (symbolp elt) collect elt into syms
 344                             else collect elt into other
 345                           finally return (list even odd syms other))
 346                  '((2 6) (1 5) (a) ("a" (3 4))))))
 347
 348 (ert-deftest cl-macs-loop-if ()
 349   (should (equal (cl-loop for i to 5
 350                           if (cl-evenp i)
 351                             collect i
 352                             and when (and (= i 2) 'two)
 353                               collect it
 354                               and if (< i 3)
 355                                 collect "low")
 356                  '(0 2 two "low" 4)))
 357   (should (equal (cl-loop for i to 5
 358                           if (cl-evenp i)
 359                             collect i
 360                             and when (and (= i 2) 'two)
 361                               collect it
 362                             end
 363                             and if (< i 3)
 364                               collect "low")
 365                  '(0 "low" 2 two "low" 4)))
 366   (should (equal (cl-loop with funny-numbers = '(6 13 -1)
 367                           for x below 10
 368                           if (cl-evenp x)
 369                             collect x into evens
 370                           else
 371                             collect x into odds
 372                             and if (memq x funny-numbers) return (cdr it)
 373                           finally return (vector odds evens))
 374                  [(1 3 5 7 9) (0 2 4 6 8)])))
 375
 376 (ert-deftest cl-macs-loop-unless ()
 377   (should (equal (cl-loop for i to 5
 378                           unless (= i 3)
 379                             collect i
 380                           else
 381                             collect 'three)
 382                  '(0 1 2 three 4 5))))
 383
 384
 385 ;;; 6.1.7.1 Control Transfer Clauses
 386 (ert-deftest cl-macs-loop-named ()
 387   (should (eql (cl-loop named finished
 388                         for i to 10
 389                         when (> (* i i) 30)
 390                           do (cl-return-from finished i))
 391                6)))
 392
 393 ;;; 6.1.7.2 Initial and Final Execution
 394 (ert-deftest cl-macs-loop-initially ()
 395   (should (equal (let ((var (list 1 2 3 4 5)))
 396                    (cl-loop for i in var
 397                             collect i
 398                             initially
 399                               (setf (car var) 10)
 400                               (setf (cadr var) 20)))
 401                  '(10 20 3 4 5))))
 402
 403 (ert-deftest cl-macs-loop-finally ()
 404   (should (eql (cl-loop for i from 10
 405                         finally
 406                           (cl-incf i 10)
 407                           (cl-return i)
 408                         while (< i 20))
 409                30)))
 410
 411 ;;; Emacs extensions to loop
 412 (ert-deftest cl-macs-loop-in-ref ()
 413   (should (equal (cl-loop with my-list = (list 1 2 3 4 5)
 414                           for x in-ref my-list
 415                           do (cl-incf x)
 416                           finally return my-list)
 417                  '(2 3 4 5 6))))
 418
 419 (ert-deftest cl-macs-loop-across-ref ()
 420   (should (equal (cl-loop with my-vec = ["one" "two" "three"]
 421                           for x across-ref my-vec
 422                           do (setf (aref x 0) (upcase (aref x 0)))
 423                           finally return my-vec)
 424                  ["One" "Two" "Three"])))
 425
 426 (ert-deftest cl-macs-loop-being-elements ()
 427   (should (equal (let ((var "StRiNG"))
 428                    (cl-loop for x being the elements of var
 429                             collect (downcase x)))
 430                  (string-to-list "string"))))
 431
 432 (ert-deftest cl-macs-loop-being-elements-of-ref ()
 433   (should (equal (let ((var (list 1 2 3 4 5)))
 434                    (cl-loop for x being the elements of-ref var
 435                             do (cl-incf x)
 436                             finally return var))
 437                  '(2 3 4 5 6))))
 438
 439 (ert-deftest cl-macs-loop-being-symbols ()
 440   (should (eq (cl-loop for sym being the symbols
 441                        when (eq sym 'cl-loop)
 442                          return 'cl-loop)
 443               'cl-loop)))
 444
 445 (ert-deftest cl-macs-loop-being-keymap ()
 446   (should (equal (let ((map (make-sparse-keymap))
 447                        (parent (make-sparse-keymap))
 448                        res)
 449                    (define-key map    "f" #'forward-char)
 450                    (define-key map    "b" #'backward-char)
 451                    (define-key parent "n" #'next-line)
 452                    (define-key parent "p" #'previous-line)
 453                    (set-keymap-parent map parent)
 454                    (cl-loop for b being the key-bindings of map
 455                             using (key-codes c)
 456                             do (push (list c b) res))
 457                    (cl-loop for s being the key-seqs of map
 458                             using (key-bindings b)
 459                             do (push (list (cl-copy-seq s) b) res))
 460                    res)
 461                  '(([?n] next-line)    ([?p] previous-line)
 462                    ([?f] forward-char) ([?b] backward-char)
 463                    (?n next-line)      (?p previous-line)
 464                    (?f forward-char)   (?b backward-char)))))
 465
 466 (ert-deftest cl-macs-loop-being-overlays ()
 467   (should (equal (let ((ov (make-overlay (point) (point))))
 468                    (overlay-put ov 'prop "test")
 469                    (cl-loop for o being the overlays
 470                             when (eq o ov)
 471                               return (overlay-get o 'prop)))
 472                  "test")))
 473
 474 (ert-deftest cl-macs-loop-being-frames ()
 475   (should (eq (cl-loop with selected = (selected-frame)
 476                        for frame being the frames
 477                        when (eq frame selected)
 478                          return frame)
 479               (selected-frame))))
 480
 481 (ert-deftest cl-macs-loop-being-windows ()
 482   (should (eq (cl-loop with selected = (selected-window)
 483                        for window being the windows
 484                        when (eq window selected)
 485                          return window)
 486               (selected-window))))
 487
 488 (ert-deftest cl-macs-loop-being-buffers ()
 489   (should (eq (cl-loop with current = (current-buffer)
 490                        for buffer being the buffers
 491                        when (eq buffer current)
 492                          return buffer)
 493               (current-buffer))))
 494
 495 (ert-deftest cl-macs-loop-vconcat ()
 496   (should (equal (cl-loop for x in (list 1 2 3 4 5)
 497                           vconcat (vector (1+ x)))
 498                  [2 3 4 5 6])))
 499
 500 (ert-deftest cl-macs-loop-for-as-equals-and ()
 501   "Test for https://debbugs.gnu.org/29799 ."
 502   (let ((arr (make-vector 3 0)))
 503     (should (equal '((0 0) (1 1) (2 2))
 504                    (cl-loop for k below 3 for x = k and z = (elt arr k)
 505                             collect (list k x))))))
 506
 507 \f
 508 (ert-deftest cl-defstruct/builtin-type ()
 509   (should-error
 510    (macroexpand '(cl-defstruct hash-table))
 511    :type 'wrong-type-argument)
 512   (should-error
 513    (macroexpand '(cl-defstruct (hash-table (:predicate hash-table-p))))
 514    :type 'wrong-type-argument))
 515
 516 ;;; cl-macs-tests.el ends here