Merge branch 'master' into scratch/org-mode-merge

5 files changed, 285 insertions, 99 deletions

diff --git a/test/Makefile.in b/test/Makefile.in
index 414eca90564..11373db8ca9 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -147,7 +147,8 @@ endif
 %.log: %.elc
         $(AM_V_at)${MKDIR_P} $(dir $@)
         $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \
-          --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG}
+          --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \
+          $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG})
 
 ifeq (@HAVE_MODULES@, yes)
 maybe_exclude_module_tests :=
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 78a37650619..6f63d30e755 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -593,5 +593,121 @@ baz\"\""
   :bindings '((electric-quote-string . t))
   :test-in-comments nil :test-in-strings nil)
 
+(define-electric-pair-test electric-quote-opening-single
+  "" "`" :expected-string "‘" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-single
+  "" "'" :expected-string "’" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-opening-double
+  "‘" "-`" :expected-string "“" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-double
+  "’" "-'" :expected-string "”" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-backtick
+  "" "`" :expected-string "`" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-single
+  "" "'" :expected-string "‘" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-double
+  "‘" "-'" :expected-string "“" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-single
+  "a\n" "--'" :expected-string "a\n‘" :expected-point 4
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-double
+  "a\n‘" "---'" :expected-string "a\n“" :expected-point 4
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-single
+  " " "-'" :expected-string " ‘" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-double
+  " ‘" "--'" :expected-string " “" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-single
+  "a" "-'" :expected-string "a’" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-double
+  "a’" "--'" :expected-string "a”" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-single
+  "(" "-'" :expected-string "(‘" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-double
+  "(‘" "--'" :expected-string "(“" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-context-sensitive . t))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-markdown-in-text
+  "" "'" :expected-string "’" :expected-point 2
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-code-faces font-lock-constant-face))
+  :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-markdown-in-code
+  #("`a`" 1 2 (face font-lock-constant-face)) "-'"
+  :expected-string "`'a`" :expected-point 3
+  :modes '(text-mode)
+  :fixture-fn #'electric-quote-local-mode
+  :bindings '((electric-quote-code-faces font-lock-constant-face))
+  :test-in-comments nil :test-in-strings nil)
+
 (provide 'electric-tests)
 ;;; electric-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index dfbe18d7844..6448a1b37f7 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -34,7 +34,7 @@
     (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) .*\n\n.*)\\'"
+    (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'"
                           (cl-prin1-to-string (symbol-function #'caar))))))
 
 (ert-deftest cl-print-tests-2 ()
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index fc5790c3659..317838b250f 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -367,12 +367,8 @@ This macro is used to test if macroexpansion in `should' works."
          (test (make-ert-test :body test-body))
          (result (ert-run-test test)))
     (should (ert-test-failed-p result))
-    (with-temp-buffer
-      (ert--print-backtrace (ert-test-failed-backtrace result))
-      (goto-char (point-min))
-      (end-of-line)
-      (let ((first-line (buffer-substring-no-properties (point-min) (point))))
-        (should (equal first-line (format "  %S()" test-body)))))))
+    (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
+                'signal))))
 
 (ert-deftest ert-test-messages ()
   :tags '(:causes-redisplay)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a90e3fff355..85990a848f5 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -53,6 +53,8 @@
 (defvar tramp-copy-size-limit)
 (defvar tramp-persistency-file-name)
 (defvar tramp-remote-process-environment)
+;; Suppress nasty messages.
+(fset 'shell-command-sentinel 'ignore)
 
 ;; There is no default value on w32 systems, which could work out of the box.
 (defconst tramp-test-temporary-file-directory
@@ -70,6 +72,10 @@
       (add-to-list
        'tramp-default-host-alist
        `("\\`mock\\'" nil ,(system-name)))
+      ;; Emacs' Makefile sets $HOME to a nonexistent value.  Needed in
+      ;; batch mode only, therefore.
+      (unless (and (null noninteractive) (file-directory-p "~/"))
+        (setenv "HOME" temporary-file-directory))
       (format "/mock::%s" temporary-file-directory)))
   "Temporary directory for Tramp tests.")
 
@@ -126,29 +132,52 @@ If QUOTED is non-nil, the local part of the file is quoted."
     (make-temp-name "tramp-test")
     (if local temporary-file-directory tramp-test-temporary-file-directory))))
 
+;; Don't print messages in nested `tramp--instrument-test-case' calls.
+(defvar tramp--instrument-test-case-p nil
+  "Whether `tramp--instrument-test-case' run.
+This shall used dynamically bound only.")
+
 (defmacro tramp--instrument-test-case (verbose &rest body)
   "Run BODY with `tramp-verbose' equal VERBOSE.
 Print the the content of the Tramp debug buffer, if BODY does not
 eval properly in `should' or `should-not'.  `should-error' is not
 handled properly.  BODY shall not contain a timeout."
   (declare (indent 1) (debug (natnump body)))
-  `(let ((tramp-verbose ,verbose)
+  `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
+         (tramp-message-show-message t)
          (tramp-debug-on-error t)
          (debug-ignored-errors
-          (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
+          (cons "^make-symbolic-link not supported$" debug-ignored-errors))
+         inhibit-message)
      (unwind-protect
-         (progn ,@body)
-       (when (> tramp-verbose 3)
+         (let ((tramp--instrument-test-case-p t)) ,@body)
+       ;; Unwind forms.
+       (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3))
          (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
            (with-current-buffer (tramp-get-connection-buffer v)
              (message "%s" (buffer-string)))
            (with-current-buffer (tramp-get-debug-buffer v)
              (message "%s" (buffer-string))))))))
 
+(defsubst tramp--test-message (fmt-string &rest arguments)
+  "Emit a message into ERT *Messages*."
+  (tramp--instrument-test-case 0
+    (apply
+     'tramp-message
+     (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
+     fmt-string arguments)))
+
+(defsubst tramp--test-backtrace ()
+  "Dump a backtrace into ERT *Messages*."
+  (tramp--instrument-test-case 10
+    (tramp-backtrace
+     (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+
 (ert-deftest tramp-test00-availability ()
   "Test availability of Tramp functions."
   :expected-result (if (tramp--test-enabled) :passed :failed)
-  (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
+  (tramp--test-message
+   "Remote directory: `%s'" tramp-test-temporary-file-directory)
   (should (ignore-errors
             (and
              (file-remote-p tramp-test-temporary-file-directory)
@@ -2759,6 +2788,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
     (let ((tmp-name (tramp--test-make-temp-name nil quoted))
           (default-directory tramp-test-temporary-file-directory)
+          ;; Suppress nasty messages.
+          (inhibit-message t)
           kill-buffer-query-functions)
       (unwind-protect
           (with-temp-buffer
@@ -2787,7 +2818,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
             (async-shell-command
              (format "ls %s" (file-name-nondirectory tmp-name))
              (current-buffer))
-            (set-process-sentinel (get-buffer-process (current-buffer)) nil)
             ;; Read output.
             (with-timeout (10 (ert-fail "`async-shell-command' timed out"))
               (while (< (- (point-max) (point-min))
@@ -2816,7 +2846,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
             (write-region "foo" nil tmp-name)
             (should (file-exists-p tmp-name))
             (async-shell-command "read line; ls $line" (current-buffer))
-            (set-process-sentinel (get-buffer-process (current-buffer)) nil)
             (process-send-string
              (get-buffer-process (current-buffer))
              (format "%s\n" (file-name-nondirectory tmp-name)))
@@ -2847,8 +2876,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   "Like `shell-command-to-string', but for asynchronous processes."
   (with-temp-buffer
     (async-shell-command command (current-buffer))
-    ;; Suppress nasty messages.
-    (set-process-sentinel (get-buffer-process (current-buffer)) nil)
     (with-timeout (10)
       (while (get-buffer-process (current-buffer))
         (accept-process-output (get-buffer-process (current-buffer)) 0.1)))
@@ -3046,11 +3073,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                 ;; We must force a reconnect, in order to activate $BZR_HOME.
                 (tramp-cleanup-connection
                  (tramp-dissect-file-name tramp-test-temporary-file-directory)
-                 nil 'keep-password)
+                 'keep-debug 'keep-password)
                 '(Bzr))
-               (t nil)))))
+               (t nil))))
+           ;; Suppress nasty messages.
+           (inhibit-message t))
       (skip-unless vc-handled-backends)
-      (message "%s" vc-handled-backends)
+      (unless quoted (tramp--test-message "%s" vc-handled-backends))
 
       (unwind-protect
           (progn
@@ -3656,90 +3685,134 @@ Use the `ls' command."
   "Check parallel asynchronous requests.
 Such requests could arrive from timers, process filters and
 process sentinels.  They shall not disturb each other."
-  ;; Mark as failed until bug has been fixed.
-  :expected-result :failed
   :tags '(:expensive-test)
   (skip-unless (tramp--test-enabled))
   (skip-unless (tramp--test-sh-p))
 
-  (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
-    ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
-    ;; This has the side effect, that this test fails instead to
-    ;; abort.  Good for hydra.
-    (tramp--instrument-test-case 0
-    (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
-           (default-directory tmp-name)
-           (remote-file-name-inhibit-cache t)
-           timer buffers kill-buffer-query-functions)
+  ;; This test times out on hydra.
+  (with-timeout
+      (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out"))
+  (let* ((tmp-name (tramp--test-make-temp-name))
+         (default-directory tmp-name)
+         ;; Do not cache Tramp properties.
+         (remote-file-name-inhibit-cache t)
+         (process-file-side-effects t)
+         ;; Suppress nasty messages.
+         (inhibit-message t)
+         (number-proc 10)
+         ;; On hydra, timings are bad.
+         (timer-repeat
+          (cond
+           ((getenv "NIX_STORE") 10
+            (t 1))))
+         ;; We must distinguish due to performance reasons.
+         (timer-operation
+          (cond
+           ((string-equal "mock" (file-remote-p tmp-name 'method))
+            'vc-registered)
+           (t 'file-attributes)))
+         timer buffers kill-buffer-query-functions)
 
-      (unwind-protect
-          (progn
-            (make-directory tmp-name)
-
-            ;; Setup a timer in order to raise an ordinary command
-            ;; again and again.  `vc-registered' is well suited,
-            ;; because there are many checks.
-            (setq
-             timer
-             (run-at-time
-              0 1
-              (lambda ()
-                (when buffers
-                  (vc-registered
-                   (buffer-name (nth (random (length buffers)) buffers)))))))
-
-            ;; Create temporary buffers.  The number of buffers
-            ;; corresponds to the number of processes; it could be
-            ;; increased in order to make pressure on Tramp.
-            (dotimes (_i 5)
-              (add-to-list 'buffers (generate-new-buffer "*temp*")))
-
-            ;; Open asynchronous processes.  Set process sentinel.
-            (dolist (buf buffers)
-              (async-shell-command "read line; touch $line; echo $line" buf)
+    (unwind-protect
+        (progn
+          (make-directory tmp-name)
+
+          ;; Setup a timer in order to raise an ordinary command again
+          ;; and again.  `vc-registered' is well suited, because there
+          ;; are many checks.
+          (setq
+           timer
+           (run-at-time
+            0 timer-repeat
+            (lambda ()
+              (when buffers
+                (let ((default-directory tmp-name)
+                      (file
+                       (buffer-name (nth (random (length buffers)) buffers))))
+                  (tramp--test-message
+                   "Start timer %s %s %s"
+                   timer-operation file (current-time-string))
+                  (funcall timer-operation file)
+                  (tramp--test-message
+                   "Stop timer %s %s %s"
+                   timer-operation file (current-time-string)))))))
+
+          ;; Create temporary buffers.  The number of buffers
+          ;; corresponds to the number of processes; it could be
+          ;; increased in order to make pressure on Tramp.
+          (dotimes (_i number-proc)
+            (add-to-list 'buffers (generate-new-buffer "foo")))
+
+          ;; Open asynchronous processes.  Set process sentinel.
+          (dolist (buf buffers)
+            (tramp--test-message "Start process %s" buf)
+            (let ((proc
+                   (start-file-process-shell-command
+                    (buffer-name buf) buf
+                    (concat
+                     "(read line && echo $line >$line);"
+                     "(read line && cat $line);"
+                     "(read line && rm $line)")))
+                  (file (expand-file-name (buffer-name buf))))
+              ;; Remember the file name.  Add counter.
+              (process-put proc 'foo file)
+              (process-put proc 'bar 0)
+              ;; Add process filter.
+              (set-process-filter
+               proc
+               (lambda (proc string)
+                 (tramp--test-message "Process filter %s" proc)
+                 (with-current-buffer (process-buffer proc)
+                   (insert string))
+                 (unless (zerop (length string))
+                   (should (file-attributes (process-get proc 'foo))))))
+              ;; Add process sentinel.
               (set-process-sentinel
-               (get-buffer-process buf)
+               proc
                (lambda (proc _state)
-                 (delete-file (buffer-name (process-buffer proc))))))
-
-            ;; Send a string.  Use a random order of the buffers.  Mix
-            ;; with regular operation.
-            (let ((buffers (copy-sequence buffers))
-                  buf)
-              (while buffers
-                (setq buf (nth (random (length buffers)) buffers))
-                (process-send-string
-                 (get-buffer-process buf) (format "'%s'\n" buf))
-                (file-attributes (buffer-name buf))
-                (setq buffers (delq buf buffers))))
-
-            ;; Wait until the whole output has been read.
-            (with-timeout ((* 10 (length buffers))
-                           (ert-fail "`async-shell-command' timed out"))
-              (let ((buffers (copy-sequence buffers))
-                    buf)
-                (while buffers
-                  (setq buf (nth (random (length buffers)) buffers))
-                  (if (ignore-errors
-                        (memq (process-status (get-buffer-process buf))
-                              '(run open)))
-                      (accept-process-output (get-buffer-process buf) 0.1)
-                    (setq buffers (delq buf buffers))))))
-
-            ;; Check.
-            (dolist (buf buffers)
-              (with-current-buffer buf
-                (should
-                 (string-equal (format "'%s'\n" buf) (buffer-string)))))
-            (should-not
-             (directory-files
-              tmp-name nil directory-files-no-dot-files-regexp)))
-
-        ;; Cleanup.
-        (ignore-errors (cancel-timer timer))
-        (ignore-errors (delete-directory tmp-name 'recursive))
-        (dolist (buf buffers)
-          (ignore-errors (kill-buffer buf))))))))
+                 (tramp--test-message "Process sentinel %s" proc)
+                 (should-not (file-attributes (process-get proc 'foo)))))))
+
+          ;; Send a string.  Use a random order of the buffers.  Mix
+          ;; with regular operation.
+          (let ((buffers (copy-sequence buffers)))
+            (while buffers
+              (let* ((buf (nth (random (length buffers)) buffers))
+                     (proc (get-buffer-process buf))
+                     (file (process-get proc 'foo))
+                     (count (process-get proc 'bar)))
+                ;; Regular operation.
+                (if (= count 0)
+                    (should-not (file-attributes file))
+                  (should (file-attributes file)))
+                ;; Send string to process.
+                (tramp--test-message "Send string %s" proc)
+                (process-send-string proc (format "%s\n" (buffer-name buf)))
+                (accept-process-output proc 0.1 nil 0)
+                ;; Regular operation.
+                (if (= count 2)
+                    (should-not (file-attributes file))
+                  (should (file-attributes file)))
+                (process-put proc 'bar (1+ count))
+                (unless (process-live-p proc)
+                  (tramp--test-message "Buffer delete %s" buf)
+                  (setq buffers (delq buf buffers))))))
+
+          ;; Checks.  All process output shall exists in the
+          ;; respective buffers.  All created files shall be deleted.
+          (tramp--test-message "Checks %s" buffers)
+          (dolist (buf buffers)
+            (with-current-buffer buf
+              (should (string-equal (format "%s\n" buf) (buffer-string)))))
+          (should-not
+           (directory-files tmp-name nil directory-files-no-dot-files-regexp)))
+
+      ;; Cleanup.
+      (dolist (buf buffers)
+        (ignore-errors (delete-process (get-buffer-process buf)))
+        (ignore-errors (kill-buffer buf)))
+      (ignore-errors (cancel-timer timer))
+      (ignore-errors (delete-directory tmp-name 'recursive))))))
 
 (ert-deftest tramp-test37-recursive-load ()
   "Check that Tramp does not fail due to recursive load."
@@ -3836,8 +3909,8 @@ Since it unloads Tramp, it shall be the last test to run."
 ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
 ;; * Fix Bug#27009.  Set expected error of
 ;;   `tramp-test29-environment-variables-and-port-numbers'.
-;; * Fix Bug#16928.  Set expected error of `tramp-test36-asynchronous-requests'.
-;; * Fix `tramp-test38-unload' (Not all symbols are unbound).  Set
+;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'.
+;; * Fix `tramp-test39-unload' (Not all symbols are unbound).  Set
 ;;   expected error.
 
 (defun tramp-test-all (&optional interactive)