1 ;;; yasnippet-tests.el --- some yasnippet tests -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
5 ;; Author: João Távora <joaot@siscog.pt>
6 ;; Keywords: emulations, convenience
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;; Test basic snippet mechanics and the loading system
35 (defun yas--buffer-contents ()
36 (buffer-substring-no-properties (point-min) (point-max)))
38 (ert-deftest field-navigation ()
41 (yas-expand-snippet "${1:brother} from another ${2:mother}")
42 (should (string= (yas--buffer-contents)
43 "brother from another mother"))
45 (should (looking-at "brother"))
46 (ert-simulate-command '(yas-next-field-or-maybe-expand))
47 (should (looking-at "mother"))
48 (ert-simulate-command '(yas-prev-field))
49 (should (looking-at "brother"))))
51 (ert-deftest simple-mirror ()
54 (yas-expand-snippet "${1:brother} from another $1")
55 (should (string= (yas--buffer-contents)
56 "brother from another brother"))
57 (yas-mock-insert "bla")
58 (should (string= (yas--buffer-contents)
59 "bla from another bla"))))
61 (ert-deftest mirror-with-transformation ()
64 (yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
65 (should (string= (yas--buffer-contents)
66 "brother from another BROTHER"))
67 (yas-mock-insert "bla")
68 (should (string= (yas--buffer-contents)
69 "bla from another BLA"))))
71 (ert-deftest mirror-with-transformation-and-autofill ()
72 "Test interaction of autofill with mirror transforms"
73 (let ((words "one two three four five")
76 (c-mode) ; In `c-mode' filling comments works by narrowing.
80 (yas-expand-snippet "/* $0\n */")
81 (yas-mock-insert words)
82 (setq filled-words (delete-and-extract-region (point-min) (point-max)))
83 (yas-expand-snippet "/* $1\n */\n$2$2")
84 (should (string= (yas--buffer-contents)
86 (yas-mock-insert words)
87 (should (string= (yas--buffer-contents)
88 (concat filled-words "\n"))))))
91 (ert-deftest primary-field-transformation ()
94 (let ((snippet "${1:$$(upcase yas-text)}${1:$(concat \"bar\" yas-text)}"))
95 (yas-expand-snippet snippet)
96 (should (string= (yas--buffer-contents) "bar"))
97 (yas-mock-insert "foo")
98 (should (string= (yas--buffer-contents) "FOObarFOO")))))
100 (ert-deftest nested-placeholders-kill-superfield ()
103 (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
104 (should (string= (yas--buffer-contents)
105 "brother from another mother!"))
106 (yas-mock-insert "bla")
107 (should (string= (yas--buffer-contents)
108 "brother from bla!"))))
110 (ert-deftest nested-placeholders-use-subfield ()
113 (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
114 (ert-simulate-command '(yas-next-field-or-maybe-expand))
115 (yas-mock-insert "bla")
116 (should (string= (yas--buffer-contents)
117 "brother from another bla!"))))
119 (ert-deftest mirrors-adjacent-to-fields-with-nested-mirrors ()
122 (yas-expand-snippet "<%= f.submit \"${1:Submit}\"${2:$(and (yas-text) \", :disable_with => '\")}${2:$1ing...}${2:$(and (yas-text) \"'\")} %>")
123 (should (string= (yas--buffer-contents)
124 "<%= f.submit \"Submit\", :disable_with => 'Submiting...' %>"))
125 (yas-mock-insert "Send")
126 (should (string= (yas--buffer-contents)
127 "<%= f.submit \"Send\", :disable_with => 'Sending...' %>"))))
129 (ert-deftest deep-nested-mirroring-issue-351 ()
132 (yas-expand-snippet "${1:FOOOOOOO}${2:$1}${3:$2}${4:$3}")
133 (yas-mock-insert "abc")
134 (should (string= (yas--buffer-contents) "abcabcabcabc"))))
136 (ert-deftest delete-numberless-inner-snippet-issue-562 ()
139 (yas-expand-snippet "${3:${test}bla}$0${2:ble}")
140 (ert-simulate-command '(yas-next-field-or-maybe-expand))
141 (should (looking-at "testblable"))
142 (ert-simulate-command '(yas-next-field-or-maybe-expand))
143 (ert-simulate-command '(yas-skip-and-clear-or-delete-char))
144 (should (looking-at "ble"))
145 (should (null (yas--snippets-at-point)))))
147 (ert-deftest ignore-trailing-whitespace ()
150 (insert "# key: foo\n# --\nfoo")
151 (yas--parse-template))
153 (insert "# key: foo \n# --\nfoo")
154 (yas--parse-template)))))
156 ;; (ert-deftest in-snippet-undo ()
158 ;; (yas-minor-mode 1)
159 ;; (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
160 ;; (ert-simulate-command '(yas-next-field-or-maybe-expand))
161 ;; (yas-mock-insert "bla")
162 ;; (ert-simulate-command '(undo))
163 ;; (should (string= (yas--buffer-contents)
164 ;; "brother from another mother!"))))
166 (ert-deftest dont-clear-on-partial-deletion-issue-515 ()
167 "Ensure fields are not cleared when user doesn't really mean to."
170 (yas-expand-snippet "my ${1:kid brother} from another ${2:mother}")
172 (ert-simulate-command '(kill-word 1))
173 (ert-simulate-command '(delete-char 1))
175 (should (string= (yas--buffer-contents)
176 "my brother from another mother"))
177 (should (looking-at "brother"))
179 (ert-simulate-command '(yas-next-field))
180 (should (looking-at "mother"))
181 (ert-simulate-command '(yas-prev-field))
182 (should (looking-at "brother"))))
184 (ert-deftest do-clear-on-yank-issue-515 ()
185 "A yank should clear an unmodified field."
188 (yas-expand-snippet "my ${1:kid brother} from another ${2:mother}")
189 (yas-mock-yank "little sibling")
190 (should (string= (yas--buffer-contents)
191 "my little sibling from another mother"))
192 (ert-simulate-command '(yas-next-field))
193 (ert-simulate-command '(yas-prev-field))
194 (should (looking-at "little sibling"))))
196 (ert-deftest basic-indentation ()
200 (set (make-local-variable 'yas-indent-line) 'auto)
201 (set (make-local-variable 'yas-also-auto-indent-first-line) t)
202 (yas-expand-snippet "def ${1:method}${2:(${3:args})}\n$0\nend")
203 ;; Note that empty line is not indented.
204 (should (string= "def method(args)
206 end" (buffer-string)))
207 (cl-loop repeat 3 do (ert-simulate-command '(yas-next-field)))
208 (yas-mock-insert (make-string (random 5) ?\ )) ; purposedly mess up indentation
209 (yas-expand-snippet "class << ${self}\n $0\nend")
210 (ert-simulate-command '(yas-next-field))
211 (should (string= "def method(args)
215 end" (buffer-string)))
216 (should (= 4 (current-column)))))
218 (ert-deftest indentation-markers ()
219 "Test a snippet with indentation markers (`$<')."
223 (set (make-local-variable 'yas-indent-line) nil)
224 (yas-expand-snippet "def ${1:method}${2:(${3:args})}\n$>Indent\nNo indent\\$>\nend")
225 (should (string= "def method(args)
228 end" (buffer-string)))))
231 (ert-deftest navigate-a-snippet-with-multiline-mirrors-issue-665 ()
232 "In issue 665, a multi-line mirror is attempted.
234 Indentation doesn't (yet) happen on these mirrors, but let this
235 test guard against any misnavigations that might be introduced by
236 an incorrect implementation of mirror auto-indentation"
240 (yas-expand-snippet "def initialize(${1:params})\n$2${1:$(
241 mapconcat #'(lambda (arg)
242 (format \"@%s = %s\" arg arg))
243 (split-string yas-text \", \")
245 (yas-mock-insert "bla, ble, bli")
246 (ert-simulate-command '(yas-next-field))
247 (let ((expected (mapconcat #'identity
249 "[[:blank:]]*@ble = ble"
250 "[[:blank:]]*@bli = bli")
252 (should (looking-at expected))
253 (yas-mock-insert "blo")
254 (ert-simulate-command '(yas-prev-field))
255 (ert-simulate-command '(yas-next-field))
256 (should (looking-at (concat "blo" expected))))))
259 ;;; Snippet expansion and character escaping
260 ;;; Thanks to @zw963 (Billy) for the testing
262 (ert-deftest escape-dollar ()
265 (yas-expand-snippet "bla\\${1:bla}ble")
266 (should (string= (yas--buffer-contents) "bla${1:bla}ble"))))
268 (ert-deftest escape-closing-brace ()
271 (yas-expand-snippet "bla${1:bla\\}}ble")
272 (should (string= (yas--buffer-contents) "blabla}ble"))
273 (should (string= (yas-field-value 1) "bla}"))))
275 (ert-deftest escape-backslashes ()
278 (yas-expand-snippet "bla\\ble")
279 (should (string= (yas--buffer-contents) "bla\\ble"))))
281 (ert-deftest escape-backquotes ()
284 (yas-expand-snippet "bla`(upcase \"foo\\`bar\")`ble")
285 (should (string= (yas--buffer-contents) "blaFOO`BARble"))))
287 (ert-deftest escape-some-elisp-with-strings ()
288 "elisp with strings and unbalance parens inside it"
291 ;; The rules here is: to output a literal `"' you need to escape
292 ;; it with one backslash. You don't need to escape them in
294 (yas-expand-snippet "soon \\\"`(concat (upcase \"(my arms\")\"\\\" were all around her\")`")
295 (should (string= (yas--buffer-contents) "soon \"(MY ARMS\" were all around her"))))
297 (ert-deftest escape-some-elisp-with-backslashes ()
300 ;; And the rule here is: to output a literal `\' inside a string
301 ;; inside embedded elisp you need a total of six `\'
302 (yas-expand-snippet "bla`(upcase \"hey\\\\\\yo\")`ble")
303 (should (string= (yas--buffer-contents) "blaHEY\\YOble"))))
305 (ert-deftest be-careful-when-escaping-in-yas-selected-text ()
308 (let ((yas-selected-text "He\\\\o world!"))
309 (yas-expand-snippet "Look ma! `(yas-selected-text)`")
310 (should (string= (yas--buffer-contents) "Look ma! He\\\\o world!")))
311 (yas-exit-all-snippets)
313 (let ((yas-selected-text "He\"o world!"))
314 (yas-expand-snippet "Look ma! `(yas-selected-text)`")
315 (should (string= (yas--buffer-contents) "Look ma! He\"o world!")))
316 (yas-exit-all-snippets)
318 (let ((yas-selected-text "He\"\)\\o world!"))
319 (yas-expand-snippet "Look ma! `(yas-selected-text)`")
320 (should (string= (yas--buffer-contents) "Look ma! He\"\)\\o world!")))
321 (yas-exit-all-snippets)
324 (ert-deftest be-careful-when-escaping-in-yas-selected-text-2 ()
327 (let ((yas-selected-text "He)}o world!"))
328 (yas-expand-snippet "Look ma! ${1:`(yas-selected-text)`} OK?")
329 (should (string= (yas--buffer-contents) "Look ma! He)}o world! OK?")))))
331 (ert-deftest example-for-issue-271 ()
334 (let ((yas-selected-text "aaa")
335 (snippet "if ${1:condition}\n`yas-selected-text`\nelse\n$3\nend"))
336 (yas-expand-snippet snippet)
338 (yas-mock-insert "bbb")
339 (should (string= (yas--buffer-contents) "if condition\naaa\nelse\nbbb\nend")))))
341 (defmacro yas--with-font-locked-temp-buffer (&rest body)
342 "Like `with-temp-buffer', but ensure `font-lock-mode'."
343 (declare (indent 0) (debug t))
344 (let ((temp-buffer (make-symbol "temp-buffer")))
345 ;; NOTE: buffer name must not start with a space, otherwise
346 ;; `font-lock-mode' doesn't turn on.
347 `(let ((,temp-buffer (generate-new-buffer "*yas-temp*")))
348 (with-current-buffer ,temp-buffer
349 ;; pretend we're interactive so `font-lock-mode' turns on
350 (let ((noninteractive nil)
351 ;; turn on font locking after major mode change
352 (change-major-mode-after-body-hook #'font-lock-mode))
354 (progn (require 'font-lock)
355 ;; turn on font locking before major mode change
358 (and (buffer-name ,temp-buffer)
359 (kill-buffer ,temp-buffer))))))))
361 (defmacro yas-saving-variables (&rest body)
362 `(yas-call-with-saving-variables #'(lambda () ,@body)))
364 (defmacro yas-with-snippet-dirs (dirs &rest body)
365 (declare (indent defun))
366 `(yas-call-with-snippet-dirs ,dirs
370 (ert-deftest example-for-issue-474 ()
371 (yas--with-font-locked-temp-buffer
374 (insert "#include <foo>\n")
375 (let ((yas-good-grace nil)) (yas-expand-snippet "`\"TODO: \"`"))
376 (should (string= (yas--buffer-contents) "#include <foo>\nTODO: "))))
378 (ert-deftest example-for-issue-404 ()
379 (yas--with-font-locked-temp-buffer
382 (insert "#include <foo>\n")
383 (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
384 (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
386 (ert-deftest example-for-issue-404-c-mode ()
387 (yas--with-font-locked-temp-buffer
390 (insert "#include <foo>\n")
391 (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
392 (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
394 (ert-deftest middle-of-buffer-snippet-insertion ()
398 (save-excursion (insert "end"))
399 (yas-expand-snippet "-middle-")
400 (should (string= (yas--buffer-contents) "beginning-middle-end"))))
402 (ert-deftest another-example-for-issue-271 ()
403 ;; expect this to fail in batch mode since `region-active-p' doesn't
404 ;; used by `yas-expand-snippet' doesn't make sense in that context.
406 :expected-result (if noninteractive
411 (let ((snippet "\\${${1:1}:`yas-selected-text`}"))
415 (yas-expand-snippet snippet)
416 (should (string= (yas--buffer-contents) "aaa${1:bbb}ccc")))))
418 (ert-deftest string-match-with-subregexp-in-embedded-elisp ()
421 ;; the rule here is: To use regexps in embedded `(elisp)` expressions, write
422 ;; it like you would normal elisp, i.e. no need to escape the backslashes.
423 (let ((snippet "`(if (string-match \"foo\\\\(ba+r\\\\)foo\" \"foobaaaaaaaaaarfoo\")
426 (yas-expand-snippet snippet))
427 (should (string= (yas--buffer-contents) "ok"))))
429 (ert-deftest string-match-with-subregexp-in-mirror-transformations ()
432 ;; the rule here is: To use regexps in embedded `(elisp)` expressions,
433 ;; escape backslashes once, i.e. to use \\( \\) constructs, write \\\\( \\\\).
434 (let ((snippet "$1${1:$(if (string-match \"foo\\\\\\\\(ba+r\\\\\\\\)baz\" yas-text)
437 (yas-expand-snippet snippet)
438 (should (string= (yas--buffer-contents) "fail"))
439 (yas-mock-insert "foobaaar")
440 (should (string= (yas--buffer-contents) "foobaaarfail"))
441 (yas-mock-insert "baz")
442 (should (string= (yas--buffer-contents) "foobaaarbazok")))))
447 (ert-deftest protection-overlay-no-cheating ()
448 "Protection overlays at the very end of the buffer are dealt
449 with by cheatingly inserting a newline!
451 TODO: correct this bug!"
452 :expected-result :failed
455 (yas-expand-snippet "${2:brother} from another ${1:mother}")
456 (should (string= (yas--buffer-contents)
457 "brother from another mother") ;; no newline should be here!
461 (defvar yas--foobarbaz)
463 ;; See issue #497. To understand this test, follow the example of the
464 ;; `yas-key-syntaxes' docstring.
466 (ert-deftest complicated-yas-key-syntaxes ()
468 (yas-saving-variables
469 (yas-with-snippet-dirs
470 '((".emacs.d/snippets"
472 ("foo-barbaz" . "# condition: yas--foobarbaz\n# --\nOKfoo-barbazOK")
473 ("barbaz" . "# condition: yas--barbaz\n# --\nOKbarbazOK")
475 ("'quote" . "OKquoteOK"))))
479 (let ((yas-key-syntaxes '("w" "w_")))
480 (let ((yas--barbaz t))
481 (yas-should-expand '(("foo-barbaz" . "foo-OKbarbazOK")
482 ("barbaz" . "OKbarbazOK"))))
483 (let ((yas--foobarbaz t))
484 (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK"))))
485 (let ((yas-key-syntaxes
486 (cons #'(lambda (_start-point)
487 (unless (looking-back "-")
492 (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))))
493 (let ((yas-key-syntaxes '(yas-try-key-from-whitespace)))
494 (yas-should-expand '(("xxx\n'quote" . "xxx\nOKquoteOK")
495 ("xxx 'quote" . "xxx OKquoteOK"))))
496 (let ((yas-key-syntaxes '(yas-shortest-key-until-whitespace))
497 (yas--foobarbaz t) (yas--barbaz t))
498 (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))
499 (setq yas-key-syntaxes '(yas-longest-key-from-whitespace))
500 (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK")
501 ("foo " . "foo "))))))))
506 (defun yas--call-with-temporary-redefinitions (function
507 &rest function-names-and-overriding-functions)
508 (let* ((overrides (remove-if-not #'(lambda (fdef)
509 (fboundp (first fdef)))
510 function-names-and-overriding-functions))
511 (definition-names (mapcar #'first overrides))
512 (overriding-functions (mapcar #'second overrides))
513 (saved-functions (mapcar #'symbol-function definition-names)))
514 ;; saving all definitions before overriding anything ensures FDEFINITION
515 ;; errors don't cause accidental permanent redefinitions.
517 (cl-labels ((set-fdefinitions (names functions)
518 (loop for name in names
521 (set-fdefinitions definition-names overriding-functions)
522 (unwind-protect (funcall function)
523 (set-fdefinitions definition-names saved-functions)))))
525 (defmacro yas--with-temporary-redefinitions (fdefinitions &rest body)
526 ;; "Temporarily (but globally) redefine each function in FDEFINITIONS.
527 ;; E.g.: (yas--with-temporary-redefinitions ((foo (x) ...)
529 ;; ;; code that eventually calls foo, bar of (setf foo)
531 ;; FIXME: This is hideous! Better use defadvice (or at least letf).
532 `(yas--call-with-temporary-redefinitions
534 ,@(mapcar #'(lambda (thingy)
535 `(list ',(first thingy)
536 (lambda ,@(rest thingy))))
539 (defmacro yas-with-overriden-buffer-list (&rest body)
540 (let ((saved-sym (make-symbol "yas--buffer-list")))
541 `(let ((,saved-sym (symbol-function 'buffer-list)))
542 (yas--with-temporary-redefinitions
544 (remove-if #'(lambda (buf)
545 (with-current-buffer buf
546 (eq major-mode 'lisp-interaction-mode)))
547 (funcall ,saved-sym))))
551 (defmacro yas-with-some-interesting-snippet-dirs (&rest body)
552 `(yas-saving-variables
553 (yas-with-overriden-buffer-list
554 (yas-with-snippet-dirs
555 '((".emacs.d/snippets"
557 (".yas-parents" . "cc-mode")
558 ("printf" . "printf($1);")) ;; notice the overriding for issue #281
559 ("emacs-lisp-mode" ("ert-deftest" . "(ert-deftest ${1:name} () $0)"))
560 ("lisp-interaction-mode" (".yas-parents" . "emacs-lisp-mode")))
563 (".yas-parents" . "c++-mode")
564 ("printf" . "printf"))
565 ("cc-mode" ("def" . "# define"))
566 ("emacs-lisp-mode" ("dolist" . "(dolist)"))
567 ("lisp-interaction-mode" ("sc" . "brother from another mother"))))
570 (ert-deftest snippet-lookup ()
571 "Test `yas-lookup-snippet'."
572 (yas-with-some-interesting-snippet-dirs
573 (yas-reload-all 'no-jit)
574 (should (equal (yas-lookup-snippet "printf" 'c-mode) "printf($1);"))
575 (should (equal (yas-lookup-snippet "def" 'c-mode) "# define"))
576 (should-not (yas-lookup-snippet "no such snippet" nil 'noerror))
577 (should-not (yas-lookup-snippet "printf" 'emacs-lisp-mode 'noerror))))
579 (ert-deftest basic-jit-loading ()
580 "Test basic loading and expansion of snippets"
581 (yas-with-some-interesting-snippet-dirs
583 (yas--basic-jit-loading-1)))
585 (ert-deftest basic-jit-loading-with-compiled-snippets ()
586 "Test basic loading and expansion of compiled snippets"
587 (yas-with-some-interesting-snippet-dirs
590 (yas--with-temporary-redefinitions ((yas--load-directory-2
592 (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled")))
594 (yas--basic-jit-loading-1))))
596 (ert-deftest visiting-compiled-snippets ()
597 "Test snippet visiting for compiled snippets."
598 (yas-with-some-interesting-snippet-dirs
600 (yas-reload-all 'no-jit) ; must be loaded for `yas-lookup-snippet' to work.
601 (yas--with-temporary-redefinitions ((find-file-noselect
603 (throw 'yas-snippet-file filename)))
604 (should (string-suffix-p
606 (catch 'yas-snippet-file
607 (yas--visit-snippet-file-1
608 (yas--lookup-snippet-1 "def" 'cc-mode))))))))
610 (ert-deftest loading-with-cyclic-parenthood ()
611 "Test loading when cyclic parenthood is setup."
612 (yas-saving-variables
613 (yas-with-snippet-dirs '((".emacs.d/snippets"
615 (".yas-parents" . "cc-mode"))
617 (".yas-parents" . "yet-another-c-mode and-that-one"))
618 ("yet-another-c-mode"
619 (".yas-parents" . "c-mode and-also-this-one lisp-interaction-mode"))))
622 (let* ((major-mode 'c-mode)
628 ;; prog-mode doesn't exist in emacs 24.3
629 ,@(if (fboundp 'prog-mode)
632 lisp-interaction-mode))
633 (observed (yas--modes-to-activate)))
634 (should (equal major-mode (car observed)))
635 (should (equal (sort expected #'string<) (sort observed #'string<))))))))
637 (ert-deftest extra-modes-parenthood ()
638 "Test activation of parents of `yas--extra-modes'."
639 (yas-saving-variables
640 (yas-with-snippet-dirs '((".emacs.d/snippets"
642 (".yas-parents" . "cc-mode"))
643 ("yet-another-c-mode"
644 (".yas-parents" . "c-mode and-also-this-one lisp-interaction-mode"))))
647 (yas-activate-extra-mode 'c-mode)
648 (yas-activate-extra-mode 'yet-another-c-mode)
649 (yas-activate-extra-mode 'and-that-one)
650 (let* ((expected-first `(and-that-one
654 (expected-rest `(cc-mode
655 ;; prog-mode doesn't exist in emacs 24.3
656 ,@(if (fboundp 'prog-mode)
660 lisp-interaction-mode))
661 (observed (yas--modes-to-activate)))
662 (should (equal expected-first
663 (cl-subseq observed 0 (length expected-first))))
664 (should (equal (sort expected-rest #'string<)
665 (sort (cl-subseq observed (length expected-first)) #'string<))))))))
667 (defalias 'yas--phony-c-mode 'c-mode)
669 (ert-deftest issue-492-and-494 ()
670 (define-derived-mode yas--test-mode yas--phony-c-mode "Just a test mode")
671 (yas-with-snippet-dirs '((".emacs.d/snippets"
675 (let* ((major-mode 'yas--test-mode)
677 ,@(if (fboundp 'prog-mode)
681 (observed (yas--modes-to-activate)))
682 (should (null (cl-set-exclusive-or expected observed)))
683 (should (= (length expected)
684 (length observed)))))))
686 (define-derived-mode yas--test-mode c-mode "Just a test mode")
687 (define-derived-mode yas--another-test-mode c-mode "Another test mode")
689 (ert-deftest issue-504-tricky-jit ()
690 (yas-with-snippet-dirs
691 '((".emacs.d/snippets"
692 ("yas--another-test-mode"
693 (".yas-parents" . "yas--test-mode"))
695 (let ((b (with-current-buffer (generate-new-buffer "*yas-test*")
696 (yas--another-test-mode)
701 (should (= 0 (hash-table-count yas--scheduled-jit-loads))))
704 (defun yas--basic-jit-loading-1 ()
706 (should (= 4 (hash-table-count yas--scheduled-jit-loads)))
707 (should (= 0 (hash-table-count yas--tables)))
708 (lisp-interaction-mode)
710 (should (= 2 (hash-table-count yas--scheduled-jit-loads)))
711 (should (= 2 (hash-table-count yas--tables)))
712 (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'lisp-interaction-mode yas--tables)))))
713 (should (= 2 (hash-table-count (yas--table-uuidhash (gethash 'emacs-lisp-mode yas--tables)))))
714 (yas-should-expand '(("sc" . "brother from another mother")
715 ("dolist" . "(dolist)")
716 ("ert-deftest" . "(ert-deftest name () )")))
719 (should (= 0 (hash-table-count yas--scheduled-jit-loads)))
720 (should (= 4 (hash-table-count yas--tables)))
721 (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'c-mode yas--tables)))))
722 (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'cc-mode yas--tables)))))
723 (yas-should-expand '(("printf" . "printf();")
724 ("def" . "# define")))
725 (yas-should-not-expand '("sc" "dolist" "ert-deftest"))))
730 (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
731 `(yas-saving-variables
732 (yas-with-snippet-dirs
733 `((".emacs.d/snippets"
735 (".yas-make-groups" . "")
736 ("printf" . "printf($1);")
738 ("fnprintf" . "fprintf($1);")
739 ("snprintf" . "snprintf($1);"))
741 ("strcmp" . "strecmp($1);")
742 ("strcasecmp" . "strcasecmp($1);")))
743 ("lisp-interaction-mode"
744 ("ert-deftest" . "# group: barbar\n# --\n(ert-deftest ${1:name} () $0)"))
746 ("a-guy" . "# uuid: 999\n# --\nyo!")
747 ("a-sir" . "# uuid: 12345\n# --\nindeed!")
748 ("a-lady" . "# uuid: 54321\n# --\noh-la-la!")
749 ("a-beggar" . "# uuid: 0101\n# --\narrrgh!")
750 ("an-outcast" . "# uuid: 666\n# --\narrrgh!")
751 (".yas-setup.el" . , (pp-to-string
752 '(yas-define-menu 'fancy-mode
753 '((yas-ignore-item "0101")
756 ((yas-item "12345")))
757 (yas-submenu "ladies"
758 ((yas-item "54321"))))
762 (ert-deftest test-yas-define-menu ()
763 (let ((yas-use-menu t))
764 (yas-with-even-more-interesting-snippet-dirs
765 (yas-reload-all 'no-jit)
766 (let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
767 (should (eql 4 (length menu)))
768 (dolist (item '("a-guy" "a-beggar"))
769 (should (find item menu :key #'third :test #'string=)))
770 (should-not (find "an-outcast" menu :key #'third :test #'string=))
771 (dolist (submenu '("sirs" "ladies"))
774 (find submenu menu :key #'third :test #'string=)))))
777 (ert-deftest test-group-menus ()
778 "Test group-based menus using .yas-make-groups and the group directive"
779 (let ((yas-use-menu t))
780 (yas-with-even-more-interesting-snippet-dirs
781 (yas-reload-all 'no-jit)
782 ;; first the subdir-based groups
784 (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
785 (should (eql 3 (length menu)))
786 (dolist (item '("printf" "foo-group-a" "foo-group-b"))
787 (should (find item menu :key #'third :test #'string=)))
788 (dolist (submenu '("foo-group-a" "foo-group-b"))
791 (find submenu menu :key #'third :test #'string=))))))
792 ;; now group directives
794 (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
795 (should (eql 1 (length menu)))
796 (should (find "barbar" menu :key #'third :test #'string=))
799 (find "barbar" menu :key #'third :test #'string=))))))))
801 (ert-deftest test-group-menus-twisted ()
802 "Same as similarly named test, but be mean.
805 (let ((yas-use-menu t))
806 (yas-with-even-more-interesting-snippet-dirs
807 ;; add a group directive conflicting with the subdir and watch
810 (insert "# group: foo-group-c\n# --\nstrecmp($1)")
811 (write-region nil nil (concat (first (yas-snippet-dirs))
812 "/c-mode/foo-group-b/strcmp")))
813 (yas-reload-all 'no-jit)
814 (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
815 (should (eql 4 (length menu)))
816 (dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
817 (should (find item menu :key #'third :test #'string=)))
818 (dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
821 (find submenu menu :key #'third :test #'string=))))))
822 ;; delete the .yas-make-groups file and watch behaviour
824 (delete-file (concat (first (yas-snippet-dirs))
825 "/c-mode/.yas-make-groups"))
826 (yas-reload-all 'no-jit)
827 (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
828 (should (eql 5 (length menu))))
829 ;; Change a group directive and reload
831 (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
832 (should (find "barbar" menu :key #'third :test #'string=)))
835 (insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
836 (write-region nil nil (concat (first (yas-snippet-dirs))
837 "/lisp-interaction-mode/ert-deftest")))
838 (yas-reload-all 'no-jit)
839 (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
840 (should (eql 1 (length menu)))
841 (should (find "foofoo" menu :key #'third :test #'string=))
844 (find "foofoo" menu :key #'third :test #'string=))))))))
847 ;;; The infamous and problematic tab keybinding
849 (ert-deftest test-yas-tab-binding ()
852 (should (not (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand)))
854 (should (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand))
855 (yas-expand-snippet "$1 $2 $3")
856 (should (eq (key-binding [(tab)]) 'yas-next-field-or-maybe-expand))
857 (should (eq (key-binding (kbd "TAB")) 'yas-next-field-or-maybe-expand))
858 (should (eq (key-binding [(shift tab)]) 'yas-prev-field))
859 (should (eq (key-binding [backtab]) 'yas-prev-field))))
861 (ert-deftest test-rebindings ()
864 (define-key yas-minor-mode-map [tab] nil)
865 (define-key yas-minor-mode-map (kbd "TAB") nil)
866 (define-key yas-minor-mode-map (kbd "SPC") 'yas-expand)
869 (should (not (eq (key-binding (yas--read-keybinding "TAB")) 'yas-expand)))
870 (should (eq (key-binding (yas--read-keybinding "SPC")) 'yas-expand))
872 (should (not (eq (key-binding (yas--read-keybinding "TAB")) 'yas-expand)))
873 (should (eq (key-binding (yas--read-keybinding "SPC")) 'yas-expand))))
874 ;; FIXME: actually should restore to whatever saved values where there.
876 (define-key yas-minor-mode-map [tab] 'yas-expand)
877 (define-key yas-minor-mode-map (kbd "TAB") 'yas-expand)
878 (define-key yas-minor-mode-map (kbd "SPC") nil)))
880 (ert-deftest test-yas-in-org ()
884 (should (eq (key-binding [(tab)]) 'yas-expand))
885 (should (eq (key-binding (kbd "TAB")) 'yas-expand))))
887 (ert-deftest test-yas-activate-extra-modes ()
888 "Given a symbol, `yas-activate-extra-mode' should be able to
889 add the snippets associated with the given mode."
891 (yas-saving-variables
892 (yas-with-snippet-dirs
893 '((".emacs.d/snippets"
897 ("car" . "(car )"))))
901 (yas-activate-extra-mode 'markdown-mode)
902 (should (eq 'markdown-mode (car yas--extra-modes)))
903 (yas-should-expand '(("_" . "_Text_ ")))
904 (yas-should-expand '(("car" . "(car )")))
905 (yas-deactivate-extra-mode 'markdown-mode)
906 (should-not (eq 'markdown-mode (car yas--extra-modes)))
907 (yas-should-not-expand '("_"))
908 (yas-should-expand '(("car" . "(car )")))))))
913 (defun yas-should-expand (keys-and-expansions)
914 (dolist (key-and-expansion keys-and-expansions)
915 (yas-exit-all-snippets)
917 (insert (car key-and-expansion))
918 (let ((yas-fallback-behavior nil))
919 (ert-simulate-command '(yas-expand)))
920 (unless (string= (yas--buffer-contents) (cdr key-and-expansion))
921 (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
922 (car key-and-expansion)
923 (cdr key-and-expansion)
924 (yas--buffer-contents)))))
925 (yas-exit-all-snippets))
927 (defun yas-should-not-expand (keys)
929 (yas-exit-all-snippets)
932 (let ((yas-fallback-behavior nil))
933 (ert-simulate-command '(yas-expand)))
934 (unless (string= (yas--buffer-contents) key)
935 (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\""
937 (yas--buffer-contents))))))
939 (defun yas-mock-insert (string)
940 (dotimes (i (length string))
941 (let ((last-command-event (aref string i)))
942 (ert-simulate-command '(self-insert-command 1)))))
944 (defun yas-mock-yank (string)
945 (let ((interprogram-paste-function (lambda () string)))
946 (ert-simulate-command '(yank nil))))
948 (defun yas-make-file-or-dirs (ass)
949 (let ((file-or-dir-name (car ass))
951 (cond ((listp content)
952 (make-directory file-or-dir-name 'parents)
953 (let ((default-directory (concat default-directory "/" file-or-dir-name)))
954 (mapc #'yas-make-file-or-dirs content)))
958 (write-region nil nil file-or-dir-name nil 'nomessage)))
960 (message "[yas] oops don't know this content")))))
963 (defun yas-variables ()
965 (mapatoms #'(lambda (sym)
966 (if (and (string-match "^yas-[^/]" (symbol-name sym))
971 (defun yas-call-with-saving-variables (fn)
972 (let* ((vars (yas-variables))
973 (saved-values (mapcar #'symbol-value vars)))
976 (loop for var in vars
977 for saved in saved-values
978 do (set var saved)))))
980 (defun yas-call-with-snippet-dirs (dirs fn)
981 (let* ((default-directory (make-temp-file "yasnippet-fixture" t))
982 (yas-snippet-dirs (mapcar #'car dirs)))
983 (with-temp-message ""
986 (mapc #'yas-make-file-or-dirs dirs)
988 (when (>= emacs-major-version 24)
989 (delete-directory default-directory 'recursive))))))
993 (unless (fboundp 'special-mode)
994 ;; FIXME: Why provide this default definition here?!?
995 (defalias 'special-mode 'fundamental))
997 (unless (fboundp 'string-suffix-p)
998 ;; introduced in Emacs 24.4
999 (defun string-suffix-p (suffix string &optional ignore-case)
1000 "Return non-nil if SUFFIX is a suffix of STRING.
1001 If IGNORE-CASE is non-nil, the comparison is done without paying
1002 attention to case differences."
1003 (let ((start-pos (- (length string) (length suffix))))
1004 (and (>= start-pos 0)
1005 (eq t (compare-strings suffix nil nil
1006 string start-pos nil ignore-case))))))
1008 ;;; btw to test this in emacs22 mac osx:
1009 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
1010 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
1011 ;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
1014 (put 'yas-saving-variables 'edebug-form-spec t)
1015 (put 'yas-with-snippet-dirs 'edebug-form-spec t)
1016 (put 'yas-with-overriden-buffer-list 'edebug-form-spec t)
1017 (put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t)
1020 (put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
1021 (put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
1026 (provide 'yasnippet-tests)
1028 ;; indent-tabs-mode: nil
1029 ;; byte-compile-warnings: (not cl-functions)
1031 ;;; yasnippet-tests.el ends here