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

Change cl dep to cl-lib for tests too

Browse Source 
* yasnippet-tests.el (yas--call-with-temporary-redefinitions):
(yas-with-overriden-buffer-list):
(snippet-save, test-yas-define-menu, test-group-menus):
(test-group-menus-twisted, yas-call-with-saving-variables): Replace cl
function with cl-lib named equivalents.
This commit is contained in:
Noam Postavsky 2016-10-07 19:54:23 -04:00
parent 85a43ad8e5
commit 00be21c717
1 changed files with 45 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
yasnippet-tests.el
View File

@ -27,7 +27,7 @@
(require 'yasnippet) (require 'yasnippet)
(require 'ert) (require 'ert)
(require 'ert-x) (require 'ert-x)
(require 'cl) (require 'cl-lib)
;;; Snippet mechanics ;;; Snippet mechanics
@ -528,17 +528,17 @@ TODO: correct this bug!"
;;; ;;;
(defun yas--call-with-temporary-redefinitions (function (defun yas--call-with-temporary-redefinitions (function
&rest function-names-and-overriding-functions) &rest function-names-and-overriding-functions)
(let* ((overrides (remove-if-not #'(lambda (fdef) (let* ((overrides (cl-remove-if-not (lambda (fdef)
(fboundp (first fdef))) (fboundp (car fdef)))
function-names-and-overriding-functions)) function-names-and-overriding-functions))
(definition-names (mapcar #'first overrides)) (definition-names (mapcar #'car overrides))
(overriding-functions (mapcar #'second overrides)) (overriding-functions (mapcar #'cl-second overrides))
(saved-functions (mapcar #'symbol-function definition-names))) (saved-functions (mapcar #'symbol-function definition-names)))
;; saving all definitions before overriding anything ensures FDEFINITION ;; saving all definitions before overriding anything ensures FDEFINITION
;; errors don't cause accidental permanent redefinitions. ;; errors don't cause accidental permanent redefinitions.
;; ;;
(cl-labels ((set-fdefinitions (names functions) (cl-labels ((set-fdefinitions (names functions)
(loop for name in names (cl-loop for name in names
for fn in functions for fn in functions
do (fset name fn)))) do (fset name fn))))
(set-fdefinitions definition-names overriding-functions) (set-fdefinitions definition-names overriding-functions)
@ -555,8 +555,8 @@ TODO: correct this bug!"
`(yas--call-with-temporary-redefinitions `(yas--call-with-temporary-redefinitions
(lambda () ,@body) (lambda () ,@body)
,@(mapcar #'(lambda (thingy) ,@(mapcar #'(lambda (thingy)
`(list ',(first thingy) `(list ',(car thingy)
(lambda ,@(rest thingy)))) (lambda ,@(cdr thingy))))
fdefinitions))) fdefinitions)))
(defmacro yas-with-overriden-buffer-list (&rest body) (defmacro yas-with-overriden-buffer-list (&rest body)
@ -564,7 +564,7 @@ TODO: correct this bug!"
`(let ((,saved-sym (symbol-function 'buffer-list))) `(let ((,saved-sym (symbol-function 'buffer-list)))
(yas--with-temporary-redefinitions (yas--with-temporary-redefinitions
((buffer-list () ((buffer-list ()
(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)))) (funcall ,saved-sym))))
@ -640,7 +640,7 @@ TODO: correct this bug!"
(yas-with-snippet-dirs (yas-with-snippet-dirs
'((".emacs.d/snippets" '((".emacs.d/snippets"
("text-mode"))) ("text-mode")))
(letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t)) (cl-letf (((symbol-function 'y-or-n-p) (lambda (&rest _) t))
((symbol-function 'read-file-name) ((symbol-function 'read-file-name)
(lambda (_prompt &optional _dir _default _mustmatch initial _predicate) (lambda (_prompt &optional _dir _default _mustmatch initial _predicate)
(expand-file-name initial))) (expand-file-name initial)))
@ -840,12 +840,12 @@ TODO: correct this bug!"
(let ((menu (cdr (gethash 'fancy-mode yas--menu-table)))) (let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
(should (eql 4 (length menu))) (should (eql 4 (length menu)))
(dolist (item '("a-guy" "a-beggar")) (dolist (item '("a-guy" "a-beggar"))
(should (find item menu :key #'third :test #'string=))) (should (cl-find item menu :key #'cl-third :test #'string=)))
(should-not (find "an-outcast" menu :key #'third :test #'string=)) (should-not (cl-find "an-outcast" menu :key #'cl-third :test #'string=))
(dolist (submenu '("sirs" "ladies")) (dolist (submenu '("sirs" "ladies"))
(should (keymapp (should (keymapp
(fourth (cl-fourth
(find submenu menu :key #'third :test #'string=))))) (cl-find submenu menu :key #'cl-third :test #'string=)))))
)))) ))))
(ert-deftest test-group-menus () (ert-deftest test-group-menus ()
@ -858,19 +858,19 @@ TODO: correct this bug!"
(let ((menu (cdr (gethash 'c-mode yas--menu-table)))) (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
(should (eql 3 (length menu))) (should (eql 3 (length menu)))
(dolist (item '("printf" "foo-group-a" "foo-group-b")) (dolist (item '("printf" "foo-group-a" "foo-group-b"))
(should (find item menu :key #'third :test #'string=))) (should (cl-find item menu :key #'cl-third :test #'string=)))
(dolist (submenu '("foo-group-a" "foo-group-b")) (dolist (submenu '("foo-group-a" "foo-group-b"))
(should (keymapp (should (keymapp
(fourth (cl-fourth
(find submenu menu :key #'third :test #'string=)))))) (cl-find submenu menu :key #'cl-third :test #'string=))))))
;; now group directives ;; now group directives
;; ;;
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table)))) (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
(should (eql 1 (length menu))) (should (eql 1 (length menu)))
(should (find "barbar" menu :key #'third :test #'string=)) (should (cl-find "barbar" menu :key #'cl-third :test #'string=))
(should (keymapp (should (keymapp
(fourth (cl-fourth
(find "barbar" menu :key #'third :test #'string=)))))))) (cl-find "barbar" menu :key #'cl-third :test #'string=))))))))
(ert-deftest test-group-menus-twisted () (ert-deftest test-group-menus-twisted ()
"Same as similarly named test, but be mean. "Same as similarly named test, but be mean.
@ -882,20 +882,20 @@ TODO: be meaner"
;; behaviour ;; behaviour
(with-temp-buffer (with-temp-buffer
(insert "# group: foo-group-c\n# --\nstrecmp($1)") (insert "# group: foo-group-c\n# --\nstrecmp($1)")
(write-region nil nil (concat (first (yas-snippet-dirs)) (write-region nil nil (concat (car (yas-snippet-dirs))
"/c-mode/foo-group-b/strcmp"))) "/c-mode/foo-group-b/strcmp")))
(yas-reload-all 'no-jit) (yas-reload-all 'no-jit)
(let ((menu (cdr (gethash 'c-mode yas--menu-table)))) (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
(should (eql 4 (length menu))) (should (eql 4 (length menu)))
(dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c")) (dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
(should (find item menu :key #'third :test #'string=))) (should (cl-find item menu :key #'cl-third :test #'string=)))
(dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c")) (dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
(should (keymapp (should (keymapp
(fourth (cl-fourth
(find submenu menu :key #'third :test #'string=)))))) (cl-find submenu menu :key #'cl-third :test #'string=))))))
;; delete the .yas-make-groups file and watch behaviour ;; delete the .yas-make-groups file and watch behaviour
;; ;;
(delete-file (concat (first (yas-snippet-dirs)) (delete-file (concat (car (yas-snippet-dirs))
"/c-mode/.yas-make-groups")) "/c-mode/.yas-make-groups"))
(yas-reload-all 'no-jit) (yas-reload-all 'no-jit)
(let ((menu (cdr (gethash 'c-mode yas--menu-table)))) (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
@ -903,19 +903,19 @@ TODO: be meaner"
;; Change a group directive and reload ;; Change a group directive and reload
;; ;;
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table)))) (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
(should (find "barbar" menu :key #'third :test #'string=))) (should (cl-find "barbar" menu :key #'cl-third :test #'string=)))
(with-temp-buffer (with-temp-buffer
(insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)") (insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
(write-region nil nil (concat (first (yas-snippet-dirs)) (write-region nil nil (concat (car (yas-snippet-dirs))
"/lisp-interaction-mode/ert-deftest"))) "/lisp-interaction-mode/ert-deftest")))
(yas-reload-all 'no-jit) (yas-reload-all 'no-jit)
(let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table)))) (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
(should (eql 1 (length menu))) (should (eql 1 (length menu)))
(should (find "foofoo" menu :key #'third :test #'string=)) (should (cl-find "foofoo" menu :key #'cl-third :test #'string=))
(should (keymapp (should (keymapp
(fourth (cl-fourth
(find "foofoo" menu :key #'third :test #'string=)))))))) (cl-find "foofoo" menu :key #'cl-third :test #'string=))))))))
;;; The infamous and problematic tab keybinding ;;; The infamous and problematic tab keybinding
@ -1045,7 +1045,7 @@ add the snippets associated with the given mode."
(saved-values (mapcar #'symbol-value vars))) (saved-values (mapcar #'symbol-value vars)))
(unwind-protect (unwind-protect
(funcall fn) (funcall fn)
(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 (set var saved)))))
@ -1098,6 +1098,5 @@ attention to case differences."
(provide 'yasnippet-tests) (provide 'yasnippet-tests)
;; Local Variables: ;; Local Variables:
;; indent-tabs-mode: nil ;; indent-tabs-mode: nil
;; byte-compile-warnings: (not cl-functions)
;; End: ;; End:
;;; yasnippet-tests.el ends here ;;; yasnippet-tests.el ends here