Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

9 files changed, 323 insertions, 19 deletions

diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el
new file mode 100644
index 00000000000..e8352a4ecaf
--- /dev/null
+++ b/test/lisp/dired-x-tests.el
@@ -0,0 +1,53 @@
+;;; dired-x-tests.el --- Test suite for dired-x. -*- 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 <http://www.gnu.org/licenses/>.
+
+;;; Code:
+(require 'ert)
+(require 'dired-x)
+
+
+(ert-deftest dired-test-bug25942 ()
+  "Test for http://debbugs.gnu.org/25942 ."
+  (let* ((dirs (list "Public" "Music"))
+         (files (list ".bashrc" "bar.c" "foo.c" "c" ".c"))
+         (all-but-c
+          (sort
+           (append (copy-sequence dirs)
+                   (delete "c" (copy-sequence files)))
+           #'string<))
+         (dir (make-temp-file "Bug25942" 'dir))
+         (extension "c"))
+    (unwind-protect
+        (progn
+          (dolist (d dirs)
+            (make-directory (expand-file-name d dir)))
+          (dolist (f files)
+            (write-region nil nil (expand-file-name f dir)))
+          (dired dir)
+          (dired-mark-extension extension)
+          (should (equal '("bar.c" "foo.c")
+                         (sort (dired-get-marked-files 'local) #'string<)))
+          (dired-unmark-all-marks)
+          (dired-mark-suffix extension)
+          (should (equal all-but-c
+                         (sort (dired-get-marked-files 'local) #'string<))))
+      (delete-directory dir 'recursive))))
+
+(provide 'dired-x-tests)
+;; dired-x-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 5edc3e72bf2..093cb3476c1 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -493,4 +493,30 @@
   (should (cl-typep '* 'cl-lib-test-type))
   (should-not (cl-typep 1 'cl-lib-test-type)))
 
+(ert-deftest cl-lib-symbol-macrolet ()
+  ;; bug#26325
+  :expected-result :failed
+  (should (equal (cl-flet ((f (x) (+ x 5)))
+                   (let ((x 5))
+                     (f (+ x 6))))
+                 ;; Go through `eval', otherwise the macro-expansion
+                 ;; error prevents running the whole test suite :-(
+                 (eval '(cl-symbol-macrolet ((f (+ x 6)))
+                          (cl-flet ((f (x) (+ x 5)))
+                            (let ((x 5))
+                              (f f))))
+                       t))))
+
+(defmacro cl-lib-symbol-macrolet-4+5 ()
+  ;; bug#26068
+  (let* ((sname "x")
+         (s1 (make-symbol sname))
+         (s2 (make-symbol sname)))
+    `(cl-symbol-macrolet ((,s1 4)
+                          (,s2 5))
+       (+ ,s1 ,s2))))
+
+(ert-deftest cl-lib-symbol-macrolet-2 ()
+  (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
+
 ;;; cl-lib.el ends here
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el
index 2801f23df63..8e3f2e185cf 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -77,6 +77,10 @@ noindent\" 3
       (search-backward "d2")
       (up-list -1)
       (indent-sexp)
+      (should (equal (buffer-string) correct))
+      (backward-sexp)
+      (end-of-line)
+      (indent-sexp)
       (should (equal (buffer-string) correct)))))
 
 (ert-deftest indent-sexp-in-string ()
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 72080322379..54e7ebfc0e5 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -294,13 +294,20 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
                (file-notify-add-watch
                 temporary-file-directory '(change attribute-change) #'ignore)))
         (file-notify-rm-watch file-notify--test-desc)
-        (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
+
+        ;; File monitors like kqueue insist, that the watched file
+        ;; exists.  Directory monitors are not bound to this
+        ;; restriction.
+        (when (string-equal (file-notify--test-library) "kqueue")
+          (write-region
+           "any text" nil file-notify--test-tmpfile nil 'no-message))
         (should
          (setq file-notify--test-desc
                (file-notify-add-watch
                 file-notify--test-tmpfile '(change attribute-change) #'ignore)))
         (file-notify-rm-watch file-notify--test-desc)
-        (delete-file file-notify--test-tmpfile)
+        (when (string-equal (file-notify--test-library) "kqueue")
+          (delete-file file-notify--test-tmpfile))
 
         ;; Check error handling.
         (should-error (file-notify-add-watch 1 2 3 4)
@@ -340,20 +347,19 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
   (expand-file-name
    (make-temp-name "file-notify-test") temporary-file-directory))
 
-;; This test is inspired by Bug#26127.
+;; This test is inspired by Bug#26126 and Bug#26127.
 (ert-deftest file-notify-test02-rm-watch ()
   "Check `file-notify-rm-watch'."
   (skip-unless (file-notify--test-local-enabled))
 
   (unwind-protect
+      ;; Check, that `file-notify-rm-watch' works.
       (progn
-        ;; Check, that `file-notify-rm-watch' works.
         (should
          (setq file-notify--test-desc
                (file-notify-add-watch
                 temporary-file-directory '(change) #'ignore)))
         (file-notify-rm-watch file-notify--test-desc)
-
         ;; Check, that any parameter is accepted.
         (condition-case err
             (progn
@@ -363,9 +369,19 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
               (file-notify-rm-watch 'foo))
           (error (ert-fail err)))
 
-        ;; Check, that no error is returned removing a watch descriptor twice.
+        ;; The environment shall be cleaned up.
+        (file-notify--test-cleanup-p))
+
+    ;; Cleanup.
+    (file-notify--test-cleanup))
+
+  (unwind-protect
+      ;; Check, that no error is returned removing a watch descriptor twice.
+      (progn
         (setq file-notify--test-tmpfile (file-notify--test-make-temp-name)
               file-notify--test-tmpfile1 (file-notify--test-make-temp-name))
+        (write-region "any text" nil file-notify--test-tmpfile nil 'no-message)
+        (write-region "any text" nil file-notify--test-tmpfile1 nil 'no-message)
         (should
          (setq file-notify--test-desc
                (file-notify-add-watch
@@ -374,14 +390,51 @@ This returns only for the local case and gfilenotify; otherwise it is nil.
          (setq file-notify--test-desc1
                (file-notify-add-watch
                 file-notify--test-tmpfile1 '(change) #'ignore)))
+        ;; Remove `file-notify--test-desc' twice.
         (file-notify-rm-watch file-notify--test-desc)
         (file-notify-rm-watch file-notify--test-desc)
         (file-notify-rm-watch file-notify--test-desc1)
+        (delete-file file-notify--test-tmpfile)
+        (delete-file file-notify--test-tmpfile1)
 
         ;; The environment shall be cleaned up.
         (file-notify--test-cleanup-p))
 
     ;; Cleanup.
+    (file-notify--test-cleanup))
+
+  (unwind-protect
+      ;; Check, that removing watch descriptors out of order do not harm.
+      (let (results)
+        (cl-flet ((first-callback (event)
+                   (when (eq (nth 1 event) 'deleted) (push 1 results)))
+                  (second-callback (event)
+                   (when (eq (nth 1 event) 'deleted) (push 2 results))))
+          (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
+          (write-region
+           "any text" nil file-notify--test-tmpfile nil 'no-message)
+          (should
+           (setq file-notify--test-desc
+                 (file-notify-add-watch
+                  file-notify--test-tmpfile
+                  '(change) #'first-callback)))
+          (should
+           (setq file-notify--test-desc1
+                 (file-notify-add-watch
+                  file-notify--test-tmpfile
+                  '(change) #'second-callback)))
+          ;; Remove first watch.
+          (file-notify-rm-watch file-notify--test-desc)
+          ;; Only the second callback shall run.
+          (delete-file file-notify--test-tmpfile)
+          (file-notify--wait-for-events
+           (file-notify--test-timeout) results)
+          (should (equal results (list 2)))
+
+          ;; The environment shall be cleaned up.
+          (file-notify--test-cleanup-p)))
+
+    ;; Cleanup.
     (file-notify--test-cleanup)))
 
 (file-notify--deftest-remote file-notify-test02-rm-watch
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 45b4ff2f5ab..2a4ef740a04 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -1,4 +1,4 @@
-;;; tramp-tests.el --- Tests of remote file access
+;;; tramp-tests.el --- Tests of remote file access  -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
 
@@ -37,6 +37,7 @@
 
 ;;; Code:
 
+(require 'dired)
 (require 'ert)
 (require 'tramp)
 (require 'vc)
@@ -44,11 +45,11 @@
 (require 'vc-git)
 (require 'vc-hg)
 
-(autoload 'dired-uncache "dired")
 (declare-function tramp-find-executable "tramp-sh")
 (declare-function tramp-get-remote-path "tramp-sh")
 (declare-function tramp-get-remote-stat "tramp-sh")
 (declare-function tramp-get-remote-perl "tramp-sh")
+(defvar auto-save-file-name-transforms)
 (defvar tramp-copy-size-limit)
 (defvar tramp-persistency-file-name)
 (defvar tramp-remote-process-environment)
@@ -2083,17 +2084,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
   (skip-unless
    (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
 
+  ;; `make-nearby-temp-file' and `temporary-file-directory' exists
+  ;; since Emacs 26.  We don't want to see compiler warnings for older
+  ;; Emacsen."
   (let ((default-directory tramp-test-temporary-file-directory)
         tmp-file)
     ;; The remote host shall know a temporary file directory.
-    (should (stringp (temporary-file-directory)))
+    (should (stringp (with-no-warnings (temporary-file-directory))))
     (should
      (string-equal
       (file-remote-p default-directory)
-      (file-remote-p (temporary-file-directory))))
+      (file-remote-p (with-no-warnings (temporary-file-directory)))))
 
     ;; The temporary file shall be located on the remote host.
-    (setq tmp-file (make-nearby-temp-file "tramp-test"))
+    (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test")))
     (should (file-exists-p tmp-file))
     (should (file-regular-p tmp-file))
     (should
@@ -2103,7 +2107,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
     (delete-file tmp-file)
     (should-not (file-exists-p tmp-file))
 
-    (setq tmp-file (make-nearby-temp-file "tramp-test" 'dir))
+    (setq tmp-file (with-no-warnings (make-nearby-temp-file "tramp-test" 'dir)))
     (should (file-exists-p tmp-file))
     (should (file-directory-p tmp-file))
     (delete-directory tmp-file)
@@ -2582,7 +2586,7 @@ process sentinels.  They shall not disturb each other."
             ;; 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)
+            (dotimes (_i 5)
               (add-to-list 'buffers (generate-new-buffer "*temp*")))
 
             ;; Open asynchronous processes.  Set process sentinel.
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index e030675e07c..8e1bac10cd1 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -140,6 +140,43 @@ if (!/[ (:,='\"]/.test(value)) {
       (font-lock-ensure)
       (should (eq (get-text-property (point) 'face) (caddr test))))))
 
+(ert-deftest js-mode-propertize-bug-1 ()
+  (with-temp-buffer
+    (js-mode)
+    (save-excursion (insert "x"))
+    (insert "/")
+    ;; The bug was a hang.
+    (should t)))
+
+(ert-deftest js-mode-propertize-bug-2 ()
+  (with-temp-buffer
+    (js-mode)
+    (insert "function f() {
+    function g()
+    {
+        1 / 2;
+    }
+
+    function h() {
+")
+    (save-excursion
+      (insert "
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00000000000000000000000000000000000000000000000000;
+        00;
+    }
+}
+"))
+    (insert "/")
+    ;; The bug was a hang.
+    (should t)))
+
 (provide 'js-tests)
 
 ;;; js-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index 1e6b867d30b..2f4c2fb849d 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -5314,6 +5314,25 @@ class SomeClass:
       (or enabled (hs-minor-mode -1)))))
 
 
+(ert-deftest python-tests--python-nav-end-of-statement--infloop ()
+  "Checks that `python-nav-end-of-statement' doesn't infloop in a
+buffer with overlapping strings."
+  (python-tests-with-temp-buffer "''' '\n''' ' '\n"
+    (syntax-propertize (point-max))
+    ;; Create a situation where strings nominally overlap.  This
+    ;; shouldn't happen in practice, but apparently it can happen when
+    ;; a package calls `syntax-ppss' in a narrowed buffer during JIT
+    ;; lock.
+    (put-text-property 4 5 'syntax-table (string-to-syntax "|"))
+    (remove-text-properties 8 9 '(syntax-table nil))
+    (goto-char 4)
+    (setq-local syntax-propertize-function nil)
+    ;; The next form should not infloop.  We have to disable
+    ;; ‘debug-on-error’ so that ‘cl-assert’ doesn’t call the debugger.
+    (should-error (let ((debug-on-error nil))
+                    (python-nav-end-of-statement)))
+    (should (eolp))))
+
 
 (provide 'python-tests)
 
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 11e5a479720..30636db083c 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -77,6 +77,49 @@ server's WWW-Authenticate header field.")
              :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
              :expected-response "0d84884d967e04440efc77e9e2b5b561")))
 
+(ert-deftest url-auth-test-colonjoin ()
+  "Check joining strings with `:'."
+  (should (string= (url-digest-auth-colonjoin) ""))
+  (should (string= (url-digest-auth-colonjoin nil) ""))
+  (should (string= (url-digest-auth-colonjoin nil nil nil) "::"))
+  (should (string= (url-digest-auth-colonjoin "") ""))
+  (should (string= (url-digest-auth-colonjoin "" "") ":"))
+  (should (string= (url-digest-auth-colonjoin "one") "one"))
+  (should (string= (url-digest-auth-colonjoin "one" "two" "three") "one:two:three")))
+
+(ert-deftest url-auth-test-digest-ha1 ()
+  "Check HA1 computation."
+  (dolist (row url-auth-test-challenges)
+    (should (string= (url-digest-auth-make-ha1 (plist-get row :username)
+                                               (plist-get row :realm)
+                                               (plist-get row :password))
+                     (plist-get row :expected-ha1)
+                     ))))
+
+(ert-deftest url-auth-test-digest-ha2 ()
+  "Check HA2 computation."
+  (dolist (row url-auth-test-challenges)
+    (should (string= (url-digest-auth-make-ha2 (plist-get row :method)
+                                               (plist-get row :uri))
+                     (plist-get row :expected-ha2)))))
+
+(ert-deftest url-auth-test-digest-request-digest ()
+  "Check digest response value."
+  (dolist (row url-auth-test-challenges)
+    (should (string= (plist-get row :expected-response)
+                     (if (plist-member row :qop)
+                         (url-digest-auth-make-request-digest-qop
+                          (plist-get row :qop)
+                          (plist-get row :expected-ha1)
+                          (plist-get row :expected-ha2)
+                          (plist-get row :nonce)
+                          (plist-get row :nc)
+                          (plist-get row :cnonce))
+                       (url-digest-auth-make-request-digest
+                        (plist-get row :expected-ha1)
+                        (plist-get row :expected-ha2)
+                        (plist-get row :nonce)))))))
+
 (ert-deftest url-auth-test-digest-create-key ()
   "Check user credentials in their hashed form."
   (dolist (challenge url-auth-test-challenges)
@@ -223,14 +266,12 @@ test and cannot be passed by arguments to `url-digest-auth'."
           (progn
             ;; We don't know these, just check that they exists.
             (should (string-match-p ".*response=\".*?\".*" auth))
-            ;; url-digest-auth doesn't return these AFAICS.
-;;;            (should (string-match-p ".*nc=\".*?\".*" auth))
-;;;            (should (string-match-p ".*cnonce=\".*?\".*" auth))
-            )
+            (should (string-match-p ".*nc=\".*?\".*" auth))
+            (should (string-match-p ".*cnonce=\".*?\".*" auth)))
         (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
         (should (string= (match-string 1 auth)
                          (plist-get challenge :expected-response))))
-      )))
+        )))
 
 (ert-deftest url-auth-test-digest-auth-opaque ()
   "Check that `opaque' value is added to result when presented by
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 912c6b1e818..387786ced06 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -22,7 +22,7 @@
 (require 'ert)
 (require 'ediff-ptch)
 
-(ert-deftest ibuffer-test-bug25010 ()
+(ert-deftest ediff-ptch-test-bug25010 ()
   "Test for http://debbugs.gnu.org/25010 ."
   (with-temp-buffer
     (insert "diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
@@ -38,5 +38,72 @@ index 6a07f80..6e8e947 100644
              (match-string 1))))
       (should-not (string-suffix-p "@@" filename)))))
 
+
+(ert-deftest ediff-ptch-test-bug26084 ()
+  "Test for http://debbugs.gnu.org/26084 ."
+  (skip-unless (executable-find "git"))
+  (skip-unless (executable-find ediff-patch-program))
+  (let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
+         (default-directory (file-name-as-directory tmpdir))
+         (patch (make-temp-file "ediff-ptch-test"))
+         (qux (expand-file-name "qux.txt" tmpdir))
+         (bar (expand-file-name "bar.txt" tmpdir))
+         (git-program (executable-find "git")))
+    ;; Create repository.
+    (with-temp-buffer
+      (insert "qux here\n")
+      (write-region nil nil qux nil 'silent)
+      (erase-buffer)
+      (insert "bar here\n")
+      (write-region nil nil bar nil 'silent))
+    (call-process git-program nil nil nil "init")
+    (call-process git-program nil nil nil "add" ".")
+    (call-process git-program nil nil nil "commit" "-m" "Test repository.")
+    ;; Update repo., save the diff and reset to initial state.
+    (with-temp-buffer
+      (insert "foo here\n")
+      (write-region nil nil qux nil 'silent)
+      (write-region nil nil bar nil 'silent))
+    (call-process git-program nil `(:file ,patch) nil "diff")
+    (call-process git-program nil nil nil "reset" "--hard" "HEAD")
+    (find-file patch)
+    (unwind-protect
+        (let* ((info
+                (progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map))
+               (patch1
+                (buffer-substring-no-properties
+                 (car (nth 3 (car info)))
+                 (car (nth 4 (car info)))))
+               (patch2
+                (buffer-substring-no-properties
+                 (car (nth 3 (cadr info)))
+                 (car (nth 4 (cadr info))))))
+          ;; Apply both patches.
+          (dolist (x (list (cons patch1 bar) (cons patch2 qux)))
+            (with-temp-buffer
+              (insert (car x))
+              (call-process-region (point-min)
+                                   (point-max)
+                                   ediff-patch-program
+                                   nil nil nil
+                                   "-b" (cdr x))))
+          ;; Check backup files were saved correctly.
+          (dolist (x (list qux bar))
+            (let ((backup
+                   (car
+                    (directory-files
+                     tmpdir 'full
+                     (concat (file-name-nondirectory x) ".")))))
+              (should-not
+               (string= (with-temp-buffer
+                          (insert-file-contents x)
+                          (buffer-string))
+                        (with-temp-buffer
+                          (insert-file-contents backup)
+                          (buffer-string))))))
+          (delete-directory tmpdir 'recursive)
+          (delete-file patch)))))
+
+
 (provide 'ediff-ptch-tests)
 ;;; ediff-ptch-tests.el ends here