test/automated/subr-x-tests.el

   1 ;;; subr-x-tests.el --- Testing the extended lisp routines
   2
   3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Fabián E. Gallina <fgallina@gnu.org>
   6 ;; Keywords:
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;;
  24
  25 ;;; Code:
  26
  27 (require 'ert)
  28 (require 'subr-x)
  29
  30 \f
  31 ;; if-let tests
  32
  33 (ert-deftest subr-x-test-if-let-single-binding-expansion ()
  34   "Test single bindings are expanded properly."
  35   (should (equal
  36            (macroexpand
  37             '(if-let (a 1)
  38                  (- a)
  39                "no"))
  40            '(let* ((a (and t 1)))
  41               (if a
  42                   (- a)
  43                 "no"))))
  44   (should (equal
  45            (macroexpand
  46             '(if-let (a)
  47                  (- a)
  48                "no"))
  49            '(let* ((a (and t nil)))
  50               (if a
  51                   (- a)
  52                 "no")))))
  53
  54 (ert-deftest subr-x-test-if-let-single-symbol-expansion ()
  55   "Test single symbol bindings are expanded properly."
  56   (should (equal
  57            (macroexpand
  58             '(if-let (a)
  59                  (- a)
  60                "no"))
  61            '(let* ((a (and t nil)))
  62               (if a
  63                   (- a)
  64                 "no"))))
  65   (should (equal
  66            (macroexpand
  67             '(if-let (a b c)
  68                  (- a)
  69                "no"))
  70            '(let* ((a (and t nil))
  71                    (b (and a nil))
  72                    (c (and b nil)))
  73               (if c
  74                   (- a)
  75                 "no"))))
  76   (should (equal
  77            (macroexpand
  78             '(if-let (a (b 2) c)
  79                  (- a)
  80                "no"))
  81            '(let* ((a (and t nil))
  82                    (b (and a 2))
  83                    (c (and b nil)))
  84               (if c
  85                   (- a)
  86                 "no")))))
  87
  88 (ert-deftest subr-x-test-if-let-nil-related-expansion ()
  89   "Test nil is processed properly."
  90   (should (equal
  91            (macroexpand
  92             '(if-let (nil)
  93                  (- a)
  94                "no"))
  95            '(let* ((nil (and t nil)))
  96               (if nil
  97                   (- a)
  98                 "no"))))
  99   (should (equal
 100            (macroexpand
 101             '(if-let ((nil))
 102                  (- a)
 103                "no"))
 104            '(let* ((nil (and t nil)))
 105               (if nil
 106                   (- a)
 107                 "no"))))
 108   (should (equal
 109            (macroexpand
 110             '(if-let ((a 1) (nil) (b 2))
 111                  (- a)
 112                "no"))
 113            '(let* ((a (and t 1))
 114                    (nil (and a nil))
 115                    (b (and nil 2)))
 116               (if b
 117                   (- a)
 118                 "no"))))
 119   (should (equal
 120            (macroexpand
 121             '(if-let ((a 1) nil (b 2))
 122                  (- a)
 123                "no"))
 124            '(let* ((a (and t 1))
 125                    (nil (and a nil))
 126                    (b (and nil 2)))
 127               (if b
 128                   (- a)
 129                 "no")))))
 130
 131 (ert-deftest subr-x-test-if-let-malformed-binding ()
 132   "Test malformed bindings trigger errors."
 133   (should-error (macroexpand
 134                  '(if-let (_ (a 1 1) (b 2) (c 3) d)
 135                       (- a)
 136                     "no"))
 137                 :type 'error)
 138   (should-error (macroexpand
 139                  '(if-let (_ (a 1) (b 2 2) (c 3) d)
 140                       (- a)
 141                     "no"))
 142                 :type 'error)
 143   (should-error (macroexpand
 144                  '(if-let (_ (a 1) (b 2) (c 3 3) d)
 145                       (- a)
 146                     "no"))
 147                 :type 'error)
 148   (should-error (macroexpand
 149                  '(if-let ((a 1 1))
 150                       (- a)
 151                     "no"))
 152                 :type 'error))
 153
 154 (ert-deftest subr-x-test-if-let-true ()
 155   "Test `if-let' with truthy bindings."
 156   (should (equal
 157            (if-let (a 1)
 158                a
 159              "no")
 160            1))
 161   (should (equal
 162            (if-let ((a 1) (b 2) (c 3))
 163                (list a b c)
 164              "no")
 165            (list 1 2 3))))
 166
 167 (ert-deftest subr-x-test-if-let-false ()
 168   "Test `if-let' with falsie bindings."
 169   (should (equal
 170            (if-let (a nil)
 171                (list a b c)
 172              "no")
 173            "no"))
 174   (should (equal
 175            (if-let ((a nil) (b 2) (c 3))
 176                (list a b c)
 177              "no")
 178            "no"))
 179   (should (equal
 180            (if-let ((a 1) (b nil) (c 3))
 181                (list a b c)
 182              "no")
 183            "no"))
 184   (should (equal
 185            (if-let ((a 1) (b 2) (c nil))
 186                (list a b c)
 187              "no")
 188            "no"))
 189   (should (equal
 190            (if-let (z (a 1) (b 2) (c 3))
 191                (list a b c)
 192              "no")
 193            "no"))
 194   (should (equal
 195            (if-let ((a 1) (b 2) (c 3) d)
 196                (list a b c)
 197              "no")
 198            "no")))
 199
 200 (ert-deftest subr-x-test-if-let-bound-references ()
 201   "Test `if-let' bindings can refer to already bound symbols."
 202   (should (equal
 203            (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
 204                (list a b c)
 205              "no")
 206            (list 1 2 3))))
 207
 208 (ert-deftest subr-x-test-if-let-and-laziness-is-preserved ()
 209   "Test `if-let' respects `and' laziness."
 210   (let (a-called b-called c-called)
 211     (should (equal
 212              (if-let ((a nil)
 213                       (b (setq b-called t))
 214                       (c (setq c-called t)))
 215                  "yes"
 216                (list a-called b-called c-called))
 217              (list nil nil nil))))
 218   (let (a-called b-called c-called)
 219     (should (equal
 220              (if-let ((a (setq a-called t))
 221                       (b nil)
 222                       (c (setq c-called t)))
 223                  "yes"
 224                (list a-called b-called c-called))
 225              (list t nil nil))))
 226   (let (a-called b-called c-called)
 227     (should (equal
 228              (if-let ((a (setq a-called t))
 229                       (b (setq b-called t))
 230                       (c nil)
 231                       (d (setq c-called t)))
 232                  "yes"
 233                (list a-called b-called c-called))
 234              (list t t nil)))))
 235
 236 \f
 237 ;; when-let tests
 238
 239 (ert-deftest subr-x-test-when-let-body-expansion ()
 240   "Test body allows for multiple sexps wrapping with progn."
 241   (should (equal
 242            (macroexpand
 243             '(when-let (a 1)
 244                (message "opposite")
 245                (- a)))
 246            '(let* ((a (and t 1)))
 247               (if a
 248                   (progn
 249                     (message "opposite")
 250                     (- a)))))))
 251
 252 (ert-deftest subr-x-test-when-let-single-binding-expansion ()
 253   "Test single bindings are expanded properly."
 254   (should (equal
 255            (macroexpand
 256             '(when-let (a 1)
 257                (- a)))
 258            '(let* ((a (and t 1)))
 259               (if a
 260                   (- a)))))
 261   (should (equal
 262            (macroexpand
 263             '(when-let (a)
 264                (- a)))
 265            '(let* ((a (and t nil)))
 266               (if a
 267                   (- a))))))
 268
 269 (ert-deftest subr-x-test-when-let-single-symbol-expansion ()
 270   "Test single symbol bindings are expanded properly."
 271   (should (equal
 272            (macroexpand
 273             '(when-let (a)
 274                (- a)))
 275            '(let* ((a (and t nil)))
 276               (if a
 277                   (- a)))))
 278   (should (equal
 279            (macroexpand
 280             '(when-let (a b c)
 281                (- a)))
 282            '(let* ((a (and t nil))
 283                    (b (and a nil))
 284                    (c (and b nil)))
 285               (if c
 286                   (- a)))))
 287   (should (equal
 288            (macroexpand
 289             '(when-let (a (b 2) c)
 290                (- a)))
 291            '(let* ((a (and t nil))
 292                    (b (and a 2))
 293                    (c (and b nil)))
 294               (if c
 295                   (- a))))))
 296
 297 (ert-deftest subr-x-test-when-let-nil-related-expansion ()
 298   "Test nil is processed properly."
 299   (should (equal
 300            (macroexpand
 301             '(when-let (nil)
 302                (- a)))
 303            '(let* ((nil (and t nil)))
 304               (if nil
 305                   (- a)))))
 306   (should (equal
 307            (macroexpand
 308             '(when-let ((nil))
 309                (- a)))
 310            '(let* ((nil (and t nil)))
 311               (if nil
 312                   (- a)))))
 313   (should (equal
 314            (macroexpand
 315             '(when-let ((a 1) (nil) (b 2))
 316                (- a)))
 317            '(let* ((a (and t 1))
 318                    (nil (and a nil))
 319                    (b (and nil 2)))
 320               (if b
 321                   (- a)))))
 322   (should (equal
 323            (macroexpand
 324             '(when-let ((a 1) nil (b 2))
 325                (- a)))
 326            '(let* ((a (and t 1))
 327                    (nil (and a nil))
 328                    (b (and nil 2)))
 329               (if b
 330                   (- a))))))
 331
 332 (ert-deftest subr-x-test-when-let-malformed-binding ()
 333   "Test malformed bindings trigger errors."
 334   (should-error (macroexpand
 335                  '(when-let (_ (a 1 1) (b 2) (c 3) d)
 336                     (- a)))
 337                 :type 'error)
 338   (should-error (macroexpand
 339                  '(when-let (_ (a 1) (b 2 2) (c 3) d)
 340                     (- a)))
 341                 :type 'error)
 342   (should-error (macroexpand
 343                  '(when-let (_ (a 1) (b 2) (c 3 3) d)
 344                     (- a)))
 345                 :type 'error)
 346   (should-error (macroexpand
 347                  '(when-let ((a 1 1))
 348                     (- a)))
 349                 :type 'error))
 350
 351 (ert-deftest subr-x-test-when-let-true ()
 352   "Test `when-let' with truthy bindings."
 353   (should (equal
 354            (when-let (a 1)
 355              a)
 356            1))
 357   (should (equal
 358            (when-let ((a 1) (b 2) (c 3))
 359              (list a b c))
 360            (list 1 2 3))))
 361
 362 (ert-deftest subr-x-test-when-let-false ()
 363   "Test `when-let' with falsie bindings."
 364   (should (equal
 365            (when-let (a nil)
 366              (list a b c)
 367              "no")
 368            nil))
 369   (should (equal
 370            (when-let ((a nil) (b 2) (c 3))
 371              (list a b c)
 372              "no")
 373            nil))
 374   (should (equal
 375            (when-let ((a 1) (b nil) (c 3))
 376              (list a b c)
 377              "no")
 378            nil))
 379   (should (equal
 380            (when-let ((a 1) (b 2) (c nil))
 381              (list a b c)
 382              "no")
 383            nil))
 384   (should (equal
 385            (when-let (z (a 1) (b 2) (c 3))
 386              (list a b c)
 387              "no")
 388            nil))
 389   (should (equal
 390            (when-let ((a 1) (b 2) (c 3) d)
 391              (list a b c)
 392              "no")
 393            nil)))
 394
 395 (ert-deftest subr-x-test-when-let-bound-references ()
 396   "Test `when-let' bindings can refer to already bound symbols."
 397   (should (equal
 398            (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
 399              (list a b c))
 400            (list 1 2 3))))
 401
 402 (ert-deftest subr-x-test-when-let-and-laziness-is-preserved ()
 403   "Test `when-let' respects `and' laziness."
 404   (let (a-called b-called c-called)
 405     (should (equal
 406              (progn
 407                (when-let ((a nil)
 408                           (b (setq b-called t))
 409                           (c (setq c-called t)))
 410                  "yes")
 411                (list a-called b-called c-called))
 412              (list nil nil nil))))
 413   (let (a-called b-called c-called)
 414     (should (equal
 415              (progn
 416                (when-let ((a (setq a-called t))
 417                           (b nil)
 418                           (c (setq c-called t)))
 419                  "yes")
 420                (list a-called b-called c-called))
 421              (list t nil nil))))
 422   (let (a-called b-called c-called)
 423     (should (equal
 424              (progn
 425                (when-let ((a (setq a-called t))
 426                           (b (setq b-called t))
 427                           (c nil)
 428                           (d (setq c-called t)))
 429                  "yes")
 430                (list a-called b-called c-called))
 431              (list t t nil)))))
 432
 433 \f
 434 ;; Thread first tests
 435
 436 (ert-deftest subr-x-test-thread-first-no-forms ()
 437   "Test `thread-first' with no forms expands to the first form."
 438   (should (equal (macroexpand '(thread-first 5)) 5))
 439   (should (equal (macroexpand '(thread-first (+ 1 2))) '(+ 1 2))))
 440
 441 (ert-deftest subr-x-test-thread-first-function-names-are-threaded ()
 442   "Test `thread-first' wraps single function names."
 443   (should (equal (macroexpand
 444                   '(thread-first 5
 445                      -))
 446                  '(- 5)))
 447   (should (equal (macroexpand
 448                   '(thread-first (+ 1 2)
 449                      -))
 450                  '(- (+ 1 2)))))
 451
 452 (ert-deftest subr-x-test-thread-first-expansion ()
 453   "Test `thread-first' expands correctly."
 454   (should (equal
 455            (macroexpand '(thread-first
 456                              5
 457                            (+ 20)
 458                            (/ 25)
 459                            -
 460                            (+ 40)))
 461            '(+ (- (/ (+ 5 20) 25)) 40))))
 462
 463 (ert-deftest subr-x-test-thread-first-examples ()
 464   "Test several `thread-first' examples."
 465   (should (equal (thread-first (+ 40 2)) 42))
 466   (should (equal (thread-first
 467                      5
 468                    (+ 20)
 469                    (/ 25)
 470                    -
 471                    (+ 40)) 39))
 472   (should (equal (thread-first
 473                      "this-is-a-string"
 474                    (split-string "-")
 475                    (nbutlast 2)
 476                    (append (list "good")))
 477                  (list "this" "is" "good"))))
 478 \f
 479 ;; Thread last tests
 480
 481 (ert-deftest subr-x-test-thread-last-no-forms ()
 482   "Test `thread-last' with no forms expands to the first form."
 483   (should (equal (macroexpand '(thread-last 5)) 5))
 484   (should (equal (macroexpand '(thread-last (+ 1 2))) '(+ 1 2))))
 485
 486 (ert-deftest subr-x-test-thread-last-function-names-are-threaded ()
 487   "Test `thread-last' wraps single function names."
 488   (should (equal (macroexpand
 489                   '(thread-last 5
 490                      -))
 491                  '(- 5)))
 492   (should (equal (macroexpand
 493                   '(thread-last (+ 1 2)
 494                      -))
 495                  '(- (+ 1 2)))))
 496
 497 (ert-deftest subr-x-test-thread-last-expansion ()
 498   "Test `thread-last' expands correctly."
 499   (should (equal
 500            (macroexpand '(thread-last
 501                              5
 502                            (+ 20)
 503                            (/ 25)
 504                            -
 505                            (+ 40)))
 506            '(+ 40 (- (/ 25 (+ 20 5)))))))
 507
 508 (ert-deftest subr-x-test-thread-last-examples ()
 509   "Test several `thread-last' examples."
 510   (should (equal (thread-last (+ 40 2)) 42))
 511   (should (equal (thread-last
 512                      5
 513                    (+ 20)
 514                    (/ 25)
 515                    -
 516                    (+ 40)) 39))
 517   (should (equal (thread-last
 518                      (list 1 -2 3 -4 5)
 519                    (mapcar #'abs)
 520                    (cl-reduce #'+)
 521                    (format "abs sum is: %s"))
 522                  "abs sum is: 15")))
 523
 524
 525 (provide 'subr-x-tests)
 526 ;;; subr-x-tests.el ends here