From 054c198c120c1f01a8ff753892d52710b740acc6 Mon Sep 17 00:00:00 2001 From: Alexander Gramiak Date: Thu, 13 Jul 2017 14:54:35 -0600 Subject: [PATCH 1/7] Catch argument and macroexpansion errors in ert This kludge catches errors caused by evaluating arguments in ert's should, should-not, and should-error macros; it also catches macroexpansion errors inside of the above macros (Bug#24402). * lisp/emacs-lisp/ert.el: (ert--should-signal-hook): New function. (ert--expand-should-1): Catch macroexpansion errors. * test/lisp/emacs-lisp/ert-tests.el (ert-test-should-error-argument) (ert-test-should-error-macroexpansion): Tests for argument and expansion errors. --- lisp/emacs-lisp/ert.el | 41 ++++++++++++++++++++++++------- test/lisp/emacs-lisp/ert-tests.el | 9 +++++++ 2 files changed, 41 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d7bd331c11b..c232b08bd1a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -260,6 +260,14 @@ DATA is displayed to the user and should state the reason for skipping." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) +;; See Bug#24402 for why this exists +(defun ert--should-signal-hook (error-symbol data) + "Stupid hack to stop `condition-case' from catching ert signals. +It should only be stopped when ran from inside ert--run-test-internal." + (when (and (not (symbolp debugger)) ; only run on anonymous debugger + (memq error-symbol '(ert-test-failed ert-test-skipped))) + (funcall debugger 'error data))) + (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -267,16 +275,22 @@ DATA is displayed to the user and should state the reason for skipping." (and (subrp definition) (eql (cdr (subr-arity definition)) 'unevalled))))) +;; FIXME: Code inside of here should probably be evaluated like it is +;; outside of tests, with the sole exception of error handling (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - (macroexpand form (append (bound-and-true-p - byte-compile-macro-environment) - (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment)))))) + ;; catch macroexpansion errors + (condition-case err + (macroexpand-all form + (append (bound-and-true-p + byte-compile-macro-environment) + (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment)))) + (error `(signal ',(car err) ',(cdr err)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (cl-gensym "value-"))) @@ -297,8 +311,13 @@ DATA is displayed to the user and should state the reason for skipping." (args (cl-gensym "args-")) (value (cl-gensym "value-")) (default-value (cl-gensym "ert-form-evaluation-aborted-"))) - `(let ((,fn (function ,fn-name)) - (,args (list ,@arg-forms))) + `(let* ((,fn (function ,fn-name)) + (,args (condition-case err + (let ((signal-hook-function #'ert--should-signal-hook)) + (list ,@arg-forms)) + (error (progn (setq ,fn #'signal) + (list (car err) + (cdr err))))))) (let ((,value ',default-value)) ,(funcall inner-expander `(setq ,value (apply ,fn ,args)) @@ -760,6 +779,10 @@ This mainly sets up debugger-related bindings." ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion + ;; FIXME: Use `signal-hook-function' instead of `debugger' to + ;; handle ert errors. Once that's done, remove + ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for + ;; details. (let ((debugger (lambda (&rest args) (ert--run-test-debugger test-execution-info args))) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 57463ad932d..2fbc188dcb9 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -294,6 +294,15 @@ failed or if there was a problem." "the error signaled was a subtype of the expected type"))))) )) +(ert-deftest ert-test-should-error-argument () + "Errors due to evaluating arguments should not break tests." + (should-error (identity (/ 1 0)))) + +(ert-deftest ert-test-should-error-macroexpansion () + "Errors due to expanding macros should not break tests." + (cl-macrolet ((test () (error "Foo"))) + (should-error (test)))) + (ert-deftest ert-test-skip-unless () ;; Don't skip. (let ((test (make-ert-test :body (lambda () (skip-unless t))))) From 95a04fd26c91e6c6c9191a629d26886f136e30fc Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 16 Jul 2017 19:12:10 -0400 Subject: [PATCH 2/7] ; Avoid test failures when running from compiled test files * test/lisp/dom-tests.el: Require `subr-x' during runtime as well. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record): * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-23-inheritance-check, eieio-test-25-slot-tests): Mark as expected to fail when byte-compiled. --- test/lisp/dom-tests.el | 5 ++++- test/lisp/emacs-lisp/cl-lib-tests.el | 8 ++++++++ test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 12 ++++++++++++ 3 files changed, 24 insertions(+), 1 deletion(-) diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 32d231a47e5..24d4b932452 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -26,7 +26,10 @@ (require 'dom) (require 'ert) -(eval-when-compile (require 'subr-x)) + +;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402), +;; therefore we can't use `eval-when-compile' here. +(require 'subr-x) (defun dom-tests--tree () "Return a DOM tree for testing." diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 65bd97f3b2d..9e68dceb8f1 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -518,7 +518,15 @@ (ert-deftest cl-lib-symbol-macrolet-2 () (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) +(defun cl-lib-tests--dummy-function () + ;; Dummy function to see if the file is compiled. + t) + (ert-deftest cl-lib-defstruct-record () + ;; This test fails when compiled, see Bug#24402/27718. + :expected-result (if (byte-code-function-p + (symbol-function 'cl-lib-tests--dummy-function)) + :failed :passed) (cl-defstruct foo x) (let ((x (make-foo :x 42))) (should (recordp x)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 1a6ab9da085..d824bfc1bb4 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -529,7 +529,15 @@ METHOD is the method that was attempting to be called." "This class should break.")) :type 'invalid-slot-type)) +(defun eieio-tests--dummy-function () + ;; Dummy function to see if the file is compiled. + t) + (ert-deftest eieio-test-23-inheritance-check () + ;; This test fails when compiled, see Bug#27718. + :expected-result (if (byte-code-function-p + (symbol-function 'eieio-tests--dummy-function)) + :failed :passed) (should (child-of-class-p 'class-ab 'class-a)) (should (child-of-class-p 'class-ab 'class-b)) (should (object-of-class-p eitest-a 'class-a)) @@ -548,6 +556,10 @@ METHOD is the method that was attempting to be called." (should (not (cl-typep "foo" 'class-a)))) (ert-deftest eieio-test-24-object-predicates () + ;; This test fails when compiled, see Bug#27718. + :expected-result (if (byte-code-function-p + (symbol-function 'eieio-tests--dummy-function)) + :failed :passed) (let ((listooa (list (class-ab) (class-a))) (listoob (list (class-ab) (class-b)))) (should (cl-typep listooa '(list-of class-a))) From 0508045ed7159bce5b5ea3b5fb72cf78b8b4ee8e Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 19 Jul 2017 18:48:50 -0400 Subject: [PATCH 3/7] Don't error on circular values in testcover * lisp/emacs-lisp/testcover.el (testcover-after, testcover-1value): Consider circular lists to be non-equal instead of signaling error. --- lisp/emacs-lisp/testcover.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 433ad38a147..17891fd6096 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -463,7 +463,10 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM (cond ((eq (aref testcover-vector idx) 'unknown) (aset testcover-vector idx val)) - ((not (equal (aref testcover-vector idx) val)) + ((not (condition-case () + (equal (aref testcover-vector idx) val) + ;; TODO: Actually check circular lists for equality. + (circular-list nil))) (aset testcover-vector idx 'ok-coverage))) val) @@ -475,7 +478,10 @@ same value during coverage testing." ((eq (aref testcover-vector idx) '1value) (aset testcover-vector idx (cons '1value val))) ((not (and (eq (car-safe (aref testcover-vector idx)) '1value) - (equal (cdr (aref testcover-vector idx)) val))) + (condition-case () + (equal (cdr (aref testcover-vector idx)) val) + ;; TODO: Actually check circular lists for equality. + (circular-list nil)))) (error "Value of form marked with `1value' does vary: %s" val))) val) From 00f7e31110a27e568529192d7441d9631b9096bc Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Thu, 20 Jul 2017 12:01:42 -0700 Subject: [PATCH 4/7] Add a test of handling of circular values to testcover-tests * test/lisp/emacs-lisp-testcover-resources/testcases.el (testcover-testcase-cyc1): New function. (testcover-tests-circular-lists-bug-24402): New test. --- test/lisp/emacs-lisp/testcover-resources/testcases.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index 1eb791a993c..c9a5a6daacd 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -490,4 +490,14 @@ edebug spec, so testcover needs to cope with that." (should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown)) +;; ==== circular-lists-bug-24402 ==== +"Testcover captures and ignores circular list errors." +;; ==== +(defun testcover-testcase-cyc1 (a) + (let ((ls (make-list 10 a%%%))) + (nconc ls ls) + ls)) +(testcover-testcase-cyc1 1) +(testcover-testcase-cyc1 1) + ;; testcases.el ends here. From cc30d77ecdd1b9155ade3d0656a84a0839ee2795 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 14 Jul 2017 00:32:34 -0400 Subject: [PATCH 5/7] Let `define-symbol-prop' take effect during compilation * src/fns.c (syms_of_fns): New variable `overriding-plist-environment'. (Fget): Consult it. * lisp/emacs-lisp/bytecomp.el (byte-compile-close-variables): Let-bind it to nil. (byte-compile-define-symbol-prop): New function, handles compilation of top-level `define-symbol-prop' and `function-put' calls by putting the symbol setting into `overriding-plist-environment'. Co-authored-by: Noam Postavsky --- lisp/emacs-lisp/bytecomp.el | 29 ++++++++++++++++++++++++++ src/fns.c | 11 ++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 17 +++++++++++++++ 3 files changed, 57 insertions(+) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5fa7389e431..9e14c91c953 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1572,6 +1572,7 @@ extra args." ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-lexical-variables nil) @@ -4714,6 +4715,34 @@ binding slots have been popped." 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) + +(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(defun byte-compile-define-symbol-prop (form) + (pcase form + ((and `(,op ,fun ,prop ,val) + (guard (and (macroexp-const-p fun) + (macroexp-const-p prop) + (or (macroexp-const-p val) + ;; Also accept anonymous functions, since + ;; we're at top-level which implies they're + ;; also constants. + (pcase val (`(function (lambda . ,_)) t)))))) + (byte-compile-push-constant op) + (byte-compile-form fun) + (byte-compile-form prop) + (let* ((fun (eval fun)) + (prop (eval prop)) + (val (if (macroexp-const-p val) + (eval val) + (byte-compile-lambda (cadr val))))) + (push `(,fun + . (,prop ,val ,@(alist-get fun overriding-plist-environment))) + overriding-plist-environment) + (byte-compile-push-constant val) + (byte-compile-out 'byte-call 3))) + + (_ (byte-compile-keep-pending form)))) ;;; tags diff --git a/src/fns.c b/src/fns.c index d849618f2b7..00b6ed6a281 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1987,6 +1987,10 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) (Lisp_Object symbol, Lisp_Object propname) { CHECK_SYMBOL (symbol); + Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)), + propname); + if (!NILP (propval)) + return propval; return Fplist_get (XSYMBOL (symbol)->plist, propname); } @@ -5163,6 +5167,13 @@ syms_of_fns (void) DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area"); DEFSYM (Qwidget_type, "widget-type"); + DEFVAR_LISP ("overriding-plist-environment", Voverriding_plist_environment, + doc: /* An alist overrides the plists of the symbols which it lists. +Used by the byte-compiler to apply `define-symbol-prop' during +compilation. */); + Voverriding_plist_environment = Qnil; + DEFSYM (Qoverriding_plist_environment, "overriding-plist-environment"); + staticpro (&string_char_byte_cache_string); string_char_byte_cache_string = Qnil; diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d15bd8b6e65..8ef2ce70251 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -545,6 +545,23 @@ literals (Bug#20852)." This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual."))))))) + +(ert-deftest bytecomp-tests-function-put () + "Check `function-put' operates during compilation." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1) + (function-put 'bytecomp-tests--foo 'bar 2) + (defmacro bytecomp-tests--foobar () + `(cons ,(function-get 'bytecomp-tests--foo 'foo) + ,(function-get 'bytecomp-tests--foo 'bar))) + (defvar bytecomp-tests--foobar 1) + (setq bytecomp-tests--foobar (bytecomp-tests--foobar)))) + (print form (current-buffer))) + (write-region (point-min) (point-max) source nil 'silent) + (byte-compile-file source t) + (should (equal bytecomp-tests--foobar (cons 1 2))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: From b5c8e9898d9dbd4145c40d08e8eef84a5e32008a Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 4 Aug 2017 19:50:21 -0400 Subject: [PATCH 6/7] Let the cl-typep effects of defclass work during compilation (Bug#27718) * lisp/emacs-lisp/eieio.el (defclass): Use `define-symbol-prop' instead of `put'. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-tests--dummy-function): Remove. (eieio-test-25-slot-tests, eieio-test-23-inheritance-check): Don't expect to fail if compiled. --- lisp/emacs-lisp/eieio.el | 2 +- test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 12 ------------ 2 files changed, 1 insertion(+), 13 deletions(-) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1a7de55fcef..8b92d5b7acd 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -246,7 +246,7 @@ This method is obsolete." ;; test, so we can let typep have the CLOS documented behavior ;; while keeping our above predicate clean. - (put ',name 'cl-deftype-satisfies #',testsym2) + (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2) (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index d824bfc1bb4..1a6ab9da085 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -529,15 +529,7 @@ METHOD is the method that was attempting to be called." "This class should break.")) :type 'invalid-slot-type)) -(defun eieio-tests--dummy-function () - ;; Dummy function to see if the file is compiled. - t) - (ert-deftest eieio-test-23-inheritance-check () - ;; This test fails when compiled, see Bug#27718. - :expected-result (if (byte-code-function-p - (symbol-function 'eieio-tests--dummy-function)) - :failed :passed) (should (child-of-class-p 'class-ab 'class-a)) (should (child-of-class-p 'class-ab 'class-b)) (should (object-of-class-p eitest-a 'class-a)) @@ -556,10 +548,6 @@ METHOD is the method that was attempting to be called." (should (not (cl-typep "foo" 'class-a)))) (ert-deftest eieio-test-24-object-predicates () - ;; This test fails when compiled, see Bug#27718. - :expected-result (if (byte-code-function-p - (symbol-function 'eieio-tests--dummy-function)) - :failed :passed) (let ((listooa (list (class-ab) (class-a))) (listoob (list (class-ab) (class-b)))) (should (cl-typep listooa '(list-of class-a))) From 79a74568e9166f63a12adb30f54edcd57a6405a3 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 13 Jul 2017 00:42:38 -0400 Subject: [PATCH 7/7] Don't define gv expanders in compiler's runtime (Bug#27016) This prevents definitions being compiled from leaking into the current Emacs doing the compilation. * lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead of `put' with `eval-and-compile'. * test/lisp/emacs-lisp/gv-tests.el: New tests. --- lisp/emacs-lisp/gv.el | 7 +- test/lisp/emacs-lisp/gv-tests.el | 147 +++++++++++++++++++++++++++++++ 2 files changed, 148 insertions(+), 6 deletions(-) create mode 100644 test/lisp/emacs-lisp/gv-tests.el diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 27376fc7f95..a8b8974cb4f 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -146,12 +146,7 @@ NAME is a symbol: the name of a function, macro, or special form. HANDLER is a function which takes an argument DO followed by the same arguments as NAME. DO is a function as defined in `gv-get'." (declare (indent 1) (debug (sexp form))) - ;; Use eval-and-compile so the method can be used in the same file as it - ;; is defined. - ;; FIXME: Just like byte-compile-macro-environment, we should have something - ;; like byte-compile-symbolprop-environment so as to handle these things - ;; cleanly without affecting the running Emacs. - `(eval-and-compile (put ',name 'gv-expander ,handler))) + `(function-put ',name 'gv-expander ,handler)) ;;;###autoload (defun gv--defun-declaration (symbol name args handler &optional fix) diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el new file mode 100644 index 00000000000..f19af024b57 --- /dev/null +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -0,0 +1,147 @@ +;;; gv-tests.el --- tests for gv.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar) + (&rest filebody) + &rest body) + (declare (indent 2)) + `(let ((default-directory (make-temp-file "gv-test" t))) + (unwind-protect + (let ((,elvar "gv-test-deffoo.el") + (,elcvar "gv-test-deffoo.elc")) + (with-temp-file ,elvar + (insert ";; -*- lexical-binding: t; -*-\n") + (dolist (form ',filebody) + (pp form (current-buffer)))) + ,@body) + (delete-directory default-directory t)))) + +(ert-deftest gv-define-expander-in-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-define-expander-in-file-twice () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (gv-define-setter gv-test-foo (newval cons) + `(setcdr ,cons ,newval)) + (setf (gv-test-foo gv-test-pair) 42) + (message "%S" gv-test-pair)) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "(99 . 42)\n"))))) + +(ert-deftest gv-dont-define-expander-in-file () + ;; The expander is defined while we are compiling the file, even + ;; though it's inside (when nil ...) because the compiler won't + ;; analyze the conditional. + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((when nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +(ert-deftest gv-define-expander-in-function () + ;; The expander is not defined while we are compiling the file, the + ;; compiler won't handle gv definitions not at top-level. + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((defun foo () + (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + t) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-define-expander-out-of-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-dont-define-expander-other-file () + (gv-tests--in-temp-dir (el elc) + ((if nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +;; `ert-deftest' messes up macroexpansion when the test file itself is +;; compiled (see Bug #24402). + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; gv-tests.el ends here