diff options
Diffstat (limited to 'test/src')
39 files changed, 472 insertions, 66 deletions
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index aa1ab1648f8..1324c2d3b4d 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -1,6 +1,6 @@ ;;; alloc-tests.el --- alloc tests -*- lexical-binding: t -*- -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Daniel Colascione <dancol@dancol.org> ;; Keywords: diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index dd8927457ae..123f2e8eabb 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -1,6 +1,6 @@ ;;; buffer-tests.el --- tests for buffer.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el index 42dae424476..0df58877102 100644 --- a/test/src/callint-tests.el +++ b/test/src/callint-tests.el @@ -1,6 +1,6 @@ ;;; callint-tests.el --- unit tests for callint.c -*- lexical-binding: t; -*- -;; Copyright (C) 2018-2020 Free Software Foundation, Inc. +;; Copyright (C) 2018-2021 Free Software Foundation, Inc. ;; Author: Philipp Stephani <phst@google.com> diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el index 1617d5e33d3..7262abbe0d0 100644 --- a/test/src/callproc-tests.el +++ b/test/src/callproc-tests.el @@ -1,6 +1,6 @@ ;;; callproc-tests.el --- callproc.c tests -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el index 3eba4cfd78b..9fa54dcaf43 100644 --- a/test/src/casefiddle-tests.el +++ b/test/src/casefiddle-tests.el @@ -1,6 +1,6 @@ ;;; casefiddle-tests.el --- tests for casefiddle.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2015-2016, 2018-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2016, 2018-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el index 86a0d6ffc1a..5c46627c163 100644 --- a/test/src/charset-tests.el +++ b/test/src/charset-tests.el @@ -1,6 +1,6 @@ ;;; charset-tests.el --- Tests for charset.c -*- lexical-binding: t -*- -;; Copyright 2017-2020 Free Software Foundation, Inc. +;; Copyright 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el index 4d52dc367c8..bf37fb51cf5 100644 --- a/test/src/chartab-tests.el +++ b/test/src/chartab-tests.el @@ -1,6 +1,6 @@ ;;; chartab-tests.el --- Tests for char-tab.c -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; Author: Eli Zaretskii <eliz@gnu.org> @@ -49,5 +49,25 @@ (#xe0e00 . #xe0ef6) ))) +(ert-deftest chartab-test-char-table-p () + (should (char-table-p (make-char-table 'foo))) + (should (not (char-table-p (make-hash-table))))) + +(ert-deftest chartab-test-char-table-subtype () + (should (eq (char-table-subtype (make-char-table 'foo)) 'foo))) + +(ert-deftest chartab-test-char-table-parent () + (should (eq (char-table-parent (make-char-table 'foo)) nil)) + (let ((parent (make-char-table 'foo)) + (child (make-char-table 'bar))) + (set-char-table-parent child parent) + (should (eq (char-table-parent child) parent)))) + +(ert-deftest chartab-test-char-table-extra-slot () + ;; Use any type with extra slots, e.g. 'case-table. + (let ((tbl (make-char-table 'case-table))) + (set-char-table-extra-slot tbl 1 'bar) + (should (eq (char-table-extra-slot tbl 1) 'bar)))) + (provide 'chartab-tests) ;;; chartab-tests.el ends here diff --git a/test/src/cmds-tests.el b/test/src/cmds-tests.el index 302b00c6760..681bfb30164 100644 --- a/test/src/cmds-tests.el +++ b/test/src/cmds-tests.el @@ -1,6 +1,6 @@ ;;; cmds-tests.el --- Testing some Emacs commands -*- lexical-binding: t -*- -;; Copyright (C) 2013-2020 Free Software Foundation, Inc. +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; Author: Nicolas Richard <youngfrog@members.fsf.org> ;; Keywords: diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el index 82883a045c8..0bdcff22ce5 100644 --- a/test/src/coding-tests.el +++ b/test/src/coding-tests.el @@ -1,6 +1,6 @@ ;;; coding-tests.el --- tests for text encoding and decoding -*- lexical-binding: t -*- -;; Copyright (C) 2013-2020 Free Software Foundation, Inc. +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; Author: Eli Zaretskii <eliz@gnu.org> ;; Author: Kenichi Handa <handa@gnu.org> diff --git a/test/src/data-tests.el b/test/src/data-tests.el index c5fc3eaa11a..03d867f18a8 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -1,6 +1,6 @@ ;;; data-tests.el --- tests for src/data.c -*- lexical-binding:t -*- -;; Copyright (C) 2013-2020 Free Software Foundation, Inc. +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el index 0a328396818..67a7fefb05e 100644 --- a/test/src/decompress-tests.el +++ b/test/src/decompress-tests.el @@ -1,6 +1,6 @@ ;;; decompress-tests.el --- Test suite for decompress. -*- lexical-binding: t -*- -;; Copyright (C) 2013-2020 Free Software Foundation, Inc. +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; Author: Lars Ingebrigtsen <larsi@gnus.org> diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index de0aeabfe78..64f9137865b 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -1,6 +1,6 @@ ;;; editfns-tests.el -- tests for editfns.c -*- lexical-binding:t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 30ad352cf8b..ad59cfc18cd 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -1,6 +1,6 @@ /* Test GNU Emacs modules. -Copyright 2015-2020 Free Software Foundation, Inc. +Copyright 2015-2021 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index bf26ffb935c..af5bc2a0baf 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -1,6 +1,6 @@ ;;; emacs-module-tests --- Test GNU Emacs modules. -*- lexical-binding: t; -*- -;; Copyright 2015-2020 Free Software Foundation, Inc. +;; Copyright 2015-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 297db81f5ab..b2b7dfefda5 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -1,6 +1,6 @@ ;;; eval-tests.el --- unit tests for src/eval.c -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; Author: Philipp Stephani <phst@google.com> diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 8d46abf342a..7f193d4eeab 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -1,6 +1,6 @@ ;;; unit tests for src/fileio.c -*- lexical-binding: t; -*- -;; Copyright 2017-2020 Free Software Foundation, Inc. +;; Copyright 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 8c56674d4fd..4a3c03d833e 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -1,6 +1,6 @@ ;;; floatfns-tests.el --- tests for floating point operations -*- lexical-binding: t -*- -;; Copyright 2017-2020 Free Software Foundation, Inc. +;; Copyright 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e66dad44a1a..a9daf878b81 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1,6 +1,6 @@ ;;; fns-tests.el --- tests for src/fns.c -*- lexical-binding:t -*- -;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;; Copyright (C) 2014-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/font-tests.el b/test/src/font-tests.el index cfc6f4c31b7..de153b8de9b 100644 --- a/test/src/font-tests.el +++ b/test/src/font-tests.el @@ -1,6 +1,6 @@ ;;; font-tests.el --- Test suite for font-related functions. -*- lexical-binding: t -*- -;; Copyright (C) 2011-2020 Free Software Foundation, Inc. +;; Copyright (C) 2011-2021 Free Software Foundation, Inc. ;; Author: Chong Yidong <cyd@stupidchicken.com> ;; Keywords: internal diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el index 7d1a6ce6dc3..10f1202949b 100644 --- a/test/src/indent-tests.el +++ b/test/src/indent-tests.el @@ -1,6 +1,6 @@ ;;; indent-tests.el --- tests for src/indent.c -*- lexical-binding:t -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el index d42fe1b0086..5572c7d7a0f 100644 --- a/test/src/inotify-tests.el +++ b/test/src/inotify-tests.el @@ -1,6 +1,6 @@ ;;; inotify-tests.el --- Test suite for inotify. -*- lexical-binding: t -*- -;; Copyright (C) 2012-2020 Free Software Foundation, Inc. +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. ;; Author: Rüdiger Sonderfeld <ruediger@c-plusplus.de> ;; Keywords: internal diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 028f92f29d3..4be11b8c81a 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -1,6 +1,6 @@ ;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*- -;; Copyright (C) 2017-2020 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 970a53555f9..607d2eafd45 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -1,6 +1,6 @@ ;;; keyboard-tests.el --- Tests for keyboard.c -*- lexical-binding: t -*- -;; Copyright (C) 2017-2020 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index f58dac87401..74fb3c892db 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -1,6 +1,6 @@ ;;; keymap-tests.el --- Test suite for src/keymap.c -*- lexical-binding: t -*- -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Juanma Barranquero <lekktu@gmail.com> ;; Stefan Kangas <stefankangas@gmail.com> diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 4430d696807..40a48f1e9bb 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -1,6 +1,6 @@ ;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- -;; Copyright (C) 2017-2020 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 825b74e6234..edf88214f97 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -1,6 +1,6 @@ ;;; lread-tests.el --- tests for lread.c -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; Author: Philipp Stephani <phst@google.com> diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el index 37140f8a10b..234a0b35ea7 100644 --- a/test/src/marker-tests.el +++ b/test/src/marker-tests.el @@ -1,6 +1,6 @@ ;;; marker-tests.el --- tests for marker.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index 13f5fac585b..b9cd255462d 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -1,6 +1,6 @@ ;;; minibuf-tests.el --- tests for minibuf.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/print-tests.el b/test/src/print-tests.el index 202555adb3b..0d2ea6e3834 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -1,6 +1,6 @@ ;;; print-tests.el --- tests for src/print.c -*- lexical-binding: t; -*- -;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;; Copyright (C) 2014-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/process-tests.el b/test/src/process-tests.el index e15ad47f968..cddf955853e 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -1,6 +1,6 @@ ;;; process-tests.el --- Testing the process facilities -*- lexical-binding: t -*- -;; Copyright (C) 2013-2020 Free Software Foundation, Inc. +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -23,8 +23,11 @@ ;;; Code: +(require 'cl-lib) (require 'ert) (require 'puny) +(require 'rx) +(require 'subr-x) ;; Timeout in seconds; the test fails if the timeout is reached. (defvar process-test-sentinel-wait-timeout 2.0) @@ -47,13 +50,15 @@ (ert-deftest process-test-sentinel-accept-process-output () (skip-unless (executable-find "bash")) + (with-timeout (60 (ert-fail "Test timed out")) (should (process-test-sentinel-wait-function-working-p - #'accept-process-output))) + #'accept-process-output)))) (ert-deftest process-test-sentinel-sit-for () (skip-unless (executable-find "bash")) + (with-timeout (60 (ert-fail "Test timed out")) (should - (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t))))) + (process-test-sentinel-wait-function-working-p (lambda () (sit-for 0.01 t)))))) (when (eq system-type 'windows-nt) (ert-deftest process-test-quoted-batfile () @@ -79,6 +84,7 @@ (ert-deftest process-test-stderr-buffer () (skip-unless (executable-find "bash")) + (with-timeout (60 (ert-fail "Test timed out")) (let* ((stdout-buffer (generate-new-buffer "*stdout*")) (stderr-buffer (generate-new-buffer "*stderr*")) (proc (make-process :name "test" @@ -103,10 +109,11 @@ (looking-at "hello stdout!"))) (should (with-current-buffer stderr-buffer (goto-char (point-min)) - (looking-at "hello stderr!"))))) + (looking-at "hello stderr!")))))) (ert-deftest process-test-stderr-filter () (skip-unless (executable-find "bash")) + (with-timeout (60 (ert-fail "Test timed out")) (let* ((sentinel-called nil) (stderr-sentinel-called nil) (stdout-output nil) @@ -145,10 +152,11 @@ (should (equal 1 (with-current-buffer stderr-buffer (point-max)))) (should (equal "hello stderr!\n" - (mapconcat #'identity (nreverse stderr-output) ""))))) + (mapconcat #'identity (nreverse stderr-output) "")))))) (ert-deftest set-process-filter-t () "Test setting process filter to t and back." ;; Bug#36591 + (with-timeout (60 (ert-fail "Test timed out")) (with-temp-buffer (let* ((print-level nil) (print-length nil) @@ -180,11 +188,12 @@ (line-beginning-position) (point-max)) "2> ")) (accept-process-output proc)) ; Read "Two". - (should (equal (buffer-string) "0> one\n1> two\n2> "))))) + (should (equal (buffer-string) "0> one\n1> two\n2> ")))))) (ert-deftest start-process-should-not-modify-arguments () "`start-process' must not modify its arguments in-place." ;; See bug#21831. + (with-timeout (60 (ert-fail "Test timed out")) (let* ((path (pcase system-type ((or 'windows-nt 'ms-dos) ;; Make sure the file name uses forward slashes. @@ -198,11 +207,12 @@ (should (process-live-p (condition-case nil (start-process "" nil path) (error nil)))) - (should (equal path samepath)))) + (should (equal path samepath))))) (ert-deftest make-process/noquery-stderr () "Checks that Bug#30031 is fixed." (skip-unless (executable-find "sleep")) + (with-timeout (60 (ert-fail "Test timed out")) (with-temp-buffer (let* ((previous-processes (process-list)) (process (make-process :name "sleep" @@ -217,7 +227,7 @@ (should new-processes) (dolist (process new-processes) (should-not (process-query-on-exit-flag process)))) - (kill-process process))))) + (kill-process process)))))) ;; Return t if OUTPUT could have been generated by merging the INPUTS somehow. (defun process-tests--mixable (output &rest inputs) @@ -233,6 +243,7 @@ (ert-deftest make-process/mix-stderr () "Check that `make-process' mixes the output streams if STDERR is nil." (skip-unless (executable-find "bash")) + (with-timeout (60 (ert-fail "Test timed out")) ;; Frequent random (?) failures on hydra.nixos.org, with no process output. ;; Maybe this test should be tagged unstable? See bug#31214. (skip-unless (not (getenv "EMACS_HYDRA_CI"))) @@ -251,11 +262,12 @@ (should (eq (process-exit-status process) 0)) (should (process-tests--mixable (string-to-list (buffer-string)) (string-to-list "stdout\n") - (string-to-list "stderr\n")))))) + (string-to-list "stderr\n"))))))) (ert-deftest make-process-w32-debug-spawn-error () "Check that debugger runs on `make-process' failure (Bug#33016)." (skip-unless (eq system-type 'windows-nt)) + (with-timeout (60 (ert-fail "Test timed out")) (let* ((debug-on-error t) (have-called-debugger nil) (debugger (lambda (&rest _) @@ -271,11 +283,12 @@ ;; code. (make-process :name "test" :command '("c:/No-Such-Command")) (error :got-error)))) - (should have-called-debugger))) + (should have-called-debugger)))) (ert-deftest make-process/file-handler/found () - "Check that the ‘:file-handler’ argument of ‘make-process’ + "Check that the `:file-handler’ argument of `make-process’ works as expected if a file name handler is found." + (with-timeout (60 (ert-fail "Test timed out")) (let ((file-handler-calls 0)) (cl-flet ((file-handler (&rest args) @@ -292,27 +305,29 @@ works as expected if a file name handler is found." :command '("/some/binary") :file-handler t) 'fake-process)) - (should (= file-handler-calls 1)))))) + (should (= file-handler-calls 1))))))) (ert-deftest make-process/file-handler/not-found () - "Check that the ‘:file-handler’ argument of ‘make-process’ + "Check that the `:file-handler’ argument of `make-process’ works as expected if no file name handler is found." + (with-timeout (60 (ert-fail "Test timed out")) (let ((file-name-handler-alist ()) (default-directory invocation-directory) (program (expand-file-name invocation-name invocation-directory))) (should (processp (make-process :name "name" :command (list program "--version") - :file-handler t))))) + :file-handler t)))))) (ert-deftest make-process/file-handler/disable () - "Check ‘make-process’ works as expected if it shouldn’t use the + "Check `make-process’ works as expected if it shouldn’t use the file name handler." + (with-timeout (60 (ert-fail "Test timed out")) (let ((file-name-handler-alist (list (cons (rx bos "test-handler:") #'process-tests--file-handler))) (default-directory "test-handler:/dir/") (program (expand-file-name invocation-name invocation-directory))) (should (processp (make-process :name "name" - :command (list program "--version")))))) + :command (list program "--version"))))))) (defun process-tests--file-handler (operation &rest _args) (cl-ecase operation @@ -325,48 +340,419 @@ file name handler." (ert-deftest make-process/stop () "Check that `make-process' doesn't accept a `:stop' key. See Bug#30460." + (with-timeout (60 (ert-fail "Test timed out")) (should-error (make-process :name "test" :command (list (expand-file-name invocation-name invocation-directory)) - :stop t))) + :stop t)))) ;; All the following tests require working DNS, which appears not to ;; be the case for hydra.nixos.org, so disable them there for now. (ert-deftest lookup-family-specification () - "network-lookup-address-info should only accept valid family symbols." + "`network-lookup-address-info' should only accept valid family symbols." (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (with-timeout (60 (ert-fail "Test timed out")) (should-error (network-lookup-address-info "google.com" 'both)) (should (network-lookup-address-info "google.com" 'ipv4)) (when (featurep 'make-network-process '(:family ipv6)) - (should (network-lookup-address-info "google.com" 'ipv6)))) + (should (network-lookup-address-info "google.com" 'ipv6))))) (ert-deftest lookup-unicode-domains () - "Unicode domains should fail" + "Unicode domains should fail." (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (with-timeout (60 (ert-fail "Test timed out")) (should-error (network-lookup-address-info "faß.de")) - (should (network-lookup-address-info (puny-encode-domain "faß.de")))) + (should (network-lookup-address-info (puny-encode-domain "faß.de"))))) (ert-deftest unibyte-domain-name () - "Unibyte domain names should work" + "Unibyte domain names should work." (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - (should (network-lookup-address-info (string-to-unibyte "google.com")))) + (with-timeout (60 (ert-fail "Test timed out")) + (should (network-lookup-address-info (string-to-unibyte "google.com"))))) (ert-deftest lookup-google () - "Check that we can look up google IP addresses" + "Check that we can look up google IP addresses." (skip-unless (not (getenv "EMACS_HYDRA_CI"))) + (with-timeout (60 (ert-fail "Test timed out")) (let ((addresses-both (network-lookup-address-info "google.com")) (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))) (should addresses-both) (should addresses-v4)) (when (featurep 'make-network-process '(:family ipv6)) - (should (network-lookup-address-info "google.com" 'ipv6)))) + (should (network-lookup-address-info "google.com" 'ipv6))))) (ert-deftest non-existent-lookup-failure () + "Check that looking up non-existent domain returns nil." (skip-unless (not (getenv "EMACS_HYDRA_CI"))) - "Check that looking up non-existent domain returns nil" - (should (eq nil (network-lookup-address-info "emacs.invalid")))) + (with-timeout (60 (ert-fail "Test timed out")) + (should (eq nil (network-lookup-address-info "emacs.invalid"))))) + +(defmacro process-tests--ignore-EMFILE (&rest body) + "Evaluate BODY, ignoring EMFILE errors." + (declare (indent 0) (debug t)) + (let ((err (make-symbol "err")) + (message (make-symbol "message"))) + `(let ((,message (process-tests--EMFILE-message))) + (condition-case ,err + ,(macroexp-progn body) + (file-error + ;; If we couldn't determine the EMFILE message, just ignore + ;; all `file-error' signals. + (and ,message + (not (string-equal (caddr ,err) ,message)) + (signal (car ,err) (cdr ,err)))))))) + +(defmacro process-tests--with-buffers (var &rest body) + "Bind VAR to nil and evaluate BODY. +Afterwards, kill all buffers in the list VAR. BODY should add +some buffer objects to VAR." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + `(let ((,var nil)) + (unwind-protect + ,(macroexp-progn body) + (mapc #'kill-buffer ,var)))) + +(defmacro process-tests--with-processes (var &rest body) + "Bind VAR to nil and evaluate BODY. +Afterwards, delete all processes in the list VAR. BODY should +add some process objects to VAR." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + `(let ((,var nil)) + (unwind-protect + ,(macroexp-progn body) + (mapc #'delete-process ,var)))) + +(defmacro process-tests--with-raised-rlimit (&rest body) + "Evaluate BODY using a higher limit for the number of open files. +Attempt to set the resource limit for the number of open files +temporarily to the highest possible value." + (declare (indent 0) (debug t)) + (let ((prlimit (make-symbol "prlimit")) + (soft (make-symbol "soft")) + (hard (make-symbol "hard")) + (pid-arg (make-symbol "pid-arg"))) + `(let ((,prlimit (executable-find "prlimit")) + (,pid-arg (format "--pid=%d" (emacs-pid))) + (,soft nil) (,hard nil)) + (cl-flet ((set-limit + (value) + (cl-check-type value natnum) + (when ,prlimit + (call-process ,prlimit nil nil nil + ,pid-arg + (format "--nofile=%d:" value))))) + (when ,prlimit + (with-temp-buffer + (when (eql (call-process ,prlimit nil t nil + ,pid-arg "--nofile" + "--raw" "--noheadings" + "--output=SOFT,HARD") + 0) + (goto-char (point-min)) + (when (looking-at (rx (group (+ digit)) (+ blank) + (group (+ digit)) ?\n)) + (setq ,soft (string-to-number + (match-string-no-properties 1)) + ,hard (string-to-number + (match-string-no-properties 2)))))) + (and ,soft ,hard (< ,soft ,hard) + (set-limit ,hard))) + (unwind-protect + ,(macroexp-progn body) + (when ,soft (set-limit ,soft))))))) + +(defmacro process-tests--fd-setsize-test (&rest body) + "Run BODY as a test for FD_SETSIZE overflow. +Try to generate pipe processes until we are close to the +FD_SETSIZE limit. Within BODY, only a small number of file +descriptors should still be available. Furthermore, raise the +maximum number of open files in the Emacs process above +FD_SETSIZE." + (declare (indent 0) (debug t)) + (let ((process (make-symbol "process")) + (processes (make-symbol "processes")) + (buffer (make-symbol "buffer")) + (buffers (make-symbol "buffers")) + ;; FD_SETSIZE is typically 1024 on Unix-like systems. On + ;; MS-Windows we artificially limit FD_SETSIZE to 64, see the + ;; commentary in w32proc.c. + (fd-setsize (if (eq system-type 'windows-nt) 64 1024))) + `(process-tests--with-raised-rlimit + (process-tests--with-buffers ,buffers + (process-tests--with-processes ,processes + ;; First, allocate enough pipes to definitely exceed the + ;; FD_SETSIZE limit. + (cl-loop for i from 1 to ,(1+ fd-setsize) + for ,buffer = (generate-new-buffer + (format " *pipe %d*" i)) + do (push ,buffer ,buffers) + for ,process = (process-tests--ignore-EMFILE + (make-pipe-process + :name (format "pipe %d" i) + ;; Prevent delete-process from + ;; trying to read from pipe + ;; processes that didn't exit + ;; yet, because no one is + ;; writing to those pipes, and + ;; the read will stall. + :stop (eq system-type 'windows-nt) + :buffer ,buffer + :coding 'no-conversion + :noquery t)) + while ,process + do (push ,process ,processes)) + (unless (cddr ,processes) + (ert-fail "Couldn't allocate enough pipes")) + ;; Delete two pipes to test more edge cases. + (delete-process (pop ,processes)) + (delete-process (pop ,processes)) + ,@body))))) + +(defmacro process-tests--with-temp-file (var &rest body) + "Bind VAR to the name of a new regular file and evaluate BODY. +Afterwards, delete the file." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + (let ((file (make-symbol "file"))) + `(let ((,file (make-temp-file "emacs-test-"))) + (unwind-protect + (let ((,var ,file)) + ,@body) + (delete-file ,file))))) + +(defmacro process-tests--with-temp-directory (var &rest body) + "Bind VAR to the name of a new directory and evaluate BODY. +Afterwards, delete the directory." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + (let ((dir (make-symbol "dir"))) + `(let ((,dir (make-temp-file "emacs-test-" :dir))) + (unwind-protect + (let ((,var ,dir)) + ,@body) + (delete-directory ,dir :recursive))))) + +;; Tests for FD_SETSIZE overflow (Bug#24325). The following tests +;; generate lots of process objects of the various kinds. Running the +;; tests with assertions enabled should not result in any crashes due +;; to file descriptor set overflow. These tests first generate lots +;; of unused pipe processes to fill up the file descriptor space. +;; Then, they create a few instances of the process type under test. + +(ert-deftest process-tests/fd-setsize-no-crash/make-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (with-timeout (60 (ert-fail "Test timed out")) + (let ((sleep (executable-find "sleep"))) + (skip-unless sleep) + (dolist (conn-type '(pipe pty)) + (ert-info ((format "Connection type `%s'" conn-type)) + (process-tests--fd-setsize-test + (process-tests--with-processes processes + ;; Start processes until we exhaust the file descriptor + ;; set size. We assume that each process requires at + ;; least one file descriptor. + (dotimes (i 10) + (let ((process + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we + ;; ignore `file-error'. + (process-tests--ignore-EMFILE + (make-process :name (format "test %d" i) + :command (list sleep "5") + :connection-type conn-type + :coding 'no-conversion + :noquery t)))) + (when process (push process processes)))) + ;; We should have managed to start at least one process. + (should processes) + (dolist (process processes) + (while (accept-process-output process)) + (should (eq (process-status process) 'exit)) + ;; If there's an error between fork and exec, Emacs + ;; will use exit statuses between 125 and 127, see + ;; process.h. This can happen if the child process + ;; tries to set up terminal device but fails due to + ;; file number limits. We don't treat this as an + ;; error. + (should (memql (process-exit-status process) + '(0 125 126 127))))))))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-pipe-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (with-timeout (60 (ert-fail "Test timed out")) + (process-tests--fd-setsize-test + (process-tests--with-buffers buffers + (process-tests--with-processes processes + ;; Start processes until we exhaust the file descriptor set + ;; size. We assume that each process requires at least one + ;; file descriptor. + (dotimes (i 10) + (let ((buffer (generate-new-buffer (format " *%d*" i)))) + (push buffer buffers) + (let ((process + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we ignore + ;; `file-error'. + (process-tests--ignore-EMFILE + (make-pipe-process :name (format "test %d" i) + :buffer buffer + :coding 'no-conversion + :noquery t)))) + (when process (push process processes))))) + ;; We should have managed to start at least one process. + (should processes)))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-network-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (skip-unless (featurep 'make-network-process '(:server t))) + (skip-unless (featurep 'make-network-process '(:family local))) + (with-timeout (60 (ert-fail "Test timed out")) + (process-tests--with-temp-directory directory + (process-tests--with-processes processes + (let* ((num-clients 10) + (socket-name (expand-file-name "socket" directory)) + ;; Run a UNIX server to connect to. + (server (make-network-process :name "server" + :server num-clients + :buffer nil + :service socket-name + :family 'local + :coding 'no-conversion + :noquery t))) + (push server processes) + (process-tests--fd-setsize-test + ;; Start processes until we exhaust the file descriptor + ;; set size. We assume that each process requires at + ;; least one file descriptor. + (dotimes (i num-clients) + (let ((client + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we ignore + ;; `file-error'. + (process-tests--ignore-EMFILE + (make-network-process + :name (format "client %d" i) + :service socket-name + :family 'local + :coding 'no-conversion + :noquery t)))) + (when client (push client processes)))) + ;; We should have managed to start at least one process. + (should processes))))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (with-timeout (60 (ert-fail "Test timed out")) + (skip-unless (file-executable-p shell-file-name)) + (skip-unless (executable-find "tty")) + (skip-unless (executable-find "sleep")) + ;; `process-tests--new-pty' probably only works with GNU Bash. + (skip-unless (string-equal + (file-name-nondirectory shell-file-name) "bash")) + (process-tests--with-processes processes + ;; In order to use `make-serial-process', we need to create some + ;; pseudoterminals. The easiest way to do that is to start a + ;; normal process using the `pty' connection type. We need to + ;; ensure that the terminal stays around while we connect to it. + ;; Create the host processes before the dummy pipes so we have a + ;; high chance of succeeding here. + (let ((tty-names ())) + (dotimes (_ 10) + (cl-destructuring-bind + (host tty-name) (process-tests--new-pty) + (should (processp host)) + (push host processes) + (should tty-name) + (should (file-exists-p tty-name)) + (push tty-name tty-names))) + (process-tests--fd-setsize-test + (process-tests--with-processes processes + (process-tests--with-buffers buffers + (dolist (tty-name tty-names) + (let ((buffer (generate-new-buffer + (format " *%s*" tty-name)))) + (push buffer buffers) + ;; Failure to allocate more file descriptors should + ;; signal `file-error', but not crash. Since we + ;; don't know the exact limit, we ignore + ;; `file-error'. + (let ((process (process-tests--ignore-EMFILE + (make-serial-process + :name (format "test %s" tty-name) + :port tty-name + :speed 9600 + :buffer buffer + :coding 'no-conversion + :noquery t)))) + (when process (push process processes)))))) + ;; We should have managed to start at least one process. + (should processes))))))) + +(defvar process-tests--EMFILE-message :unknown + "Cached result of the function `process-tests--EMFILE-message'.") + +(defun process-tests--EMFILE-message () + "Return the error message for the EMFILE POSIX error. +Return nil if that can't be determined." + (when (eq process-tests--EMFILE-message :unknown) + (setq process-tests--EMFILE-message + (with-temp-buffer + (when (eql (ignore-error 'file-error + (call-process "errno" nil t nil "EMFILE")) + 0) + (goto-char (point-min)) + (when (looking-at (rx "EMFILE" (+ blank) (+ digit) + (+ blank) (group (+ nonl)))) + (match-string-no-properties 1)))))) + process-tests--EMFILE-message) + +(defun process-tests--new-pty () + "Allocate a new pseudoterminal. +Return a list (PROCESS TTY-NAME)." + ;; The command below will typically only work with GNU Bash. + (should (string-equal (file-name-nondirectory shell-file-name) + "bash")) + (process-tests--with-temp-file temp-file + (should-not (file-remote-p temp-file)) + (let* ((command (list shell-file-name shell-command-switch + (format "tty > %s && sleep 60" + (shell-quote-argument + (file-name-unquote temp-file))))) + (process (make-process :name "tty host" + :command command + :buffer nil + :coding 'utf-8-unix + :connection-type 'pty + :noquery t)) + (tty-name nil) + (coding-system-for-read 'utf-8-unix) + (coding-system-for-write 'utf-8-unix)) + ;; Wait until TTY name has arrived. + (with-timeout (2 (message "Timed out waiting for TTY name")) + (while (and (process-live-p process) (not tty-name)) + (sleep-for 0.1) + (when-let ((attributes (file-attributes temp-file))) + (when (cl-plusp (file-attribute-size attributes)) + (with-temp-buffer + (insert-file-contents temp-file) + (goto-char (point-max)) + ;; `tty' has printed a trailing newline. + (skip-chars-backward "\n") + (unless (bobp) + (setq tty-name (buffer-substring-no-properties + (point-min) (point))))))))) + (list process tty-name)))) (provide 'process-tests) -;; process-tests.el ends here. +;;; process-tests.el ends here diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index 34d4067db47..0607eacf397 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -1,6 +1,6 @@ ;;; regex-emacs-tests.el --- tests for regex-emacs.c -*- lexical-binding: t -*- -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index edee01ec585..479b818935f 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el @@ -1,6 +1,6 @@ ;;; syntax-tests.el --- tests for syntax.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2017-2020 Free Software Foundation, Inc. +;; Copyright (C) 2017-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el index 365d2c7a7b7..b083588e645 100644 --- a/test/src/textprop-tests.el +++ b/test/src/textprop-tests.el @@ -1,6 +1,6 @@ ;;; textprop-tests.el --- Test suite for text properties. -*- lexical-binding: t -*- -;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Copyright (C) 2015-2021 Free Software Foundation, Inc. ;; Author: Wolfgang Jenkner <wjenkner@inode.at> ;; Keywords: internal diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index df34a2b66eb..f14d2426ef0 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -1,6 +1,6 @@ ;;; threads.el --- tests for threads. -*- lexical-binding: t -*- -;; Copyright (C) 2012-2020 Free Software Foundation, Inc. +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index b35a5287946..e55bd1eb4ee 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -1,6 +1,6 @@ ;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*- -;; Copyright (C) 2016-2020 Free Software Foundation, Inc. +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index 182e2df93bc..055bf102dfc 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -1,6 +1,6 @@ ;;; undo-tests.el --- Tests of primitive-undo -*- lexical-binding: t -*- -;; Copyright (C) 2012-2020 Free Software Foundation, Inc. +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. ;; Author: Aaron S. Hawley <aaron.s.hawley@gmail.com> diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el index a7e05a57de9..d13ce77a997 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -1,6 +1,6 @@ ;;; xdisp-tests.el --- tests for xdisp.c functions -*- lexical-binding: t -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el index bde3a354229..0a7ef55b2b6 100644 --- a/test/src/xfaces-tests.el +++ b/test/src/xfaces-tests.el @@ -1,6 +1,6 @@ ;;; xfaces-tests.el --- tests for xfaces.c -*- lexical-binding: t -*- -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020-2021 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el index 800f400b3ca..632cf965fa2 100644 --- a/test/src/xml-tests.el +++ b/test/src/xml-tests.el @@ -1,6 +1,6 @@ ;;; xml-tests.el --- Test suite for libxml parsing. -*- lexical-binding: t -*- -;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;; Copyright (C) 2014-2021 Free Software Foundation, Inc. ;; Author: Ulf Jasper <ulf.jasper@web.de> ;; Keywords: internal |