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

4 files changed, 463 insertions, 19 deletions

diff --git a/test/automated/elisp-mode-tests.el b/test/automated/elisp-mode-tests.el
index 2581de46931..64b3f665a03 100644
--- a/test/automated/elisp-mode-tests.el
+++ b/test/automated/elisp-mode-tests.el
@@ -3,6 +3,7 @@
 ;; Copyright (C) 2015 Free Software Foundation, Inc.
 
 ;; Author: Dmitry Gutov <dgutov@yandex.ru>
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
 
 ;; This file is part of GNU Emacs.
 
@@ -113,26 +114,420 @@
       (should (member "backup-buffer" comps))
       (should-not (member "backup-inhibited" comps)))))
 
-;;; Navigation
+;;; xref
 
-(ert-deftest elisp-xref-finds-both-function-and-variable ()
-  ;; "system-name" is both: a variable and a function
-  (let ((defs (elisp-xref-find 'definitions "system-name")))
-    (should (= (length defs) 2))
-    (should (string= (xref-item-summary (nth 0 defs))
-                     "(defun system-name)"))
-    (should (string= (xref-item-summary (nth 1 defs))
-                     "(defvar system-name)")))
+(defun xref-elisp-test-descr-to-target (xref)
+  "Return an appropriate `looking-at' match string for XREF."
+  (let* ((loc (xref-item-location xref))
+         (type (or (xref-elisp-location-type loc)
+                  'defun)))
+
+    (cl-case type
+      (defalias
+       ;; summary: "(defalias xref)"
+       ;; target : "(defalias 'xref)"
+       (concat "(defalias '" (substring (xref-item-summary xref) 10 -1)))
+
+      (defun
+       (let ((summary (xref-item-summary xref))
+             (file (xref-elisp-location-file loc)))
+         (cond
+          ((string= "c" (file-name-extension file))
+           ;; summary: "(defun buffer-live-p)"
+           ;; target : "DEFUN (buffer-live-p"
+           (concat
+            (upcase (substring summary 1 6))
+            " (\""
+            (substring summary 7 -1)
+            "\""))
+
+          (t
+           (substring summary 0 -1))
+          )))
+
+      (defvar
+       (let ((summary (xref-item-summary xref))
+             (file (xref-elisp-location-file loc)))
+         (cond
+          ((string= "c" (file-name-extension file))
+           ;; summary: "(defvar system-name)"
+           ;; target : "DEFVAR_LISP ("system-name", "
+           ;; summary: "(defvar abbrev-mode)"
+           ;; target : DEFVAR_PER_BUFFER ("abbrev-mode"
+           (concat
+            (upcase (substring summary 1 7))
+            (if (bufferp (variable-binding-locus (xref-elisp-location-symbol loc)))
+                "_PER_BUFFER (\""
+              "_LISP (\"")
+            (substring summary 8 -1)
+            "\""))
+
+          (t
+           (substring summary 0 -1))
+          )))
+
+      (feature
+       ;; summary: "(feature xref)"
+       ;; target : "(provide 'xref)"
+       (concat "(provide '" (substring (xref-item-summary xref) 9 -1)))
+
+      (otherwise
+       (substring (xref-item-summary xref) 0 -1))
+      )))
+
+
+(defun xref-elisp-test-run (xrefs expected-xrefs)
+  (should (= (length xrefs) (length expected-xrefs)))
+  (while xrefs
+    (let ((xref (pop xrefs))
+          (expected (pop expected-xrefs)))
+
+      (should (equal xref
+                     (or (when (consp expected) (car expected)) expected)))
+
+      (xref--goto-location (xref-item-location xref))
+      (should (looking-at (or (when (consp expected) (cdr expected))
+                              (xref-elisp-test-descr-to-target expected)))))
+    ))
+
+(defmacro xref-elisp-deftest (name computed-xrefs expected-xrefs)
+  "Define an ert test for an xref-elisp feature.
+COMPUTED-XREFS and EXPECTED-XREFS are lists of xrefs, except if
+an element of EXPECTED-XREFS is a cons (XREF . TARGET), TARGET is
+matched to the found location; otherwise, match
+to (xref-elisp-test-descr-to-target xref)."
+  (declare (indent defun)
+           (debug (symbolp "name")))
+  `(ert-deftest ,(intern (concat "xref-elisp-test-" (symbol-name name))) ()
+     (xref-elisp-test-run ,computed-xrefs ,expected-xrefs)
+     ))
+
+;; When tests are run from the Makefile, 'default-directory' is $HOME,
+;; so we must provide this dir to expand-file-name in the expected
+;; results. This also allows running these tests from other
+;; directories.
+(defconst emacs-test-dir (file-name-directory (or load-file-name (buffer-file-name))))
+
+;; alphabetical by test name
+
+;; FIXME: autoload
+
+;; FIXME: defalias-defun-c cmpl-prefix-entry-head
+;; FIXME: defalias-defvar-el allout-mode-map
+
+(xref-elisp-deftest find-defs-constructor
+  (elisp--xref-find-definitions 'xref-make-elisp-location)
+  ;; 'xref-make-elisp-location' is just a name for the default
+  ;; constructor created by the cl-defstruct, so the location is the
+  ;; cl-defstruct location.
+  (list
+   (cons
+    (xref-make "(cl-defstruct (xref-elisp-location (:constructor xref-make-elisp-location)))"
+               (xref-make-elisp-location
+                'xref-elisp-location 'define-type
+                (expand-file-name "../../lisp/progmodes/elisp-mode.el" emacs-test-dir)))
+    ;; It's not worth adding another special case to `xref-elisp-test-descr-to-target' for this
+    "(cl-defstruct (xref-elisp-location")
+   ))
+
+(xref-elisp-deftest find-defs-defalias-defun-el
+  (elisp--xref-find-definitions 'Buffer-menu-sort)
+  (list
+   (xref-make "(defalias Buffer-menu-sort)"
+              (xref-make-elisp-location
+               'Buffer-menu-sort 'defalias
+               (expand-file-name "../../lisp/buff-menu.elc" emacs-test-dir)))
+   (xref-make "(defun tabulated-list-sort)"
+              (xref-make-elisp-location
+               'tabulated-list-sort nil
+               (expand-file-name "../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir)))
+   ))
+
+;; FIXME: defconst
+
+;; FIXME: eieio defclass
+
+;; Possible ways of defining the default method implementation for a
+;; generic function. We declare these here, so we know we cover all
+;; cases, and we don't rely on other code not changing.
+;;
+;; When the generic and default method are declared in the same place,
+;; elisp--xref-find-definitions only returns one.
+
+(cl-defstruct (xref-elisp-root-type)
+  slot-1)
+
+(cl-defgeneric xref-elisp-generic-no-methods ()
+  "doc string no-methods"
+  ;; No default implementation, no methods, but fboundp is true for
+  ;; this symbol; it calls cl-no-applicable-method
+  )
+
+(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type))
+  "doc string no-default xref-elisp-root-type"
+  "non-default for no-default")
+
+;; defgeneric after defmethod in file to ensure the fallback search
+;; method of just looking for the function name will fail.
+(cl-defgeneric xref-elisp-generic-no-default ()
+  "doc string no-default generic"
+  ;; No default implementation; this function calls the cl-generic
+  ;; dispatching code.
+  )
+
+(cl-defgeneric xref-elisp-generic-co-located-default ()
+  "doc string co-located-default generic"
+  "co-located default")
+
+(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type))
+  "doc string co-located-default xref-elisp-root-type"
+  "non-default for co-located-default")
+
+(cl-defgeneric xref-elisp-generic-separate-default ()
+  "doc string separate-default generic"
+  ;; default implementation provided separately
+  )
+
+(cl-defmethod xref-elisp-generic-separate-default ()
+  "doc string separate-default default"
+  "separate default")
+
+(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type))
+  "doc string separate-default xref-elisp-root-type"
+  "non-default for separate-default")
+
+(cl-defmethod xref-elisp-generic-implicit-generic ()
+  "doc string implicit-generic default"
+  "default for implicit generic")
+
+(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type))
+  "doc string implicit-generic xref-elisp-root-type"
+  "non-default for implicit generic")
+
+
+(xref-elisp-deftest find-defs-defgeneric-no-methods
+  (elisp--xref-find-definitions 'xref-elisp-generic-no-methods)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-no-methods)"
+              (xref-make-elisp-location
+               'xref-elisp-generic-no-methods 'cl-defgeneric
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-no-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-no-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-no-default)"
+              (xref-make-elisp-location
+               'xref-elisp-generic-no-default 'cl-defgeneric
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type)))"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-no-default xref-elisp-root-type) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-co-located-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-co-located-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-co-located-default)"
+              (xref-make-elisp-location
+               'xref-elisp-generic-co-located-default 'cl-defgeneric
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type)))"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-co-located-default xref-elisp-root-type) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-separate-default
+  (elisp--xref-find-definitions 'xref-elisp-generic-separate-default)
+  (list
+   (xref-make "(cl-defgeneric xref-elisp-generic-separate-default)"
+              (xref-make-elisp-location
+               'xref-elisp-generic-separate-default 'cl-defgeneric
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-separate-default ())"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-separate-default) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+
+   (xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type)))"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-separate-default xref-elisp-root-type) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-implicit-generic
+  (elisp--xref-find-definitions 'xref-elisp-generic-implicit-generic)
+  (list
+   (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ())"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-implicit-generic) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type)))"
+              (xref-make-elisp-location
+               '(xref-elisp-generic-implicit-generic xref-elisp-root-type) 'cl-defmethod
+               (expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
+   ))
+
+;; Test that we handle more than one method
+
+;; When run from the Makefile, etags is not loaded at compile time,
+;; but it is by the time this test is run.  interactively; don't fail
+;; for that.
+(require 'etags)
+(xref-elisp-deftest find-defs-defgeneric-el
+  (elisp--xref-find-definitions 'xref-location-marker)
+  (list
+   (xref-make "(cl-defgeneric xref-location-marker)"
+              (xref-make-elisp-location
+               'xref-location-marker 'cl-defgeneric
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-elisp-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/elisp-mode.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-file-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-file-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-buffer-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-buffer-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-bogus-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-bogus-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+   (xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))"
+              (xref-make-elisp-location
+               '(xref-location-marker xref-etags-location) 'cl-defmethod
+               (expand-file-name "../../lisp/progmodes/etags.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-defgeneric-eval
+  (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ())))
+  nil)
+
+(xref-elisp-deftest find-defs-defun-el
+  (elisp--xref-find-definitions 'xref-find-definitions)
+  (list
+   (xref-make "(defun xref-find-definitions)"
+              (xref-make-elisp-location
+               'xref-find-definitions nil
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))))
+
+(xref-elisp-deftest find-defs-defun-eval
+  (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ())))
+  nil)
+
+(xref-elisp-deftest find-defs-defun-c
+  (elisp--xref-find-definitions 'buffer-live-p)
+  (list
+   (xref-make "(defun buffer-live-p)"
+              (xref-make-elisp-location 'buffer-live-p nil "src/buffer.c"))))
+
+;; FIXME: deftype
+
+(xref-elisp-deftest find-defs-defun-c-defvar-c
+  (elisp-xref-find 'definitions "system-name")
+  (list
+   (xref-make "(defvar system-name)"
+              (xref-make-elisp-location 'system-name 'defvar "src/editfns.c"))
+   (xref-make "(defun system-name)"
+              (xref-make-elisp-location 'system-name nil "src/editfns.c")))
+  )
+
+(xref-elisp-deftest find-defs-defun-el-defvar-c
+  (elisp-xref-find 'definitions "abbrev-mode")
   ;; It's a minor mode, but the variable is defined in buffer.c
-  (let ((defs (elisp-xref-find 'definitions "abbrev-mode")))
-    (should (= (length defs) 2))))
-
-(ert-deftest elisp-xref-finds-only-function-for-minor-mode ()
-  ;; Both variable and function are defined in the same place.
-  (let ((defs (elisp-xref-find 'definitions "visible-mode")))
-    (should (= (length defs) 1))
-    (should (string= (xref-item-summary (nth 0 defs))
-                     "(defun visible-mode)"))))
+  (list
+   (xref-make "(defvar abbrev-mode)"
+              (xref-make-elisp-location 'abbrev-mode 'defvar "src/buffer.c"))
+   (cons
+    (xref-make "(defun abbrev-mode)"
+               (xref-make-elisp-location
+                'abbrev-mode nil
+                (expand-file-name "../../lisp/abbrev.el" emacs-test-dir)))
+    "(define-minor-mode abbrev-mode"))
+  )
+
+;; Source for both variable and defun is "(define-minor-mode
+;; compilation-minor-mode". There is no way to tell that directly from
+;; the symbol, but we can use (memq sym minor-mode-list) to detect
+;; that the symbol is a minor mode. See `elisp--xref-find-definitions'
+;; for more comments.
+;;
+;; IMPROVEME: return defvar instead of defun if source near starting
+;; point indicates the user is searching for a variable, not a
+;; function.
+(require 'compile) ;; not loaded by default at test time
+(xref-elisp-deftest find-defs-defun-defvar-el
+  (elisp--xref-find-definitions 'compilation-minor-mode)
+  (list
+   (cons
+    (xref-make "(defun compilation-minor-mode)"
+               (xref-make-elisp-location
+                'compilation-minor-mode nil
+                (expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir)))
+    "(define-minor-mode compilation-minor-mode")
+   ))
+
+(xref-elisp-deftest find-defs-defvar-el
+  (elisp--xref-find-definitions 'xref--marker-ring)
+  (list
+   (xref-make "(defvar xref--marker-ring)"
+              (xref-make-elisp-location
+               'xref--marker-ring 'defvar
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+    ))
+
+(xref-elisp-deftest find-defs-defvar-c
+  (elisp--xref-find-definitions 'default-directory)
+  (list
+   (cons
+    (xref-make "(defvar default-directory)"
+               (xref-make-elisp-location 'default-directory 'defvar "src/buffer.c"))
+    ;; IMPROVEME: we might be able to compute this target
+    "DEFVAR_PER_BUFFER (\"default-directory\"")))
+
+(xref-elisp-deftest find-defs-defvar-eval
+  (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil)))
+  nil)
+
+(xref-elisp-deftest find-defs-face-el
+  (elisp--xref-find-definitions 'font-lock-keyword-face)
+  ;; 'font-lock-keyword-face is both a face and a var
+  (list
+   (xref-make "(defvar font-lock-keyword-face)"
+              (xref-make-elisp-location
+               'font-lock-keyword-face 'defvar
+               (expand-file-name "../../lisp/font-lock.el" emacs-test-dir)))
+   (xref-make "(defface font-lock-keyword-face)"
+              (xref-make-elisp-location
+               'font-lock-keyword-face 'defface
+               (expand-file-name "../../lisp/font-lock.el" emacs-test-dir)))
+   ))
+
+(xref-elisp-deftest find-defs-face-eval
+  (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil "")))
+  nil)
+
+(xref-elisp-deftest find-defs-feature-el
+  (elisp--xref-find-definitions 'xref)
+  (list
+   (cons
+    (xref-make "(feature xref)"
+              (xref-make-elisp-location
+               'xref 'feature
+               (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+    ";;; Code:")
+   ))
+
+(xref-elisp-deftest find-defs-feature-eval
+  (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature)))
+  nil)
 
 (provide 'elisp-mode-tests)
 ;;; elisp-mode-tests.el ends here
diff --git a/test/automated/ert-tests.el b/test/automated/ert-tests.el
index fcfc7ee4823..5382c400962 100644
--- a/test/automated/ert-tests.el
+++ b/test/automated/ert-tests.el
@@ -345,6 +345,10 @@ This macro is used to test if macroexpansion in `should' works."
         (should (equal actual-condition expected-condition)))))))
 
 (ert-deftest ert-test-deftest ()
+  ;; FIXME: These tests don't look very good.  What is their intent, i.e. what
+  ;; are they really testing?  The precise generated code shouldn't matter, so
+  ;; we should either test the behavior of the code, or else try to express the
+  ;; kind of efficiency guarantees we're looking for.
   (should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
                  '(progn
                     (ert-set-test 'abc
diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el
index 3643ce53cb0..74c0700759e 100644
--- a/test/automated/seq-tests.el
+++ b/test/automated/seq-tests.el
@@ -187,7 +187,12 @@ Evaluate BODY for each created sequence.
   (should-not   (seq-subseq '(1 2 3) 3))
   (should       (seq-subseq '(1 2 3) -3))
   (should-error (seq-subseq '(1 2 3) 1 4))
-  (should       (seq-subseq '(1 2 3) 1 3)))
+  (should       (seq-subseq '(1 2 3) 1 3))
+  (should-error (seq-subseq '() -1))
+  (should-error (seq-subseq [] -1))
+  (should-error (seq-subseq "" -1))
+  (should-not (seq-subseq '() 0))
+  (should-error(seq-subseq '() 0 -1)))
 
 (ert-deftest test-seq-concatenate ()
   (with-test-sequences (seq '(2 4 6))
diff --git a/test/redisplay-testsuite.el b/test/redisplay-testsuite.el
index 357ab08bf84..332eeb1cc9f 100644
--- a/test/redisplay-testsuite.el
+++ b/test/redisplay-testsuite.el
@@ -251,6 +251,45 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff
           (str "ABC"))
       (put-text-property 1 2 'invisible 'test-redisplay--ellipsis-invis str)
       (overlay-put ov 'display str)))
+  ;; Overlay string over invisible text and non-default face.
+  (insert "\n  Expected: ..." (propertize "ABC" 'face 'highlight) "XYZ")
+  (insert "\n    Result: ")
+  (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis))
+  (let ((ov (make-overlay (point) (point))))
+    (overlay-put ov 'invisible t)
+    (overlay-put ov 'window (selected-window))
+    (overlay-put ov 'after-string
+                 (propertize "ABC" 'face 'highlight)))
+  (insert "XYZ\n")
+  ;; Overlay strings with partial `invisibility' property and with a
+  ;; display property on the before-string.
+  (insert "\n  Expected: ..."
+          (propertize "DEF" 'display '(image :type xpm :file "close.xpm"))
+          (propertize "ABC" 'face 'highlight) "XYZ")
+  (insert "\n    Result: ")
+  (insert (propertize "foo" 'invisible 'test-redisplay--ellipsis-invis))
+  (let ((ov (make-overlay (point) (point))))
+    (overlay-put ov 'invisible t)
+    (overlay-put ov 'window (selected-window))
+    (overlay-put ov 'after-string
+                 (propertize "ABC" 'face 'highlight))
+    (overlay-put ov 'before-string
+                 (propertize "DEF"
+                             'display '(image :type xpm :file "close.xpm"))))
+  (insert "XYZ\n")
+
+  ;; Overlay string with 2 adjacent and different invisible
+  ;; properties.  This caused an infloop before Emacs 25.
+  (insert "\n  Expected: ABC")
+  (insert "\n    Result: ")
+  (let ((opoint (point)))
+    (insert "ABC\n")
+    (let ((ov (make-overlay (1+ opoint) (+ 2 opoint)))
+          (str (concat (propertize "X"
+                                   'invisible 'test-redisplay--simple-invis)
+                       (propertize "Y"
+                                   'invisible 'test-redisplay--simple-invis2))))
+      (overlay-put ov 'after-string str)))
 
   (insert "\n"))
 
@@ -264,6 +303,7 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff
     (erase-buffer)
     (setq buffer-invisibility-spec
           '(test-redisplay--simple-invis
+            test-redisplay--simple-invis2
             (test-redisplay--ellipsis-invis . t)))
     (test-redisplay-1)
     (test-redisplay-2)