test/src/eval-tests.el

   1 ;;; eval-tests.el --- unit tests for src/eval.c      -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Philipp Stephani <phst@google.com>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; Unit tests for src/eval.c.
  25
  26 ;;; Code:
  27
  28 (require 'ert)
  29 (eval-when-compile (require 'cl-lib))
  30
  31 (ert-deftest eval-tests--bug24673 ()
  32   "Check that Bug#24673 has been fixed."
  33   ;; This should not crash.
  34   (should-error (funcall '(closure)) :type 'invalid-function))
  35
  36 (defvar byte-compile-debug)
  37
  38 (ert-deftest eval-tests--bugs-24912-and-24913 ()
  39   "Check that Emacs doesn't accept weird argument lists.
  40 Bug#24912 and Bug#24913."
  41   (dolist (args '((&rest &optional)
  42                   (&rest a &optional) (&rest &optional a)
  43                   (&optional &optional) (&optional &optional a)
  44                   (&optional a &optional b)
  45                   (&rest &rest) (&rest &rest a)
  46                   (&rest a &rest b)))
  47     (should-error (eval `(funcall (lambda ,args)) t) :type 'invalid-function)
  48     (should-error (byte-compile-check-lambda-list args))
  49     (let ((byte-compile-debug t))
  50       (ert-info ((format "bytecomp: args = %S" args))
  51        (should-error (eval `(byte-compile (lambda ,args)) t))))))
  52
  53 (ert-deftest eval-tests-accept-empty-optional-rest ()
  54   "Check that Emacs accepts empty &optional and &rest arglists.
  55 Bug#24912."
  56   (dolist (args '((&optional) (&rest) (&optional &rest)
  57                   (&optional &rest a) (&optional a &rest)))
  58     (let ((fun `(lambda ,args 'ok)))
  59       (ert-info ("eval")
  60         (should (eq (funcall (eval fun t)) 'ok)))
  61       (ert-info ("byte comp check")
  62         (byte-compile-check-lambda-list args))
  63       (ert-info ("bytecomp")
  64         (let ((byte-compile-debug t))
  65           (should (eq (funcall (byte-compile fun)) 'ok)))))))
  66
  67
  68 (dolist (form '(let let*))
  69   (dolist (arg '(1 "a" [a]))
  70     (eval
  71      `(ert-deftest ,(intern (format "eval-tests--%s--%s" form (type-of arg))) ()
  72         ,(format "Check that the first argument of `%s' cannot be a %s"
  73                  form (type-of arg))
  74         (should-error (,form ,arg) :type 'wrong-type-argument))
  75      t)))
  76
  77 (ert-deftest eval-tests--if-dot-string ()
  78   "Check that Emacs rejects (if . \"string\")."
  79   (should-error (eval '(if . "abc")) :type 'wrong-type-argument)
  80   (let ((if-tail (list '(setcdr if-tail "abc") t)))
  81     (should-error (eval (cons 'if if-tail))))
  82   (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t)))
  83     (should-error (eval (cons 'if if-tail)))))
  84
  85 (ert-deftest eval-tests--let-with-circular-defs ()
  86   "Check that Emacs reports an error for (let VARS ...) when VARS is circular."
  87   (let ((vars (list 'v)))
  88     (setcdr vars vars)
  89     (dolist (let-sym '(let let*))
  90       (should-error (eval (list let-sym vars))))))
  91
  92 (ert-deftest eval-tests--mutating-cond ()
  93   "Check that Emacs doesn't crash on a cond clause that mutates during eval."
  94   (let ((clauses (list '((progn (setcdr clauses "ouch") nil)))))
  95     (should-error (eval (cons 'cond clauses)))))
  96
  97 (defun eval-tests--exceed-specbind-limit ()
  98   (defvar eval-tests--var1)
  99   (defvar eval-tests--var2)
 100   ;; Bind two variables, to make extra sure we hit the
 101   ;; `max-specpdl-size' limit before the `max-lisp-eval-depth' limit.
 102   (let ((eval-tests--var1 1)
 103         (eval-tests--var2 2))
 104     ;; Recurse until we hit the limit.
 105     (eval-tests--exceed-specbind-limit)))
 106
 107 (ert-deftest eval-exceed-specbind-with-signal-hook ()
 108   "Test for Bug#30481.
 109 Check that Emacs doesn't crash when exceeding specbind limit with
 110 `signal-hook-function' bound.  NOTE: Without the fix for
 111 Bug#30481, this test can appear to pass, but cause a
 112 crash/abort/malloc assert failure on the next test."
 113   (let ((max-specpdl-size (/ max-lisp-eval-depth 2))
 114         (signal-hook-function #'ignore))
 115     (should-error (eval-tests--exceed-specbind-limit))))
 116
 117 (ert-deftest defvar/bug31072 ()
 118   "Check that Bug#31072 is fixed."
 119   (should-error (eval '(defvar 1) t) :type 'wrong-type-argument))
 120
 121 (ert-deftest defvaralias-overwrite-warning ()
 122   "Test for Bug#5950."
 123   (defvar eval-tests--foo)
 124   (setq eval-tests--foo 2)
 125   (defvar eval-tests--foo-alias)
 126   (setq eval-tests--foo-alias 1)
 127   (cl-letf (((symbol-function 'display-warning)
 128              (lambda (type &rest _)
 129                (throw 'got-warning type))))
 130     ;; Warn if we lose a value through aliasing.
 131     (should (equal
 132              '(defvaralias losing-value eval-tests--foo-alias)
 133              (catch 'got-warning
 134                (defvaralias 'eval-tests--foo-alias 'eval-tests--foo))))
 135     ;; Don't warn if we don't.
 136     (makunbound 'eval-tests--foo-alias)
 137     (should (eq 'no-warning
 138                 (catch 'got-warning
 139                   (defvaralias 'eval-tests--foo-alias 'eval-tests--foo)
 140                   'no-warning)))))
 141
 142 ;;; eval-tests.el ends here