diff options
Diffstat (limited to 'yasnippet-tests.el')
| -rw-r--r-- | yasnippet-tests.el | 801 |
1 files changed, 653 insertions, 148 deletions
diff --git a/yasnippet-tests.el b/yasnippet-tests.el index 6b7a91a..6048467 100644 --- a/yasnippet-tests.el +++ b/yasnippet-tests.el @@ -1,6 +1,6 @@ ;;; yasnippet-tests.el --- some yasnippet tests -*- lexical-binding: t -*- -;; Copyright (C) 2012, 2013, 2014, 2015 Free Software Foundation, Inc. +;; Copyright (C) 2012-2015, 2017-2018 Free Software Foundation, Inc. ;; Author: João Távora <joaot@siscog.pt> ;; Keywords: emulations, convenience @@ -22,12 +22,134 @@ ;; Test basic snippet mechanics and the loading system +;; To test this in emacs22 mac osx: +;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el +;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el +;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert + ;;; Code: (require 'yasnippet) (require 'ert) (require 'ert-x) (require 'cl-lib) +(require 'org) + + +;;; Helper macros and function + +(defmacro yas-with-snippet-dirs (dirs &rest body) + (declare (indent defun) (debug t)) + `(yas-call-with-snippet-dirs + ,dirs #'(lambda () ,@body))) + +(defun yas-should-expand (keys-and-expansions) + (dolist (key-and-expansion keys-and-expansions) + (yas-exit-all-snippets) + (erase-buffer) + (insert (car key-and-expansion)) + (ert-simulate-command '(yas-expand)) + (unless (string= (yas--buffer-contents) (cdr key-and-expansion)) + (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\"" + (car key-and-expansion) + (cdr key-and-expansion) + (yas--buffer-contents))))) + (yas-exit-all-snippets)) + +(defun yas--collect-menu-items (menu-keymap) + (let ((yas--menu-items ())) + (map-keymap (lambda (_binding definition) + (when (eq (car-safe definition) 'menu-item) + (push definition yas--menu-items))) + menu-keymap) + yas--menu-items)) + +(defun yas-should-not-expand (keys) + (dolist (key keys) + (yas-exit-all-snippets) + (erase-buffer) + (insert key) + (ert-simulate-command '(yas-expand)) + (unless (string= (yas--buffer-contents) key) + (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\"" + key + (yas--buffer-contents)))))) + +(defun yas-mock-insert (string) + (dotimes (i (length string)) + (let ((last-command-event (aref string i))) + (ert-simulate-command '(self-insert-command 1))))) + +(defun yas-mock-yank (string) + (let ((interprogram-paste-function (lambda () string))) + (ert-simulate-command '(yank nil)))) + +(defun yas--key-binding (key) + "Like `key-binding', but override `this-command-keys-vector'. +This lets `yas--maybe-expand-from-keymap-filter' work as expected." + (cl-letf (((symbol-function 'this-command-keys-vector) + (lambda () (cl-coerce key 'vector)))) + (key-binding key))) + +(defun yas-make-file-or-dirs (ass) + (let ((file-or-dir-name (car ass)) + (content (cdr ass))) + (cond ((listp content) + (make-directory file-or-dir-name 'parents) + (let ((default-directory (concat default-directory "/" file-or-dir-name))) + (mapc #'yas-make-file-or-dirs content))) + ((stringp content) + (with-temp-buffer + (insert content) + (write-region nil nil file-or-dir-name nil 'nomessage))) + (t + (message "[yas] oops don't know this content"))))) + + +(defun yas-variables () + (let ((syms)) + (mapatoms #'(lambda (sym) + (if (and (string-match "^yas-[^/]" (symbol-name sym)) + (boundp sym)) + (push sym syms)))) + syms)) + +(defun yas-call-with-saving-variables (fn) + (let* ((vars (yas-variables)) + (saved-values (mapcar #'symbol-value vars))) + (unwind-protect + (funcall fn) + (cl-loop for var in vars + for saved in saved-values + do (set var saved))))) + +(defun yas-call-with-snippet-dirs (dirs fn) + (let* ((default-directory (make-temp-file "yasnippet-fixture" t)) + (yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs))) + (with-temp-message "" + (unwind-protect + (progn + (mapc #'yas-make-file-or-dirs dirs) + (funcall fn)) + (when (>= emacs-major-version 24) + (delete-directory default-directory 'recursive)))))) + +;;; Older emacsen +;;; +(unless (fboundp 'special-mode) + ;; FIXME: Why provide this default definition here?!? + (defalias 'special-mode 'fundamental)) + +(unless (fboundp 'string-suffix-p) + ;; introduced in Emacs 24.4 + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) ;;; Snippet mechanics @@ -90,6 +212,15 @@ (should (string= (yas--buffer-contents) (concat filled-words "\n")))))) +(ert-deftest auto-fill-with-multiparagraph () + "Test auto-fill protection on snippet spanning multiple paragraphs" + (with-temp-buffer + (yas-minor-mode +1) + (auto-fill-mode +1) + (yas-expand-snippet "foo$1\n\n$2bar") + (yas-mock-insert " ") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (should (looking-at "bar")))) (ert-deftest primary-field-transformation () (with-temp-buffer @@ -143,9 +274,20 @@ (ert-simulate-command '(yas-next-field-or-maybe-expand)) (should (looking-at "testblable")) (ert-simulate-command '(yas-next-field-or-maybe-expand)) - (ert-simulate-command '(yas-skip-and-clear-or-delete-char)) + (ert-simulate-command '(yas-skip-and-clear-field)) (should (looking-at "ble")) - (should (null (yas--snippets-at-point))))) + (should (null (yas-active-snippets))))) + +(ert-deftest delete-nested-simple-field-issue-824 () + "Test deleting a field with a nested simple field in it." + (with-temp-buffer + (yas-minor-mode 1) + (yas-expand-snippet "${3:so-$4and}$0${2:-so}") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (should (looking-at "so-and-so")) + (ert-simulate-command '(yas-skip-and-clear-or-delete-char)) + (should (looking-at "-so")) + (should (null (yas-active-snippets))))) (ert-deftest ignore-trailing-whitespace () (should (equal @@ -166,6 +308,76 @@ ;; (should (string= (yas--buffer-contents) ;; "brother from another mother!")))) +(ert-deftest undo-redo () + "Check redoing of snippet undo." + (yas-with-snippet-dirs '((".emacs.d/snippets" + ("emacs-lisp-mode" ("x" . "${1:one},and done")))) + (with-temp-buffer + (emacs-lisp-mode) + (yas-reload-all) + (yas-minor-mode 1) + (yas-expand-snippet "x$0") + (let ((pre-expand-string (buffer-string))) + (setq buffer-undo-list nil) + (ert-simulate-command '(yas-expand)) + (push nil buffer-undo-list) + (ert-simulate-command '(yas-next-field)) ; $1 -> exit snippet. + (should (string-match-p "\\`one,and done" (buffer-string))) + (push nil buffer-undo-list) + (ert-simulate-command '(undo)) ; Revive snippet. + (ert-simulate-command '(undo)) ; Undo expansion. + (should (string= (buffer-string) pre-expand-string)) + (ert-simulate-command '(move-end-of-line 1)) + (push nil buffer-undo-list) + (ert-simulate-command '(undo)) ; Redo (re-expand snippet). + (should (string-match-p "\\`one,and done" (buffer-string))))))) + +(defun yas-test-expand-and-undo (mode snippet-entry initial-contents) + (yas-with-snippet-dirs + `((".emacs.d/snippets" (,(symbol-name mode) ,snippet-entry))) + (with-temp-buffer + (funcall mode) + (yas-reload-all) + (yas-minor-mode 1) + (yas-expand-snippet initial-contents) + (let ((pre-expand-string (buffer-string))) + (setq buffer-undo-list ()) + (ert-simulate-command '(yas-expand)) + ;; Need undo barrier, I think command loop puts it normally. + (push nil buffer-undo-list) + (ert-simulate-command '(undo)) + (should (string= (buffer-string) pre-expand-string)))))) + +(ert-deftest undo-indentation-1 () + "Check undoing works when only line of snippet is indented." + (let ((yas-also-auto-indent-first-line t)) + (yas-test-expand-and-undo + 'emacs-lisp-mode '("s" . "(setq $0)") "(let\n(while s$0"))) + +(ert-deftest undo-indentation-2 () + "Check undoing works when only line of snippet is indented." + (let ((yas-also-auto-indent-first-line t) + (indent-tabs-mode nil)) + (yas-test-expand-and-undo + 'emacs-lisp-mode '("t" . "; TODO") "t$0"))) + +(ert-deftest undo-indentation-multiline-1 () + "Check undoing works when 1st line of multi-line snippet is indented." + (let ((yas-also-auto-indent-first-line t) + (indent-tabs-mode nil)) + (yas-test-expand-and-undo + 'js-mode '("if" . "if ($1) {\n\n}\n") + "if$0\nabc = 123456789 + abcdef;"))) + + +(ert-deftest undo-indentation-multiline-2 () + "Check undoing works when 2nd line of multi-line snippet is indented." + (let ((yas-also-auto-indent-first-line t) + (indent-tabs-mode nil)) + (yas-test-expand-and-undo + 'js-mode '("if" . "if (true) {\n${1:foo};\n}\n") + "if$0\nabc = 123456789 + abcdef;"))) + (ert-deftest dont-clear-on-partial-deletion-issue-515 () "Ensure fields are not cleared when user doesn't really mean to." (with-temp-buffer @@ -218,6 +430,47 @@ end" (buffer-string))) end" (buffer-string))) (should (= 4 (current-column))))) +(ert-deftest yas-also-indent-empty-lines () + "Respect `yas-also-indent-empty-lines' setting." + (with-temp-buffer + (ruby-mode) + (yas-minor-mode 1) + (set (make-local-variable 'yas-indent-line) 'auto) + (set (make-local-variable 'yas-also-auto-indent-first-line) t) + (set (make-local-variable 'yas-also-indent-empty-lines) t) + (yas-expand-snippet "def foo\n\nend") + (should (string= "def foo\n \nend" (buffer-string))) + ;; Test that it keeps working without setting + ;; `yas-also-auto-indent-first-line'. + (setq yas-also-auto-indent-first-line nil) + (erase-buffer) + (yas-expand-snippet "def foo\n\nend") + (should (string= "def foo\n \nend" (buffer-string))))) + +(ert-deftest yas-indent-first-line () + (with-temp-buffer + (ruby-mode) + (yas-minor-mode 1) + (set (make-local-variable 'yas-indent-line) 'auto) + (set (make-local-variable 'yas-also-auto-indent-first-line) nil) + (set (make-local-variable 'yas-also-indent-empty-lines) nil) + (yas-expand-snippet "def foo\n$0\nend\n") + ;; First (and only) line should not indent. + (yas-expand-snippet "#not indented") + (should (equal "def foo\n#not indented\nend\n" (buffer-string))))) + +(ert-deftest yas-indent-first-line-fixed () + (with-temp-buffer + (ruby-mode) + (yas-minor-mode 1) + (set (make-local-variable 'yas-indent-line) 'fixed) + (set (make-local-variable 'yas-also-auto-indent-first-line) nil) + (set (make-local-variable 'yas-also-indent-empty-lines) nil) + (yas-expand-snippet " def foo\n $0\n end\n") + ;; First (and only) line should not indent. + (yas-expand-snippet "#not more indented") + (should (equal " def foo\n #not more indented\n end\n" (buffer-string))))) + (ert-deftest indentation-markers () "Test a snippet with indentation markers (`$<')." (with-temp-buffer @@ -243,6 +496,78 @@ $1 ------------------------") XXXXX ---------------- XXXXX ---- XXXXX ------------------------")))) +(ert-deftest single-line-multi-mirror-indentation-2 () + "Like `single-line-multi-mirror-indentation' but 2 mirrors interleaved." + ;; See also Github issue #768. + (with-temp-buffer + (c-mode) + (yas-minor-mode 1) + (yas-expand-snippet "${1:one} ${2:two};\n$1 $2_;\n$2 $1_;\n") + (should (string= (yas--buffer-contents) + "one two;\none two_;\ntwo one_;\n")))) + +(ert-deftest indent-org-property () + "Handling of `org-mode' property indentation, see `org-property-format'." + ;; This is an interesting case because `org-indent-line' calls + ;; `replace-match' for properties. + (with-temp-buffer + (org-mode) + (yas-minor-mode +1) + (yas-expand-snippet "* Test ${1:test}\n:PROPERTIES:\n:ID: $1-after\n:END:") + (yas-mock-insert "foo bar") + (ert-simulate-command '(yas-next-field)) + (goto-char (point-min)) + (let ((expected (with-temp-buffer + (insert (format (concat "* Test foo bar\n" + " " org-property-format "\n" + " " org-property-format "\n" + " " org-property-format) + ":PROPERTIES:" "" + ":ID:" "foo bar-after" + ":END:" "")) + (delete-trailing-whitespace) + (buffer-string)))) + ;; Some org-mode versions leave trailing whitespace, some don't. + (delete-trailing-whitespace) + (should (equal expected (buffer-string)))))) + +(ert-deftest indent-cc-mode () + "Handling of cc-mode's indentation." + ;; This is an interesting case because cc-mode deletes all the + ;; indentation before recreating it. + (with-temp-buffer + (c++-mode) + (yas-minor-mode +1) + (yas-expand-snippet "\ +int foo() +{ + if ($1) { + delete $1; + $1 = 0; + } +}") + (yas-mock-insert "var") + (should (string= "\ +int foo() +{ + if (var) { + delete var; + var = 0; + } +}" (buffer-string))))) + +(ert-deftest indent-snippet-mode () + "Handling of snippet-mode indentation." + ;; This is an interesting case because newlines match [[:space:]] in + ;; snippet-mode. + (with-temp-buffer + (snippet-mode) + (yas-minor-mode +1) + (yas-expand-snippet "# -*- mode: snippet -*-\n# name: $1\n# key: $1\n# --\n") + (yas-mock-insert "foo") + (should (string= "# -*- mode: snippet -*-\n# name: foo\n# key: foo\n# --\n" + (buffer-string))))) + (ert-deftest indent-mirrors-on-update () "Check that mirrors are always kept indented." (with-temp-buffer @@ -351,6 +676,43 @@ mapconcat #'(lambda (arg) (yas-expand-snippet "Look ma! ${1:`(yas-selected-text)`} OK?") (should (string= (yas--buffer-contents) "Look ma! He)}o world! OK?"))))) +(ert-deftest insert-snippet-with-backslashes-in-active-field () + ;; This test case fails if `yas--inhibit-overlay-hooks' is not bound + ;; in `yas-expand-snippet' (see Github #844). + (with-temp-buffer + (yas-minor-mode 1) + (yas-expand-snippet "${1:$$(if (not yas-modified-p) \"a\")}") + (yas-expand-snippet "\\\\alpha"))) + +(ert-deftest expand-with-unused-yas-selected-text () + (with-temp-buffer + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("foo" . "expanded `yas-selected-text`foo")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (insert "foo") + (ert-simulate-command '(yas-expand)) + (should (equal (buffer-string) "expanded foo"))))) + +(ert-deftest yas-expand-command-snippet () + (with-temp-buffer + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("foo" . "\ +# type: command +# -- +\(insert \"expanded foo\")")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (insert "foo") + (ert-simulate-command '(yas-expand)) + (should (equal (buffer-string) "expanded foo"))))) + (ert-deftest example-for-issue-271 () (with-temp-buffer (yas-minor-mode 1) @@ -361,6 +723,17 @@ mapconcat #'(lambda (arg) (yas-mock-insert "bbb") (should (string= (yas--buffer-contents) "if condition\naaa\nelse\nbbb\nend"))))) +(ert-deftest yas-no-memory-of-bad-snippet () + "Expanding an incorrect snippet should not influence future expansions." + ;; See https://github.com/joaotavora/yasnippet/issues/800. + (with-temp-buffer + (yas-minor-mode 1) + (should-error (yas-expand-snippet "```foo\n\n```")) + (erase-buffer) ; Bad snippet may leave wrong text. + ;; But expanding the corrected snippet should work fine. + (yas-expand-snippet "\\`\\`\\`foo\n\n\\`\\`\\`") + (should (equal (buffer-string) "```foo\n\n```")))) + (defmacro yas--with-font-locked-temp-buffer (&rest body) "Like `with-temp-buffer', but ensure `font-lock-mode'." (declare (indent 0) (debug t)) @@ -382,14 +755,9 @@ mapconcat #'(lambda (arg) (kill-buffer ,temp-buffer)))))))) (defmacro yas-saving-variables (&rest body) + (declare (debug t)) `(yas-call-with-saving-variables #'(lambda () ,@body))) -(defmacro yas-with-snippet-dirs (dirs &rest body) - (declare (indent defun)) - `(yas-call-with-snippet-dirs ,dirs - #'(lambda () - ,@body))) - (ert-deftest example-for-issue-474 () (yas--with-font-locked-temp-buffer (c-mode) @@ -480,6 +848,88 @@ TODO: correct this bug!" "brother from another mother") ;; no newline should be here! ))) +(defvar yas-tests--ran-exit-hook nil) + +(ert-deftest snippet-exit-hooks () + (with-temp-buffer + (yas-saving-variables + (let ((yas-tests--ran-exit-hook nil) + (yas-triggers-in-field t)) + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("foo" . "\ +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook t)))) +# -- +FOO ${1:f1} ${2:f2}") + ("sub" . "\ +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'sub)))) +# -- +SUB")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (insert "foo") + (ert-simulate-command '(yas-expand)) + (should-not yas-tests--ran-exit-hook) + (yas-mock-insert "sub") + (ert-simulate-command '(yas-expand)) + (ert-simulate-command '(yas-next-field)) + (should-not yas-tests--ran-exit-hook) + (ert-simulate-command '(yas-next-field)) + (should (eq yas-tests--ran-exit-hook t))))))) + +(ert-deftest snippet-exit-hooks-bindings () + "Check that `yas-after-exit-snippet-hook' is handled correctly +in the case of a buffer-local variable and being overwritten by +the expand-env field." + (with-temp-buffer + (yas-saving-variables + (let ((yas-tests--ran-exit-hook nil) + (yas-triggers-in-field t) + (yas-after-exit-snippet-hook nil)) + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("foo" . "foobar\n") + ("baz" . "\ +# expand-env: ((yas-after-exit-snippet-hook (lambda () (setq yas-tests--ran-exit-hook 'letenv)))) +# -- +foobaz\n")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'global yas-tests--ran-exit-hook))) + (add-hook 'yas-after-exit-snippet-hook (lambda () (push 'local yas-tests--ran-exit-hook)) nil t) + (insert "baz") + (ert-simulate-command '(yas-expand)) + (should (eq 'letenv yas-tests--ran-exit-hook)) + (insert "foo") + (ert-simulate-command '(yas-expand)) + (should (eq 'global (nth 0 yas-tests--ran-exit-hook))) + (should (eq 'local (nth 1 yas-tests--ran-exit-hook)))))))) + +(ert-deftest snippet-mirror-bindings () + "Check that variables defined with the expand-env field are +accessible from mirror transformations." + (with-temp-buffer + (yas-saving-variables + (let ((yas-triggers-in-field t) + (yas-good-grace nil)) + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("baz" . "\ +# expand-env: ((func #'upcase)) +# -- +hello ${1:$(when (stringp yas-text) (funcall func yas-text))} foo${1:$$(concat \"baz\")}$0")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (insert "baz") + (ert-simulate-command '(yas-expand)) + (should (string= (yas--buffer-contents) "hello BAZ foobaz\n"))))))) + (defvar yas--barbaz) (defvar yas--foobarbaz) @@ -523,11 +973,69 @@ TODO: correct this bug!" (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK") ("foo " . "foo ")))))))) +(ert-deftest nested-snippet-expansion-1 () + (with-temp-buffer + (yas-minor-mode +1) + (let ((yas-triggers-in-field t)) + (yas-expand-snippet "Parent $1 Snippet") + (yas-expand-snippet "(Child $1 $2 Snippet)") + (let ((snippets (yas-active-snippets))) + (should (= (length snippets) 2)) + (should (= (length (yas--snippet-fields (nth 0 snippets))) 2)) + (should (= (length (yas--snippet-fields (nth 1 snippets))) 1)))))) + +(ert-deftest nested-snippet-expansion-2 () + (let ((yas-triggers-in-field t)) + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("text-mode" + ("nest" . "one($1:$1) two($2).$0")))) + (yas-reload-all) + (text-mode) + (yas-minor-mode +1) + (insert "nest") + (ert-simulate-command '(yas-expand)) + (yas-mock-insert "nest") + (ert-simulate-command '(yas-expand)) + (yas-mock-insert "x") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (yas-mock-insert "y") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (yas-mock-insert "z") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (should (string= (buffer-string) + "one(one(x:x) two(y).:one(x:x) two(y).) two(z)."))))) + +(ert-deftest nested-snippet-expansion-3 () + (let ((yas-triggers-in-field t)) + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("text-mode" + ("rt" . "\ +\\sqrt${1:$(if (string-equal \"\" yas/text) \"\" \"[\")}${1:}${1:$(if (string-equal \"\" yas/text) \"\" \"]\")}{$2}$0")))) + (yas-reload-all) + (text-mode) + (yas-minor-mode +1) + (insert "rt") + (ert-simulate-command '(yas-expand)) + (yas-mock-insert "3") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (yas-mock-insert "rt") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (yas-mock-insert "5") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (yas-mock-insert "2") + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (ert-simulate-command '(yas-next-field-or-maybe-expand)) + (should (string= (buffer-string) "\\sqrt[3]{\\sqrt[5]{2}}"))))) + ;;; Loading ;;; (defmacro yas-with-overriden-buffer-list (&rest body) + (declare (debug t)) (let ((saved-sym (make-symbol "yas--buffer-list"))) `(let ((,saved-sym (symbol-function 'buffer-list))) (cl-letf (((symbol-function 'buffer-list) @@ -540,6 +1048,7 @@ TODO: correct this bug!" (defmacro yas-with-some-interesting-snippet-dirs (&rest body) + (declare (debug t)) `(yas-saving-variables (yas-with-overriden-buffer-list (yas-with-snippet-dirs @@ -562,11 +1071,28 @@ TODO: correct this bug!" "Test `yas-lookup-snippet'." (yas-with-some-interesting-snippet-dirs (yas-reload-all 'no-jit) - (should (equal (yas-lookup-snippet "printf" 'c-mode) "printf($1);")) - (should (equal (yas-lookup-snippet "def" 'c-mode) "# define")) + (should (equal (yas--template-content (yas-lookup-snippet "printf" 'c-mode)) + "printf($1);")) + (should (equal (yas--template-content (yas-lookup-snippet "def" 'c-mode)) + "# define")) (should-not (yas-lookup-snippet "no such snippet" nil 'noerror)) (should-not (yas-lookup-snippet "printf" 'emacs-lisp-mode 'noerror)))) +(ert-deftest yas-lookup-snippet-with-env () + (with-temp-buffer + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("emacs-lisp-mode" + ("foo" . "\ +# expand-env: ((foo \"bar\")) +# -- +`foo`")))) + (yas-reload-all) + (emacs-lisp-mode) + (yas-minor-mode +1) + (yas-expand-snippet (yas-lookup-snippet "foo")) + (should (equal (buffer-string) "bar"))))) + (ert-deftest basic-jit-loading () "Test basic loading and expansion of snippets" (yas-with-some-interesting-snippet-dirs @@ -594,13 +1120,15 @@ TODO: correct this bug!" (with-temp-buffer (text-mode) (yas-minor-mode +1) - (should (equal (yas-lookup-snippet "one") "one")) - (should (eq (key-binding "\C-c1") 'yas-expand-from-keymap)) + (should (equal (yas--template-content (yas-lookup-snippet "one")) + "one")) + (should (eq (yas--key-binding "\C-c1") 'yas-expand-from-keymap)) (yas-define-snippets 'text-mode '(("_1" "one!" "won" nil nil nil nil nil "uuid-1"))) (should (null (yas-lookup-snippet "one" nil 'noerror))) - (should (null (key-binding "\C-c1"))) - (should (equal (yas-lookup-snippet "won") "one!"))))) + (should (null (yas--key-binding "\C-c1"))) + (should (equal (yas--template-content(yas-lookup-snippet "won")) + "one!"))))) (ert-deftest snippet-save () "Make sure snippets can be saved correctly." @@ -620,13 +1148,13 @@ TODO: correct this bug!" (yas-minor-mode +1) (save-current-buffer (yas-new-snippet t) - (with-current-buffer "*new snippet*" + (with-current-buffer yas-new-snippet-buffer-name (snippet-mode) (insert "# name: foo\n# key: bar\n# --\nsnippet foo") (call-interactively 'yas-load-snippet-buffer-and-close))) (save-current-buffer (yas-new-snippet t) - (with-current-buffer "*new snippet*" + (with-current-buffer yas-new-snippet-buffer-name (snippet-mode) (insert "# name: bar\n# key: bar\n# --\nsnippet bar") (call-interactively 'yas-load-snippet-buffer-and-close))) @@ -667,7 +1195,7 @@ TODO: correct this bug!" yet-another-c-mode and-also-this-one and-that-one - ;; prog-mode doesn't exist in emacs 24.3 + ;; prog-mode doesn't exist in emacs 23.4 ,@(if (fboundp 'prog-mode) '(prog-mode)) emacs-lisp-mode @@ -694,7 +1222,7 @@ TODO: correct this bug!" c-mode ,major-mode)) (expected-rest `(cc-mode - ;; prog-mode doesn't exist in emacs 24.3 + ;; prog-mode doesn't exist in emacs 23.4 ,@(if (fboundp 'prog-mode) '(prog-mode)) emacs-lisp-mode @@ -767,9 +1295,38 @@ TODO: correct this bug!" (yas-should-not-expand '("sc" "dolist" "ert-deftest")))) +;;; Unloading +(ert-deftest yas-unload () + "Test unloading and reloading." + (with-temp-buffer + (let ((status (call-process + (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "--batch" "-L" yas--loaddir "-l" "yasnippet" + "--eval" + (prin1-to-string + '(condition-case err + (progn + (yas-minor-mode +1) + (unload-feature 'yasnippet) + ;; Unloading leaves `yas-minor-mode' bound, + ;; harmless, though perhaps surprising. + (when (bound-and-true-p yas-minor-mode) + (error "`yas-minor-mode' still enabled")) + (when (fboundp 'yas-minor-mode) + (error "`yas-minor-mode' still fboundp")) + (require 'yasnippet) + (unless (fboundp 'yas-minor-mode) + (error "Failed to reload"))) + (error (message "%S" (error-message-string err)) + (kill-emacs 1))))))) + (ert-info ((buffer-string)) (should (eq status 0)))))) + + ;;; Menu ;;; (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body) + (declare (debug t)) `(yas-saving-variables (yas-with-snippet-dirs `((".emacs.d/snippets" @@ -805,16 +1362,16 @@ TODO: correct this bug!" (let ((yas-use-menu t)) (yas-with-even-more-interesting-snippet-dirs (yas-reload-all 'no-jit) - (let ((menu (cdr (gethash 'fancy-mode yas--menu-table)))) - (should (eql 4 (length menu))) + (let ((menu-items (yas--collect-menu-items + (gethash 'fancy-mode yas--menu-table)))) + (should (eql 4 (length menu-items))) (dolist (item '("a-guy" "a-beggar")) - (should (cl-find item menu :key #'cl-third :test #'string=))) - (should-not (cl-find "an-outcast" menu :key #'cl-third :test #'string=)) + (should (cl-find item menu-items :key #'cl-second :test #'string=))) + (should-not (cl-find "an-outcast" menu-items :key #'cl-second :test #'string=)) (dolist (submenu '("sirs" "ladies")) (should (keymapp - (cl-fourth - (cl-find submenu menu :key #'cl-third :test #'string=))))) - )))) + (cl-third + (cl-find submenu menu-items :key #'cl-second :test #'string=))))))))) (ert-deftest test-group-menus () "Test group-based menus using .yas-make-groups and the group directive" @@ -889,16 +1446,23 @@ TODO: be meaner" ;;; The infamous and problematic tab keybinding ;;; (ert-deftest test-yas-tab-binding () - (with-temp-buffer - (yas-minor-mode -1) - (should (not (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand))) - (yas-minor-mode 1) - (should (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand)) - (yas-expand-snippet "$1 $2 $3") - (should (eq (key-binding [(tab)]) 'yas-next-field-or-maybe-expand)) - (should (eq (key-binding (kbd "TAB")) 'yas-next-field-or-maybe-expand)) - (should (eq (key-binding [(shift tab)]) 'yas-prev-field)) - (should (eq (key-binding [backtab]) 'yas-prev-field)))) + (yas-saving-variables + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("fundamental-mode" + ("foo" . "foobar")))) + (yas-reload-all) + (with-temp-buffer + (yas-minor-mode -1) + (insert "foo") + (should (not (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand))) + (yas-minor-mode 1) + (should (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand)) + (yas-expand-snippet "$1 $2 $3") + (should (eq (key-binding [(tab)]) 'yas-next-field-or-maybe-expand)) + (should (eq (key-binding (kbd "TAB")) 'yas-next-field-or-maybe-expand)) + (should (eq (key-binding [(shift tab)]) 'yas-prev-field)) + (should (eq (key-binding [backtab]) 'yas-prev-field)))))) (ert-deftest test-rebindings () (let* ((yas-minor-mode-map (copy-keymap yas-minor-mode-map)) @@ -918,11 +1482,58 @@ TODO: be meaner" (should (eq (key-binding (kbd "SPC")) 'yas-expand))))) (ert-deftest test-yas-in-org () - (with-temp-buffer - (org-mode) - (yas-minor-mode 1) - (should (eq (key-binding [(tab)]) 'yas-expand)) - (should (eq (key-binding (kbd "TAB")) 'yas-expand)))) + (yas-saving-variables + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("org-mode" + ("foo" . "foobar")))) + (yas-reload-all) + (with-temp-buffer + (org-mode) + (yas-minor-mode 1) + (insert "foo") + (should (eq (key-binding [(tab)]) 'yas-expand)) + (should (eq (key-binding (kbd "TAB")) 'yas-expand)))))) + +(ert-deftest yas-org-native-tab-in-source-block () + "Test expansion of snippets in org source blocks." + :expected-result (if (and (fboundp 'org-in-src-block-p) (version< (org-version) "9")) + :passed :failed) + (yas-saving-variables + (yas-with-snippet-dirs + '((".emacs.d/snippets" + ("text-mode" + ("T" . "${1:one} $1\n${2:two} $2\n<<$0>> done!")))) + (let ((text-mode-hook '(yas-minor-mode)) + (org-src-tab-acts-natively t) + ;; Org 8.x requires this in order for + ;; `org-src-tab-acts-natively' to have effect. + (org-src-fontify-natively t)) + (yas-reload-all) + ;; Org relies on font-lock to identify source blocks. + (yas--with-font-locked-temp-buffer + (org-mode) + (yas-minor-mode 1) + (insert "#+BEGIN_SRC text\nT\n#+END_SRC") + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (jit-lock-fontify-now)) + (re-search-backward "^T$") (goto-char (match-end 0)) + (should (org-in-src-block-p)) + (ert-simulate-command `(,(key-binding (kbd "TAB")))) + (ert-simulate-command `(,(key-binding (kbd "TAB")))) + (ert-simulate-command `(,(key-binding (kbd "TAB")))) + ;; Check snippet exit location. + (should (looking-at ">> done!")) + (goto-char (point-min)) + (forward-line) + ;; Check snippet expansion, ignore leading whitespace due to + ;; `org-edit-src-content-indentation'. + (should (looking-at "\ +[[:space:]]*one one +[[:space:]]*two two +[[:space:]]*<<>> done!"))))))) + (ert-deftest test-yas-activate-extra-modes () "Given a symbol, `yas-activate-extra-mode' should be able to @@ -948,116 +1559,10 @@ add the snippets associated with the given mode." (yas-should-expand '(("car" . "(car )"))))))) -;;; Helpers -;;; -(defun yas-should-expand (keys-and-expansions) - (dolist (key-and-expansion keys-and-expansions) - (yas-exit-all-snippets) - (erase-buffer) - (insert (car key-and-expansion)) - (let ((yas-fallback-behavior nil)) - (ert-simulate-command '(yas-expand))) - (unless (string= (yas--buffer-contents) (cdr key-and-expansion)) - (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\"" - (car key-and-expansion) - (cdr key-and-expansion) - (yas--buffer-contents))))) - (yas-exit-all-snippets)) - -(defun yas-should-not-expand (keys) - (dolist (key keys) - (yas-exit-all-snippets) - (erase-buffer) - (insert key) - (let ((yas-fallback-behavior nil)) - (ert-simulate-command '(yas-expand))) - (unless (string= (yas--buffer-contents) key) - (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\"" - key - (yas--buffer-contents)))))) - -(defun yas-mock-insert (string) - (dotimes (i (length string)) - (let ((last-command-event (aref string i))) - (ert-simulate-command '(self-insert-command 1))))) - -(defun yas-mock-yank (string) - (let ((interprogram-paste-function (lambda () string))) - (ert-simulate-command '(yank nil)))) - -(defun yas-make-file-or-dirs (ass) - (let ((file-or-dir-name (car ass)) - (content (cdr ass))) - (cond ((listp content) - (make-directory file-or-dir-name 'parents) - (let ((default-directory (concat default-directory "/" file-or-dir-name))) - (mapc #'yas-make-file-or-dirs content))) - ((stringp content) - (with-temp-buffer - (insert content) - (write-region nil nil file-or-dir-name nil 'nomessage))) - (t - (message "[yas] oops don't know this content"))))) - - -(defun yas-variables () - (let ((syms)) - (mapatoms #'(lambda (sym) - (if (and (string-match "^yas-[^/]" (symbol-name sym)) - (boundp sym)) - (push sym syms)))) - syms)) - -(defun yas-call-with-saving-variables (fn) - (let* ((vars (yas-variables)) - (saved-values (mapcar #'symbol-value vars))) - (unwind-protect - (funcall fn) - (cl-loop for var in vars - for saved in saved-values - do (set var saved))))) - -(defun yas-call-with-snippet-dirs (dirs fn) - (let* ((default-directory (make-temp-file "yasnippet-fixture" t)) - (yas-snippet-dirs (mapcar (lambda (d) (expand-file-name (car d))) dirs))) - (with-temp-message "" - (unwind-protect - (progn - (mapc #'yas-make-file-or-dirs dirs) - (funcall fn)) - (when (>= emacs-major-version 24) - (delete-directory default-directory 'recursive)))))) - -;;; Older emacsen -;;; -(unless (fboundp 'special-mode) - ;; FIXME: Why provide this default definition here?!? - (defalias 'special-mode 'fundamental)) - -(unless (fboundp 'string-suffix-p) - ;; introduced in Emacs 24.4 - (defun string-suffix-p (suffix string &optional ignore-case) - "Return non-nil if SUFFIX is a suffix of STRING. -If IGNORE-CASE is non-nil, the comparison is done without paying -attention to case differences." - (let ((start-pos (- (length string) (length suffix)))) - (and (>= start-pos 0) - (eq t (compare-strings suffix nil nil - string start-pos nil ignore-case)))))) - -;;; btw to test this in emacs22 mac osx: -;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el -;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el -;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert - - -(put 'yas-saving-variables 'edebug-form-spec t) -(put 'yas-with-snippet-dirs 'edebug-form-spec t) -(put 'yas-with-overriden-buffer-list 'edebug-form-spec t) -(put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t) (provide 'yasnippet-tests) ;; Local Variables: ;; indent-tabs-mode: nil +;; autoload-compute-prefixes: nil ;; End: ;;; yasnippet-tests.el ends here |