ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 05:03:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

yasnippet-tests.el: Fix some failures

Browse Source 
* yasnippet-tests.el (yas-call-with-saving-variables): Don't `set` when
there's nothing to change.
(yas-with-overriden-buffer-list): Fix `buffer-list` override.
(loading-with-cyclic-parenthood, extra-modes-parenthood): Tweak tests
to be a bit less sensitive to details of ordering and number of
repetitions in `yas--modes-to-activate`.

* yasnippet.el (yas--all-parents): Make sure `mode` is always first in
the output, as is the case for `derived-mode-all-parents`.
(yas--modes-to-activate): Put extra modes first and not reversed, as
required by test `extra-modes-parenthood`.
This commit is contained in:
Stefan Monnier 2024-01-15 00:53:00 -05:00
parent 8ce506e32f
commit d12428082c
2 changed files with 30 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
yasnippet-tests.el
View File

@ -121,7 +121,8 @@ This lets `yas--maybe-expand-from-keymap-filter' work as expected."
(funcall fn) (funcall fn)
(cl-loop for var in vars (cl-loop for var in vars
for saved in saved-values for saved in saved-values
do (set var saved))))) do (unless (eq (symbol-value var) saved) ;Beware read-only vars!
(set var saved))))))
(defun yas-call-with-snippet-dirs (dirs fn) (defun yas-call-with-snippet-dirs (dirs fn)
(let* ((default-directory (make-temp-file "yasnippet-fixture" t)) (let* ((default-directory (make-temp-file "yasnippet-fixture" t))
@ -1229,11 +1230,11 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \
(let ((saved-sym (make-symbol "yas--buffer-list"))) (let ((saved-sym (make-symbol "yas--buffer-list")))
`(let ((,saved-sym (symbol-function 'buffer-list))) `(let ((,saved-sym (symbol-function 'buffer-list)))
(cl-letf (((symbol-function 'buffer-list) (cl-letf (((symbol-function 'buffer-list)
(lambda () (lambda (&rest args)
(cl-remove-if (lambda (buf) (cl-remove-if (lambda (buf)
(with-current-buffer buf (with-current-buffer buf
(eq major-mode 'lisp-interaction-mode))) (eq major-mode 'lisp-interaction-mode)))
(funcall ,saved-sym))))) (apply ,saved-sym args)))))
,@body)))) ,@body))))
@ -1386,19 +1387,14 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \
yet-another-c-mode yet-another-c-mode
and-also-this-one and-also-this-one
and-that-one and-that-one
;; prog-mode doesn't exist in emacs 23.4 prog-mode
,@(if (fboundp 'prog-mode) ,@(if (fboundp 'lisp-data-mode) ;Emacs≥28
'(prog-mode))
;; lisp-data-mode doesn't exist in emacs 27.1
,@(if (fboundp 'lisp-data-mode)
'(lisp-data-mode)) '(lisp-data-mode))
emacs-lisp-mode emacs-lisp-mode
lisp-interaction-mode lisp-interaction-mode))
;; `lisp-data-mode' doesn't exist prior to Emacs 28.
,@(and (fboundp 'lisp-data-mode) '(lisp-data-mode))))
(observed (yas--modes-to-activate))) (observed (yas--modes-to-activate)))
(should (equal major-mode (car observed))) (should (equal major-mode (car observed)))
(should (equal (sort expected #'string<) (sort observed #'string<)))))))) (should-not (cl-set-exclusive-or expected observed)))))))
(ert-deftest extra-modes-parenthood () (ert-deftest extra-modes-parenthood ()
"Test activation of parents of `yas--extra-modes'." "Test activation of parents of `yas--extra-modes'."
@ -1415,27 +1411,21 @@ hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \
(yas-activate-extra-mode 'and-that-one) (yas-activate-extra-mode 'and-that-one)
(let* ((expected-first `(and-that-one (let* ((expected-first `(and-that-one
yet-another-c-mode yet-another-c-mode
c-mode c-mode))
,major-mode))
(expected-rest `(cc-mode (expected-rest `(cc-mode
;; prog-mode doesn't exist in emacs 23.4 prog-mode
,@(if (fboundp 'prog-mode) ,@(if (fboundp 'lisp-data-mode) ;Emacs≥28
'(prog-mode))
;; lisp-data-mode doesn't exist in emacs 27.1
,@(if (fboundp 'lisp-data-mode)
'(lisp-data-mode)) '(lisp-data-mode))
emacs-lisp-mode emacs-lisp-mode
and-also-this-one and-also-this-one
lisp-interaction-mode lisp-interaction-mode))
;; `lisp-data-mode' doesn't exist prior to (observed (remq 'fundamental-mode (yas--modes-to-activate))))
;; Emacs 28. (should-not (cl-set-exclusive-or
,@(and (fboundp 'lisp-data-mode) expected-first
'(lisp-data-mode)))) (cl-subseq observed 0 (length expected-first))))
(observed (yas--modes-to-activate))) (should-not (cl-set-exclusive-or
(should (equal expected-first expected-rest
(cl-subseq observed 0 (length expected-first)))) (cl-subseq observed (length expected-first)))))))))
(should (equal (sort expected-rest #'string<)
(sort (cl-subseq observed (length expected-first)) #'string<))))))))
(defalias 'yas--phony-c-mode #'c-mode) (defalias 'yas--phony-c-mode #'c-mode)

20
yasnippet.el
View File

@ -828,10 +828,12 @@ which decides on the snippet to expand.")
(mapcar #'yas--all-parents (mapcar #'yas--all-parents
(gethash parent yas--parents)))) (gethash parent yas--parents))))
ap))) ap)))
(yas--merge-ordered-lists (cl-assert (eq mode (car ap)))
(cons (if (eq (car ap) 'fundamental-mode) ap (cons mode
(append ap '(fundamental-mode))) (yas--merge-ordered-lists
extras))) (cons (if (eq mode 'fundamental-mode) ()
(append (cdr ap) '(fundamental-mode)))
extras))))
(cons mode (cons mode
(yas--merge-ordered-lists (yas--merge-ordered-lists
(mapcar #'yas--all-parents (mapcar #'yas--all-parents
@ -851,15 +853,15 @@ which decides on the snippet to expand.")
"Compute list of mode symbols that are active for `yas-expand' and friends." "Compute list of mode symbols that are active for `yas-expand' and friends."
(let* ((modes (let* ((modes
(delete-dups (delete-dups
(remq nil `(,(or mode major-mode) (remq nil `(,@(unless mode yas--extra-modes)
,(or mode major-mode)
;; FIXME: Alternative major modes should use ;; FIXME: Alternative major modes should use
;; `derived-mode-add-parents', but until that ;; `derived-mode-add-parents', but until that
;; becomes common, use `major-mode-remap-alist' ;; becomes common, use `major-mode-remap-alist'
;; as a crutch to supplement the mode hierarchy. ;; as a crutch to supplement the mode hierarchy.
,(and (boundp 'major-mode-remap-alist) ,(and (boundp 'major-mode-remap-alist)
(car (rassq (or mode major-mode) (car (rassq (or mode major-mode)
major-mode-remap-alist))) major-mode-remap-alist))))))))
,@(unless mode (reverse yas--extra-modes)))))))
(yas--merge-ordered-lists (yas--merge-ordered-lists
(mapcar #'yas--all-parents modes)))) (mapcar #'yas--all-parents modes))))
@ -1281,7 +1283,7 @@ Return TEMPLATE."
(cl-assert menu-keymap) (cl-assert menu-keymap)
(yas--delete-from-keymap menu-keymap (yas--template-uuid template)) (yas--delete-from-keymap menu-keymap (yas--template-uuid template))
;; Add necessary subgroups as necessary. ;; Add subgroups as necessary.
;; ;;
(dolist (subgroup group) (dolist (subgroup group)
(let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol subgroup))))) (let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol subgroup)))))
@ -1491,7 +1493,7 @@ Also tries to work around Emacs Bug#30931."
(yas--safely-call-fun (apply-partially #'eval form))) (yas--safely-call-fun (apply-partially #'eval form)))
(defun yas--read-lisp (string &optional nil-on-error) (defun yas--read-lisp (string &optional nil-on-error)
"Read STRING as a elisp expression and return it. "Read STRING as an Elisp expression and return it.
In case STRING in an invalid expression and NIL-ON-ERROR is nil, In case STRING in an invalid expression and NIL-ON-ERROR is nil,
return an expression that when evaluated will issue an error." return an expression that when evaluated will issue an error."