diff options
Diffstat (limited to 'test/lisp')
| -rw-r--r-- | test/lisp/emacs-lisp/backquote-tests.el | 47 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/backtrace-tests.el | 49 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-print-tests.el | 115 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 21 | ||||
| -rw-r--r-- | test/lisp/progmodes/python-tests.el | 13 | ||||
| -rw-r--r-- | test/lisp/replace-tests.el | 18 | ||||
| -rw-r--r-- | test/lisp/shadowfile-tests.el | 13 |
7 files changed, 145 insertions, 131 deletions
diff --git a/test/lisp/emacs-lisp/backquote-tests.el b/test/lisp/emacs-lisp/backquote-tests.el new file mode 100644 index 00000000000..01f2c4a897e --- /dev/null +++ b/test/lisp/emacs-lisp/backquote-tests.el @@ -0,0 +1,47 @@ +;;; backquote-tests.el --- Tests for backquote.el -*- lexical-binding: t -*- + +;; Copyright (C) 2019 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'ert) + +(ert-deftest backquote-test-basic () + (let ((lst '(ba bb bc)) + (vec [ba bb bc])) + (should (equal 3 `,(eval '(+ x y) '((x . 1) (y . 2))))) + (should (equal vec `[,@lst])) + (should (equal `(a lst c) '(a lst c))) + (should (equal `(a ,lst c) '(a (ba bb bc) c))) + (should (equal `(a ,@lst c) '(a ba bb bc c))) + ;; Vectors work just like lists. + (should (equal `(a vec c) '(a vec c))) + (should (equal `(a ,vec c) '(a [ba bb bc] c))) + (should (equal `(a ,@vec c) '(a ba bb bc c))))) + +(ert-deftest backquote-test-nested () + "Test nested backquotes." + (let ((lst '(ba bb bc)) + (vec [ba bb bc])) + (should (equal `(a ,`(,@lst) c) `(a ,lst c))) + (should (equal `(a ,`[,@lst] c) `(a ,vec c))) + (should (equal `(a ,@`[,@lst] c) `(a ,@lst c))))) + +;;; backquote-tests.el ends here diff --git a/test/lisp/emacs-lisp/backtrace-tests.el b/test/lisp/emacs-lisp/backtrace-tests.el index ce827e0166f..be154953423 100644 --- a/test/lisp/emacs-lisp/backtrace-tests.el +++ b/test/lisp/emacs-lisp/backtrace-tests.el @@ -335,6 +335,55 @@ line contains the strings \"lambda\" and \"number\"." (should (string-match-p results (backtrace-tests--get-substring (point-min) (point-max))))))) +(ert-deftest backtrace-tests--print-gensym () + "Backtrace buffers can toggle `print-gensym' syntax." + (ert-with-test-buffer (:name "print-gensym") + (let* ((print-gensym nil) + (arg (list (gensym "first") (gensym) (gensym "last"))) + (results (backtrace-tests--make-regexp + (backtrace-tests--result arg))) + (results-gensym (regexp-quote (let ((print-gensym t)) + (backtrace-tests--result arg)))) + (last-frame (backtrace-tests--make-regexp + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))) + (last-frame-gensym (regexp-quote + (let ((print-gensym t)) + (format (nth (1- backtrace-tests--line-count) + (backtrace-tests--backtrace-lines)) + arg))))) + (backtrace-tests--make-backtrace arg) + (backtrace-print) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Go to the last frame. + (goto-char (point-max)) + (forward-line -1) + ;; Turn on print-gensym for that frame. + (backtrace-toggle-print-gensym) + (should (string-match-p last-frame-gensym + (backtrace-tests--get-substring (point) (point-max)))) + ;; Turn off print-gensym for the frame. + (backtrace-toggle-print-gensym) + (should (string-match-p last-frame + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-gensym on for the buffer. + (backtrace-toggle-print-gensym '(4)) + (should (string-match-p last-frame-gensym + (backtrace-tests--get-substring (point) (point-max)))) + (should (string-match-p results-gensym + (backtrace-tests--get-substring (point-min) (point-max)))) + ;; Turn print-gensym off. + (backtrace-toggle-print-gensym '(4)) + (should (string-match-p last-frame + (backtrace-tests--get-substring + (point) (+ (point) (length last-frame))))) + (should (string-match-p results + (backtrace-tests--get-substring (point-min) (point-max))))))) + (defun backtrace-tests--make-regexp (str) "Make regexp from STR for `backtrace-tests--print-circle'. Used for results of printing circular objects without diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 406c528dce5..31d79df71b5 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -19,109 +19,17 @@ ;;; Commentary: +;; See test/src/print-tests.el for tests which apply to both +;; cl-print.el and src/print.c. + ;;; Code: (require 'ert) -(cl-defstruct cl-print--test a b) - -(ert-deftest cl-print-tests-1 () - "Test cl-print code." - (let ((x (make-cl-print--test :a 1 :b 2))) - (let ((print-circle nil)) - (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) - "((x . #s(cl-print--test :a 1 :b 2)) (y . #s(cl-print--test :a 1 :b 2)))"))) - (let ((print-circle t)) - (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) - "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) - (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^)]*)\\'" - (cl-prin1-to-string (symbol-function #'caar)))))) - -(ert-deftest cl-print-tests-2 () - (let ((x (record 'foo 1 2 3))) - (should (equal - x - (car (read-from-string (with-output-to-string (prin1 x)))))) - (let ((print-circle t)) - (should (string-match - "\\`(#1=#s(foo 1 2 3) #1#)\\'" - (cl-prin1-to-string (list x x))))))) - (cl-defstruct (cl-print-tests-struct (:constructor cl-print-tests-con)) a b c d e) -(ert-deftest cl-print-tests-3 () - "CL printing observes `print-length'." - (let ((long-list (make-list 5 'a)) - (long-vec (make-vector 5 'b)) - (long-struct (cl-print-tests-con)) - (long-string (make-string 5 ?a)) - (print-length 4)) - (should (equal "(a a a a ...)" (cl-prin1-to-string long-list))) - (should (equal "[b b b b ...]" (cl-prin1-to-string long-vec))) - (should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" - (cl-prin1-to-string long-struct))) - (should (equal "\"aaaa...\"" (cl-prin1-to-string long-string))))) - -(ert-deftest cl-print-tests-4 () - "CL printing observes `print-level'." - (let* ((deep-list '(a (b (c (d (e)))))) - (buried-vector '(a (b (c (d [e]))))) - (deep-struct (cl-print-tests-con)) - (buried-struct `(a (b (c (d ,deep-struct))))) - (buried-string '(a (b (c (d #("hello" 0 5 (cl-print-test t))))))) - (buried-simple-string '(a (b (c (d "hello"))))) - (print-level 4)) - (setf (cl-print-tests-struct-a deep-struct) deep-list) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-vector))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-struct))) - (should (equal "(a (b (c (d ...))))" (cl-prin1-to-string buried-string))) - (should (equal "(a (b (c (d \"hello\"))))" - (cl-prin1-to-string buried-simple-string))) - (should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)" - (cl-prin1-to-string deep-struct))))) - -(ert-deftest cl-print-tests-5 () - "CL printing observes `print-quoted'." - (let ((quoted-stuff '('a #'b `(,c ,@d)))) - (let ((print-quoted t)) - (should (equal "('a #'b `(,c ,@d))" - (cl-prin1-to-string quoted-stuff)))) - (let ((print-quoted nil)) - (should (equal "((quote a) (function b) (\\` ((\\, c) (\\,@ d))))" - (cl-prin1-to-string quoted-stuff)))))) - -(ert-deftest cl-print-tests-strings () - "CL printing prints strings and propertized strings." - (let* ((str1 "abcdefghij") - (str2 #("abcdefghij" 3 6 (bold t) 7 9 (italic t))) - (str3 #("abcdefghij" 0 10 (test t))) - (obj '(a b)) - ;; Since the byte compiler reuses string literals, - ;; and the put-text-property call is destructive, use - ;; copy-sequence to make a new string. - (str4 (copy-sequence "abcdefghij"))) - (put-text-property 0 5 'test obj str4) - (put-text-property 7 10 'test obj str4) - - (should (equal "\"abcdefghij\"" (cl-prin1-to-string str1))) - (should (equal "#(\"abcdefghij\" 3 6 (bold t) 7 9 (italic t))" - (cl-prin1-to-string str2))) - (should (equal "#(\"abcdefghij\" 0 10 (test t))" - (cl-prin1-to-string str3))) - (let ((print-circle nil)) - (should - (equal - "#(\"abcdefghij\" 0 5 (test (a b)) 7 10 (test (a b)))" - (cl-prin1-to-string str4)))) - (let ((print-circle t)) - (should - (equal - "#(\"abcdefghij\" 0 5 (test #1=(a b)) 7 10 (test #1#))" - (cl-prin1-to-string str4)))))) - (ert-deftest cl-print-tests-ellipsis-cons () "Ellipsis expansion works in conses." (let ((print-length 4) @@ -216,23 +124,6 @@ (should (string-match expanded (with-output-to-string (cl-print-expand-ellipsis value nil)))))) -(ert-deftest cl-print-circle () - (let ((x '(#1=(a . #1#) #1#))) - (let ((print-circle nil)) - (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" - (cl-prin1-to-string x)))) - (let ((print-circle t)) - (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x)))))) - -(ert-deftest cl-print-circle-2 () - ;; Bug#31146. - (let ((x '(0 . #1=(0 . #1#)))) - (let ((print-circle nil)) - (should (string-match "\\`(0 0 . #[0-9])\\'" - (cl-prin1-to-string x)))) - (let ((print-circle t)) - (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x)))))) - (ert-deftest cl-print-tests-print-to-string-with-limit () (let* ((thing10 (make-list 10 'a)) (thing100 (make-list 100 'a)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dd6b9edd000..d7e0a045106 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2412,9 +2412,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless (and (tramp--test-nextcloud-p) - (or (not (file-remote-p source)) - (not (file-remote-p target)))) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -2437,8 +2435,7 @@ This checks also `file-name-as-directory', `file-name-directory', (unwind-protect ;; FIXME: This fails on my QNAP server, see ;; /share/Web/owncloud/data/owncloud.log - (unless - (and (tramp--test-nextcloud-p) (not (file-remote-p source))) + (unless (tramp--test-nextcloud-p) (make-directory source) (should (file-directory-p source)) (write-region "foo" nil (expand-file-name "foo" source)) @@ -4407,7 +4404,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "foo" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))))) + (format "echo -n ${%s:-bla}" envvar)))))) (unwind-protect ;; Set the empty value. @@ -4419,7 +4416,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "bla" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) ;; Variable is set. (should (string-match @@ -4441,7 +4438,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "foo" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) (let ((process-environment (cons envvar process-environment))) ;; Variable is unset. @@ -4450,12 +4447,14 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "bla" (funcall this-shell-command-to-string - (format "echo -n ${%s:?bla}" envvar)))) + (format "echo -n ${%s:-bla}" envvar)))) ;; Variable is unset. (should-not (string-match (regexp-quote envvar) - (funcall this-shell-command-to-string "env"))))))))) + ;; We must remove PS1, the output is truncated otherwise. + (funcall + this-shell-command-to-string "printenv | grep -v PS1"))))))))) ;; This test is inspired by Bug#27009. (ert-deftest tramp-test33-environment-variables-and-port-numbers () @@ -5303,7 +5302,7 @@ This requires restrictions of file name syntax." ;; of process output. So we unset it temporarily. (setenv "PS1") (with-temp-buffer - (should (zerop (process-file "env" nil t nil))) + (should (zerop (process-file "printenv" nil t nil))) (goto-char (point-min)) (should (re-search-forward diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index b1cf7e8806a..c5ad1dfb862 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -1351,7 +1351,7 @@ this is an arbitrarily expected))))) -;;; Autofill +;;; Filling (ert-deftest python-auto-fill-docstring () (python-tests-with-temp-buffer @@ -1368,6 +1368,17 @@ def some_function(arg1, (forward-line 1) (should (= docindent (current-indentation)))))) +(ert-deftest python-fill-docstring () + (python-tests-with-temp-buffer + "\ +r'''aaa + +this is a test this is a test this is a test this is a test this is a test this is a test. +'''" + (search-forward "test.") + (fill-paragraph) + (should (= (current-indentation) 0)))) + ;;; Mark diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index f7bf2d93658..f42d47c2bfb 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -514,7 +514,9 @@ Return the last evalled form in BODY." (should (replace-tests-with-undo input "theorem \\([0-9]+\\)" - "theorem \\\\ref{theo_\\1}" + '(replace-eval-replacement + replace-quote + (format "theorem \\\\ref{theo_%d}" (1+ (string-to-number (match-string 1))))) ((?\s . (1 2)) (?U . (3))) ?q (string= input (buffer-string))))) @@ -530,4 +532,18 @@ Return the last evalled form in BODY." ?q (string= expected (buffer-string)))))) +(ert-deftest query-replace-undo-bug37287 () + "Test for https://debbugs.gnu.org/37287 ." + (let ((input "foo-1\nfoo-2\nfoo-3") + (expected "foo-2\nfoo-2\nfoo-3")) + (should + (replace-tests-with-undo + input "\\([0-9]\\)" + '(replace-eval-replacement + replace-quote + (format "%d" (1+ (string-to-number (match-string 1))))) + ((?\s . (1 2 4)) (?U . (3))) + ?q + (string= expected (buffer-string)))))) + ;;; replace-tests.el ends here diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index a93664f6536..7caddc53d75 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -64,9 +64,14 @@ "Temporary directory for Tramp tests.") (setq password-cache-expiry nil - shadow-debug t + shadow-debug nil tramp-verbose 0 - tramp-message-show-message nil) + tramp-message-show-message nil + ;; On macOS, `temporary-file-directory' is a symlinked directory. + temporary-file-directory (file-truename temporary-file-directory) + shadow-test-remote-temporary-file-directory + (ignore-errors + (file-truename shadow-test-remote-temporary-file-directory))) ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") @@ -718,8 +723,6 @@ guaranteed by the originator of a cluster definition." (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) - (shadow-test-remote-temporary-file-directory - (file-truename shadow-test-remote-temporary-file-directory)) shadow-clusters shadow-literal-groups shadow-regexp-groups shadow-files-to-copy cluster1 cluster2 primary regexp file) @@ -858,8 +861,6 @@ guaranteed by the originator of a cluster definition." (shadow-info-file shadow-test-info-file) (shadow-todo-file shadow-test-todo-file) (shadow-inhibit-message t) - (shadow-test-remote-temporary-file-directory - (file-truename shadow-test-remote-temporary-file-directory)) (shadow-noquery t) shadow-clusters shadow-files-to-copy cluster1 cluster2 primary regexp file mocked-input) |