code.delx.au - gnu-emacs/blob - test/automated/subr-tests.el

   1 ;;; subr-tests.el --- Tests for subr.el
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>,
   6 ;;         Nicolas Petton <nicolas@petton.fr>
   7 ;; Keywords:
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;
  27
  28 ;;; Code:
  29
  30 (require 'ert)
  31
  32 (ert-deftest let-when-compile ()
  33   ;; good case
  34   (should (equal (macroexpand '(let-when-compile ((foo (+ 2 3)))
  35                                 (setq bar (eval-when-compile (+ foo foo)))
  36                                 (setq boo (eval-when-compile (* foo foo)))))
  37                  '(progn
  38                    (setq bar (quote 10))
  39                    (setq boo (quote 25)))))
  40   ;; bad case: `eval-when-compile' omitted, byte compiler should catch this
  41   (should (equal (macroexpand
  42                   '(let-when-compile ((foo (+ 2 3)))
  43                     (setq bar (+ foo foo))
  44                     (setq boo (eval-when-compile (* foo foo)))))
  45                  '(progn
  46                    (setq bar (+ foo foo))
  47                    (setq boo (quote 25)))))
  48   ;; something practical
  49   (should (equal (macroexpand
  50                   '(let-when-compile ((keywords '("true" "false")))
  51                     (font-lock-add-keywords
  52                      'c++-mode
  53                      `((,(eval-when-compile
  54                            (format "\\<%s\\>" (regexp-opt keywords)))
  55                          0 font-lock-keyword-face)))))
  56                  '(font-lock-add-keywords
  57                    (quote c++-mode)
  58                    (list
  59                     (cons (quote
  60                            "\\<\\(?:\\(?:fals\\|tru\\)e\\)\\>")
  61                      (quote
  62                       (0 font-lock-keyword-face))))))))
  63
  64 (ert-deftest string-comparison-test ()
  65   (should (string-lessp "abc" "acb"))
  66   (should (string-lessp "aBc" "abc"))
  67   (should (string-lessp "abc" "abcd"))
  68   (should (string-lessp "abc" "abcd"))
  69   (should-not (string-lessp "abc" "abc"))
  70   (should-not (string-lessp "" ""))
  71
  72   (should (string-greaterp "acb" "abc"))
  73   (should (string-greaterp "abc" "aBc"))
  74   (should (string-greaterp "abcd" "abc"))
  75   (should (string-greaterp "abcd" "abc"))
  76   (should-not (string-greaterp "abc" "abc"))
  77   (should-not (string-greaterp "" ""))
  78
  79   ;; Symbols are also accepted
  80   (should (string-lessp 'abc 'acb))
  81   (should (string-lessp "abc" 'acb))
  82   (should (string-greaterp 'acb 'abc))
  83   (should (string-greaterp "acb" 'abc)))
  84
  85 (ert-deftest subr-test-when ()
  86   (should (equal (when t 1) 1))
  87   (should (equal (when t 2) 2))
  88   (should (equal (when nil 1) nil))
  89   (should (equal (when nil 2) nil))
  90   (should (equal (when t 'x 1) 1))
  91   (should (equal (when t 'x 2) 2))
  92   (should (equal (when nil 'x 1) nil))
  93   (should (equal (when nil 'x 2) nil))
  94   (let ((x 1))
  95     (should-not (when nil
  96                   (setq x (1+ x))
  97                   x))
  98     (should (= x 1))
  99     (should (= 2 (when t
 100                    (setq x (1+ x))
 101                    x)))
 102     (should (= x 2)))
 103   (should (equal (macroexpand-all '(when a b c d))
 104                  '(if a (progn b c d)))))
 105
 106 (provide 'subr-tests)
 107 ;;; subr-tests.el ends here