From b7dab24b7953f7a31b806f83e15043c94aaa7745 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 4 Jul 2017 22:50:46 +0200 Subject: Module assertions: check for garbage collections It's technically possible to write a user pointer finalizer that calls into Emacs module functions. This would be disastrous because it would allow arbitrary Lisp code to run during garbage collection. Therefore extend the module assertions to check for this case. * src/emacs-module.c (module_assert_thread): Also check whether a garbage collection is in progress. * test/data/emacs-module/mod-test.c (invalid_finalizer) (Fmod_test_invalid_finalizer): New test module functions. (emacs_module_init): Register new test function. * test/src/emacs-module-tests.el (module--test-assertion) (module--with-temp-directory): New helper macros. (module--test-assertions--load-non-live-object): Rename existing unit test, use helper macros. (module--test-assertions--call-emacs-from-gc): New unit test. --- test/src/emacs-module-tests.el | 87 ++++++++++++++++++++++++++++-------------- 1 file changed, 58 insertions(+), 29 deletions(-) (limited to 'test/src') diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index a4994b6223b..988a7a178c6 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -182,37 +182,66 @@ changes." (should (equal (help-function-arglist #'mod-test-sum) '(arg1 arg2)))) -(ert-deftest module--test-assertions () - "Check that -module-assertions work." +(defmacro module--with-temp-directory (name &rest body) + "Bind NAME to the name of a temporary directory and evaluate BODY. +NAME must be a symbol. Delete the temporary directory after BODY +exits normally or non-locally. NAME will be bound to the +directory name (not the directory file name) of the temporary +directory." + (declare (indent 1)) + (cl-check-type name symbol) + `(let ((,name (file-name-as-directory + (make-temp-file "emacs-module-test" :directory)))) + (unwind-protect + (progn ,@body) + (delete-directory ,name :recursive)))) + +(defmacro module--test-assertion (pattern &rest body) + "Test that PATTERN matches the assertion triggered by BODY. +Run Emacs as a subprocess, load the test module `mod-test-file', +and evaluate BODY. Verify that Emacs aborts and prints a module +assertion message that matches PATTERN. PATTERN is evaluated and +must evaluate to a regular expression string." + (declare (indent 1)) + ;; To contain any core dumps. + `(module--with-temp-directory tempdir + (with-temp-buffer + (let* ((default-directory tempdir) + (status (call-process mod-test-emacs nil t nil + "-batch" "-Q" "-module-assertions" "-eval" + ,(prin1-to-string + `(progn + (require 'mod-test ,mod-test-file) + ,@body))))) + (should (stringp status)) + ;; eg "Aborted" or "Abort trap: 6" + (should (string-prefix-p "Abort" status)) + (search-backward "Emacs module assertion: ") + (goto-char (match-end 0)) + (should (string-match-p ,pattern + (buffer-substring-no-properties + (point) (point-max)))))))) + +(ert-deftest module--test-assertions--load-non-live-object () + "Check that -module-assertions verify that non-live objects +aren’t accessed." (skip-unless (file-executable-p mod-test-emacs)) ;; This doesn’t yet cause undefined behavior. (should (eq (mod-test-invalid-store) 123)) - ;; To contain any core dumps. - (let ((tempdir (make-temp-file "emacs-module-test" t))) - (unwind-protect - (with-temp-buffer - (should (string-match-p - "Abort" ; eg "Aborted" or "Abort trap: 6" - (let ((default-directory tempdir)) - (call-process mod-test-emacs nil t nil - "-batch" "-Q" "-module-assertions" "-eval" - (prin1-to-string - `(progn - (require 'mod-test ,mod-test-file) - ;; Storing and reloading a local - ;; value causes undefined behavior, - ;; which should be detected by the - ;; module assertions. - (mod-test-invalid-store) - (mod-test-invalid-load))))))) - (search-backward "Emacs module assertion:") - (should (string-match-p (rx bos "Emacs module assertion: " - "Emacs value not found in " - (+ digit) " values of " - (+ digit) " environments" eos) - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))) - (delete-directory tempdir t)))) + (module--test-assertion (rx "Emacs value not found in " + (+ digit) " values of " + (+ digit) " environments\n" eos) + ;; Storing and reloading a local value causes undefined behavior, + ;; which should be detected by the module assertions. + (mod-test-invalid-store) + (mod-test-invalid-load))) + +(ert-deftest module--test-assertions--call-emacs-from-gc () + "Check that -module-assertions prevents calling Emacs functions +during garbage collection." + (skip-unless (file-executable-p mod-test-emacs)) + (module--test-assertion + (rx "Module function called during garbage collection\n" eos) + (mod-test-invalid-finalizer))) ;;; emacs-module-tests.el ends here -- cgit v1.2.1 From 083940a93df17c6e50d6523e30d56ca3d179f688 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 9 Jul 2017 16:04:02 -0700 Subject: Fix core dump in substitute-object-in-subtree Without this fix, (substitute-object-in-subtree #0=(#0# 'a) 'a) would dump core, since the C code would recurse indefinitely through the infinite structure. This patch adds an argument to the function, and renames it to lread--substitute-object-in-subtree as the function is not general-purpose and should not be relied on by outside code. See Bug#23660. * src/intervals.c (traverse_intervals_noorder): ARG is now void *, not Lisp_Object, so that callers need not cons unnecessarily. All callers changed. Also, remove related #if-0 code that was “temporary” in the early 1990s and has not been compilable for some time. * src/lread.c (struct subst): New type, for substitution closure data. (seen_list): Remove this static var, as this info is now part of struct subst. All uses removed. (Flread__substitute_object_in_subtree): Rename from Fsubstitute_object_in_subtree, and give it a 3rd arg so that it doesn’t dump core when called from the top level with an already-cyclic structure. All callers changed. (SUBSTITUTE): Remove. All callers expanded and then simplified. (substitute_object_recurse): Take a single argument SUBST rather than a pair OBJECT and PLACEHOLDER, so that its address can be passed around as part of a closure; this avoids the need for an AUTO_CONS call. All callers changed. If the COMPLETED component is t, treat every subobject as potentially circular. (substitute_in_interval): Take a struct subst * rather than a Lisp_Object, for the closure data. All callers changed. * test/src/lread-tests.el (lread-lread--substitute-object-in-subtree): New test, to check that the core dump does not reoccur. --- test/src/lread-tests.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'test/src') diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 98cbb6a301d..a0a317feeeb 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -164,4 +164,10 @@ literals (Bug#20852)." (concat (format-message "Loading `%s': " file-name) "old-style backquotes detected!"))))) +(ert-deftest lread-lread--substitute-object-in-subtree () + (let ((x (cons 0 1))) + (setcar x x) + (lread--substitute-object-in-subtree x 1 t) + (should (eq x (cdr x))))) + ;;; lread-tests.el ends here -- cgit v1.2.1 From 273f4bde39af5d87f10fd58f35b666dfa8a996a3 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 9 Jul 2017 16:43:09 -0700 Subject: Fix failing module tests on GNU/Linux * test/src/emacs-module-tests.el (module--test-assertions--load-non-live-object) (module--test-assertions--call-emacs-from-gc): Avoid test failures due to backtraces. --- test/src/emacs-module-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'test/src') diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 988a7a178c6..2aa85f0b247 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -230,7 +230,7 @@ aren’t accessed." (should (eq (mod-test-invalid-store) 123)) (module--test-assertion (rx "Emacs value not found in " (+ digit) " values of " - (+ digit) " environments\n" eos) + (+ digit) " environments\n") ;; Storing and reloading a local value causes undefined behavior, ;; which should be detected by the module assertions. (mod-test-invalid-store) @@ -241,7 +241,7 @@ aren’t accessed." during garbage collection." (skip-unless (file-executable-p mod-test-emacs)) (module--test-assertion - (rx "Module function called during garbage collection\n" eos) + (rx "Module function called during garbage collection\n") (mod-test-invalid-finalizer))) ;;; emacs-module-tests.el ends here -- cgit v1.2.1 From 0bece6c6815cc59e181817a2765a4ea752f34f56 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Fri, 7 Jul 2017 21:21:55 +0200 Subject: Add an optional testfn parameter to assoc * src/fns.c (assoc): New optional testfn parameter used for comparison when provided. * test/src/fns-tests.el (test-assoc-testfn): Add tests for the new 'testfn' parameter. * src/buffer.c: * src/coding.c: * src/dbusbind.c: * src/font.c: * src/fontset.c: * src/gfilenotify.c: * src/image.c: * src/keymap.c: * src/process.c: * src/w32fns.c: * src/w32font.c: * src/w32notify.c: * src/w32term.c: * src/xdisp.c: * src/xfont.c: Add a third argument to Fassoc calls. * etc/NEWS: * doc/lispref/lists.texi: Document the new 'testfn' parameter. --- test/src/fns-tests.el | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'test/src') diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 2e463455f0c..e294859226c 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -373,6 +373,12 @@ (should-error (assoc 3 d1) :type 'wrong-type-argument) (should-error (assoc 3 d2) :type 'wrong-type-argument))) +(ert-deftest test-assoc-testfn () + (let ((alist '(("a" . 1) ("b" . 2)))) + (should-not (assoc "a" alist #'ignore)) + (should (eq (assoc "b" alist #'string-equal) (cadr alist))) + (should-not (assoc "b" alist #'eq)))) + (ert-deftest test-cycle-rassq () (let ((c1 (cyc1 '(0 . 1))) (c2 (cyc2 '(0 . 1) '(0 . 2))) -- cgit v1.2.1 From 8b18911a5c7c6c8a15b3cff12a4376ba68205e1c Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 7 Jun 2017 19:59:09 -0400 Subject: Signal error for symbol names with strange quotes (Bug#2967) * src/lread.c (read1): Signal an error when a symbol starts with a non-escaped quote-like character. * test/src/lread-tests.el (lread-tests--funny-quote-symbols): New test. * etc/NEWS: Announce change. --- test/src/lread-tests.el | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'test/src') diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index a0a317feeeb..dd5a2003b41 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -142,6 +142,23 @@ literals (Bug#20852)." "unescaped character literals " "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) +(ert-deftest lread-tests--funny-quote-symbols () + "Check that 'smart quotes' or similar trigger errors in symbol names." + (dolist (quote-char + '(#x2018 ;; LEFT SINGLE QUOTATION MARK + #x2019 ;; RIGHT SINGLE QUOTATION MARK + #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK + #x201C ;; LEFT DOUBLE QUOTATION MARK + #x201D ;; RIGHT DOUBLE QUOTATION MARK + #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK + #x301E ;; DOUBLE PRIME QUOTATION MARK + #xFF02 ;; FULLWIDTH QUOTATION MARK + #xFF07 ;; FULLWIDTH APOSTROPHE + )) + (let ((str (format "%cfoo" quote-char))) + (should-error (read str) :type 'invalid-read-syntax) + (should (eq (read (concat "\\" str)) (intern str)))))) + (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." (let ((load-path (cons -- cgit v1.2.1