diff options
Diffstat (limited to 'test/src/data-tests.el')
| -rw-r--r-- | test/src/data-tests.el | 103 |
1 files changed, 103 insertions, 0 deletions
diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 98b5ee69cb0..a1959f62fd3 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -768,8 +768,111 @@ comparing the subr with a much slower Lisp implementation." (default-value 'last-coding-system-used)) '(no-conversion bug34318))))) +(defvar-local data-tests--bug65209 :default-value) + +(ert-deftest data-tests-make-local-bug65209 () + (dolist (sym '(data-tests--bug65209 ;A normal always-local Lisp var. + cursor-in-non-selected-windows)) ;Same but DEFVAR_PER_BUFFER. + ;; Note: For vars like `mode-name' that are *really* always buffer-local, + ;; this test isn't right because the `cl-progv' only binds the + ;; buffer-local value! + (let ((default (default-value sym)) + vli vlo vgi vgo) + (with-temp-buffer + (cl-progv (list sym) '(:let-bound-value) + ;; While `setq' would not make the var buffer-local + ;; (because we'd be setq-ing the let-binding instead), + ;; `setq-local' definitely should. + (set (make-local-variable sym) :buffer-local-value) + (setq vgi (with-temp-buffer (symbol-value sym))) + (setq vli (symbol-value sym))) + (setq vgo (with-temp-buffer (symbol-value sym))) + (setq vlo (symbol-value sym))) + (should (equal (list vgo vgi vlo vli) + (cons default + '(:let-bound-value + :buffer-local-value :buffer-local-value))))))) + (ert-deftest data-tests-make_symbol_constant () "Can't set variable marked with 'make_symbol_constant'." (should-error (setq most-positive-fixnum 1) :type 'setting-constant)) +(ert-deftest data-tests-fset () + (fset 'data-tests--fs-fun (lambda () 'moo)) + (declare-function data-tests--fs-fun nil) + (should (equal (data-tests--fs-fun) 'moo)) + + (fset 'data-tests--fs-fun1 'data-tests--fs-fun) + (declare-function data-tests--fs-fun1 nil) + (should (equal (data-tests--fs-fun1) 'moo)) + + (fset 'data-tests--fs-a 'data-tests--fs-b) + (fset 'data-tests--fs-b 'data-tests--fs-c) + + (should-error (fset 'data-tests--fs-c 'data-tests--fs-c) + :type 'cyclic-function-indirection) + (fset 'data-tests--fs-d 'data-tests--fs-a) + (should-error (fset 'data-tests--fs-c 'data-tests--fs-d) + :type 'cyclic-function-indirection)) + +(ert-deftest data-tests-defalias () + (defalias 'data-tests--da-fun (lambda () 'baa)) + (declare-function data-tests--da-fun nil) + (should (equal (data-tests--da-fun) 'baa)) + + (defalias 'data-tests--da-fun1 'data-tests--da-fun) + (declare-function data-tests--da-fun1 nil) + (should (equal (data-tests--da-fun1) 'baa)) + + (defalias 'data-tests--da-a 'data-tests--da-b) + (defalias 'data-tests--da-b 'data-tests--da-c) + + (should-error (defalias 'data-tests--da-c 'data-tests--da-c) + :type 'cyclic-function-indirection) + (defalias 'data-tests--da-d 'data-tests--da-a) + (should-error (defalias 'data-tests--da-c 'data-tests--da-d) + :type 'cyclic-function-indirection)) + +(ert-deftest data-tests-bare-symbol () + (dolist (symbols-with-pos-enabled '(nil t)) + (dolist (sym (list nil t 'xyzzy (make-symbol ""))) + (should (eq sym (bare-symbol (position-symbol sym 0))))))) + +(require 'cl-extra) ;For `cl--class-children'. + +(ert-deftest data-tests--cl-type-of () + ;; Make sure that `cl-type-of' returns the most precise type. + ;; Note: This doesn't work for list/vector structs since those types + ;; are too difficult/unreliable to detect (so `cl-type-of' only says + ;; it's a `cons' or a `vector'). + (dolist (val (list -2 10 (expt 2 128) nil t 'car :car + (symbol-function 'car) + (symbol-function 'progn) + (eval '(lambda (x) (+ x 1)) t) + (position-symbol 'car 7) + (position-symbol :car 7))) + (let* ((type (cl-type-of val)) + (class (cl-find-class type)) + (alltypes (cl--class-allparents class)) + ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'. + ;; (e.g. `symbolp' returns nil on a sympos if that var is nil). + (symbols-with-pos-enabled t)) + (dolist (parent alltypes) + (should (cl-typep val parent)) + (dolist (subtype (cl--class-children (cl-find-class parent))) + (when (and (not (memq subtype alltypes)) + (built-in-class-p (cl-find-class subtype)) + (not (memq subtype + ;; FIXME: Some types don't have any associated + ;; predicate, + '( font-spec font-entity font-object + finalizer condvar terminal + native-comp-unit interpreted-function + tree-sitter-compiled-query + tree-sitter-node tree-sitter-parser)))) + (cond + ((eq subtype 'function) (cl-functionp val)) + (t (should-not (cl-typep val subtype)))))))))) + + ;;; data-tests.el ends here |