mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-13 21:13:04 +00:00
04591a4a86
* snippet-tests.el (cl-lib): require it (snippet--fixtures): Renamed from `snippet--test-snippets-alist'. Add dynamic versions to all tests. (snippet--get-fixture): Use `snippet--fixtures' * snippet.el (with-dynamic-snippet): Relax syntax restrictions. (&mirror): Update edebug spec. (snippet--call-with-inserting-object): Don't try to set the start of an object to its previous object's end, if that object hasn't got an end yet. (snippet--call-with-inserting-object): Fix previous bugfix.
431 lines
16 KiB
EmacsLisp
431 lines
16 KiB
EmacsLisp
;;; snippet-tests.el --- some basic tests for snippet.el -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2013
|
||
|
||
;; Author: ;;; some basic test snippets <joaot@BELMONTE>
|
||
;; Keywords:
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;;
|
||
|
||
;;; Code:
|
||
|
||
(require 'snippet)
|
||
(require 'ert)
|
||
(require 'ert-x)
|
||
(require 'cl-lib)
|
||
|
||
(defvar snippet--fixtures nil
|
||
"An alist of (NAME . (STATIC-FIXTURE DYNAMIC-FIXTURE))")
|
||
(setq snippet--fixtures
|
||
`((basic
|
||
;; static version
|
||
((&field 1 "foo")
|
||
" bar "
|
||
(&mirror 1))
|
||
;; dynamic version
|
||
((&field 1 "foo")
|
||
(insert " bar ")
|
||
(&mirror 1)))
|
||
(contrived
|
||
;; static version
|
||
((&field 1)
|
||
(&field 2)
|
||
(&field 3))
|
||
;; dynamic version
|
||
((cl-loop for i from 1 upto 3
|
||
do (&field i))))
|
||
(nested
|
||
;; static version
|
||
("a "
|
||
(&field 1 (&nested (&field 2 "nested")
|
||
" "
|
||
(&field 3 "field")))
|
||
" and its mirror: "
|
||
(&mirror 1))
|
||
;; dynamic version
|
||
((insert "a ")
|
||
(&field 1
|
||
(&field 2 (insert "nested"))
|
||
(insert " ")
|
||
(&field 3 (insert "field")))
|
||
(insert " and its mirror: ")
|
||
(&mirror 1 (s e)
|
||
(insert s))))
|
||
(mirror-of-nested-field
|
||
;; static
|
||
("a "
|
||
(&field 1 (&nested (&field 2 "nested")
|
||
" "
|
||
(&field 3 "field")))
|
||
(&mirror 3 (concat ", nested mirroring: "
|
||
field-string)))
|
||
;; dynamic
|
||
((insert "a ")
|
||
(&field 1
|
||
(&field 2 (insert "nested"))
|
||
(insert " ")
|
||
(&field 3 (insert "field")))
|
||
(&mirror 3 (s)
|
||
(insert ", nested mirroring: " s))))
|
||
(more-nesting ; FIXME: horribly contrived, what is "rain"?
|
||
;; static
|
||
("a "
|
||
(&field 1 (&nested
|
||
"'"
|
||
(&field 2 "rain")
|
||
(&mirror 2 (apply #'string
|
||
(reverse
|
||
(string-to-list
|
||
field-string))))
|
||
"'"))
|
||
(&field 3 " and a field:")
|
||
" "
|
||
(&mirror 1))
|
||
;; dynamic
|
||
((insert "a ")
|
||
(&field 1
|
||
(insert "'")
|
||
(&field 2 "rain")
|
||
(&mirror 2 (s)
|
||
(apply #'string
|
||
(reverse
|
||
(string-to-list
|
||
s))))
|
||
(insert "'"))
|
||
(&field 3 " and a field:")
|
||
(insert " ")
|
||
(&mirror 1)))
|
||
(printf
|
||
;; static
|
||
("printf (\""
|
||
(&field 1 "%s")
|
||
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
|
||
(&field 2)
|
||
(&mirror 1 (if (string-match "%" field-string) "\)" "")))
|
||
;; dynamic
|
||
((insert "printf (\"")
|
||
(&field 1 "%s")
|
||
(&mirror 1 (f)
|
||
(if (string-match "%" f) "\"," "\")"))
|
||
(&field 2)
|
||
(&mirror 1 (f)
|
||
(if (string-match "%" f) "\)" ""))))
|
||
(sprintf-maybe
|
||
;; static version
|
||
;;
|
||
((&mirror 0 (unless field-empty-p "s"))
|
||
"printf ("
|
||
(&field 0)
|
||
(&mirror 0 (unless field-empty-p ","))
|
||
"\""
|
||
(&field 1 "%s")
|
||
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
|
||
(&field 2)
|
||
(&mirror 1 (if (string-match "%" field-string) "\)" "")))
|
||
;; dynamic version
|
||
;;
|
||
((&mirror 0 (_field-string field-empty-p)
|
||
(unless field-empty-p "s"))
|
||
(insert "printf (")
|
||
(&field 0)
|
||
(&mirror 0 (_field-string field-empty-p)
|
||
(unless field-empty-p ","))
|
||
(insert "\"")
|
||
(&field 1 (insert "%s"))
|
||
(&mirror 1
|
||
(field-string _field-empty-p)
|
||
(if (string-match "%" field-string) "\"," "\")"))
|
||
(&field 2)
|
||
(&mirror 1
|
||
(field-string _field-empty-p)
|
||
(if (string-match "%" field-string) "\)" ""))))
|
||
(emacs-version
|
||
;; static version
|
||
((&field 1 emacs-version)
|
||
" " (upcase (emacs-version)) " "
|
||
(&mirror 1))
|
||
;; dynamic version
|
||
((&field 1 emacs-version)
|
||
(insert " " (upcase (emacs-version)) " ")
|
||
(&mirror 1)))
|
||
(wrap-selected-region ("foo"
|
||
selected-text
|
||
"baz"
|
||
(&field 1 selected-text)))
|
||
(navigate-fields
|
||
;; static version
|
||
("foo"
|
||
&exit
|
||
(&field 2)
|
||
&field
|
||
(&field last)
|
||
(&field 1))
|
||
;; dynamic version
|
||
((insert "foo")
|
||
(&exit)
|
||
(&field 2)
|
||
(&field)
|
||
(&field last)
|
||
(&field 1)))))
|
||
|
||
(defun snippet--get-fixture (name &optional dynamic-p)
|
||
(let* ((assoc (assoc name snippet--fixtures)))
|
||
(if dynamic-p
|
||
(caddr assoc)
|
||
(cadr assoc))))
|
||
|
||
(defmacro snippet--define-expansion-test (name fixture-name _args &rest body)
|
||
(declare (indent 3))
|
||
`(progn
|
||
(ert-deftest ,(intern (concat (symbol-name name) "-static")) ()
|
||
(let ((fixture (snippet--get-fixture ',fixture-name nil)))
|
||
(if (not fixture)
|
||
(ert-skip "No fixture for static test")
|
||
(with-temp-buffer
|
||
(eval `(with-static-snippet ,@fixture))
|
||
,@body))))
|
||
(ert-deftest ,(intern (concat (symbol-name name) "-dynamic")) ()
|
||
(let ((fixture (snippet--get-fixture ',fixture-name 'dynamic)))
|
||
(if (not fixture)
|
||
(ert-skip "No fixture for dynamic test")
|
||
(with-temp-buffer
|
||
(eval `(with-dynamic-snippet ,@fixture))
|
||
,@body))))))
|
||
|
||
|
||
(snippet--define-expansion-test basic-expansion basic ()
|
||
(should (equal (buffer-string) "foo bar foo"))
|
||
(should (equal (buffer-substring (overlay-start snippet--field-overlay)
|
||
(overlay-end snippet--field-overlay))
|
||
"foo" )))
|
||
|
||
(snippet--define-expansion-test basic-clear-field basic ()
|
||
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
|
||
(should (equal (buffer-string) "baz bar baz")))
|
||
|
||
(snippet--define-expansion-test basic-delete-char-in-field basic ()
|
||
(ert-simulate-command '(delete-forward-char 1))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "b"))))
|
||
(should (equal (buffer-string) "boo bar boo")))
|
||
|
||
(snippet--define-expansion-test contrived contrived ()
|
||
(should (equal (buffer-string) ""))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "foo"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
|
||
(should (equal (buffer-string) "foobarbaz")))
|
||
|
||
(snippet--define-expansion-test contrived-2 contrived ()
|
||
(should (equal (buffer-string) ""))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
|
||
(ert-simulate-command '(snippet-prev-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
|
||
(ert-simulate-command '(snippet-prev-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "foo"))))
|
||
(should (equal (buffer-string) "foobarbaz")))
|
||
|
||
(snippet--define-expansion-test nested-expansion nested ()
|
||
(should (equal (buffer-string) "a nested field and its mirror: nested field"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "nicely"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "nested field"))))
|
||
(should (equal (buffer-substring (overlay-start snippet--field-overlay)
|
||
(overlay-end snippet--field-overlay))
|
||
"nested field" ))
|
||
(should (equal (buffer-string) "a nicely nested field and its mirror: nicely nested field")))
|
||
|
||
(snippet--define-expansion-test nested-skip-fields nested ()
|
||
(ert-simulate-command '((lambda () (interactive) (insert "foo"))))
|
||
(should (equal (buffer-string) "a foo and its mirror: foo"))
|
||
;; this should exit the snippet now, since the two remaining
|
||
;; fields should be skipped
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(should (null snippet--field-overlay)))
|
||
|
||
(snippet--define-expansion-test mirror-of-nested-field mirror-of-nested-field()
|
||
(should (equal (buffer-string) "a nested field, nested mirroring: field"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "foo"))))
|
||
(should (equal (buffer-string) "a nested foo, nested mirroring: foo")))
|
||
|
||
(snippet--define-expansion-test more-nesting more-nesting()
|
||
(should (equal (buffer-string) "a 'rainniar' and a field: 'rainniar'"))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
|
||
(should (equal (buffer-string) "a bar and a field: bar"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
|
||
(should (equal (buffer-string) "a barbaz bar"))
|
||
(ert-simulate-command '(snippet-prev-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "foo"))))
|
||
(should (equal (buffer-string) "a foobarbaz foobar")))
|
||
|
||
(snippet--define-expansion-test printf-expansion printf ()
|
||
(should (equal (buffer-string) "printf (\"%s\",)")))
|
||
|
||
(snippet--define-expansion-test printf-mirrors printf ()
|
||
(ert-simulate-command '(delete-forward-char 1))
|
||
(should (equal (buffer-string) "printf (\"s\")"))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "%"))))
|
||
(should (equal (buffer-string) "printf (\"%s\",)")))
|
||
|
||
(snippet--define-expansion-test printf-mirrors-and-navigation printf ()
|
||
(ert-simulate-command '(delete-forward-char 1))
|
||
(should (equal (buffer-string) "printf (\"s\")"))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "%"))))
|
||
(should (equal (buffer-string) "printf (\"%s\",)"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "somevar"))))
|
||
(should (equal (buffer-string) "printf (\"%s\",somevar)")))
|
||
|
||
(snippet--define-expansion-test printf-jump-to-second-field-right-away printf ()
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "somevar"))))
|
||
(should (equal (buffer-string) "printf (\"%s\",somevar)")))
|
||
|
||
(snippet--define-expansion-test sprintf-variation sprintf-maybe()
|
||
(should (equal (buffer-string) "printf (\"%s\",)"))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
|
||
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(should (looking-back "sprintf (somestring,\"%s\","))
|
||
(ert-simulate-command '(snippet-prev-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bla"))))
|
||
(should (equal (buffer-string) "sprintf (somestring,\"bla\")"))
|
||
(should (looking-back "sprintf (somestring,\"bla"))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(should (looking-back "sprintf (somestring,\"bla\")")))
|
||
|
||
(snippet--define-expansion-test constants-and-default-values emacs-version()
|
||
(should (equal (buffer-string)
|
||
(concat emacs-version " "
|
||
(upcase (emacs-version)) " "
|
||
emacs-version)))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
|
||
(should (equal (buffer-string)
|
||
(concat "somestring" " "
|
||
(upcase (emacs-version)) " "
|
||
"somestring"))))
|
||
|
||
(ert-deftest wrap-selected-region ()
|
||
;; this test needs some work. testing with `region-active-p' is hard
|
||
;; and also the "delete-selection" behaviour isn't decided yet
|
||
;;
|
||
:expected-result :failed
|
||
(with-temp-buffer
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
|
||
(set-mark (point))
|
||
(goto-char (point-max))
|
||
(eval `(with-static-snippet ,@(snippet--get-fixture 'wrap-selected-region)))
|
||
(should (equal (buffer-string)
|
||
"foobarbazbar"))))
|
||
|
||
(snippet--define-expansion-test navigate-fields-and-exit navigate-fields()
|
||
(should (equal (buffer-string) "foo"))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "quam"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(ert-simulate-command '((lambda () (interactive) (insert "quux"))))
|
||
(ert-simulate-command '(snippet-next-field))
|
||
(should (equal (buffer-string) "foobarbazquuxquam"))
|
||
(should (null snippet--field-overlay))
|
||
(should (looking-at "barbazquuxquam")))
|
||
|
||
|
||
;;; input validation
|
||
;;;
|
||
(ert-deftest valid-forms ()
|
||
;; fields
|
||
;;
|
||
(should (equal (snippet--canonicalize-form '(&field 1 (foo)))
|
||
'(&field 1 (&eval (foo)))))
|
||
(should (equal (snippet--canonicalize-form '(&field 1 (&eval (foo))))
|
||
'(&field 1 (&eval (foo)))))
|
||
(should (equal (snippet--canonicalize-form '(&field 1 (&transform (foo))))
|
||
'(&field 1 (&transform (foo)))))
|
||
(should (equal (snippet--canonicalize-form '(&field 1 (&nested (foo) (bar))))
|
||
'(&field 1 (&nested (&eval (foo)) (&eval (bar))))))
|
||
(should (equal (snippet--canonicalize-form '(&field 1))
|
||
'(&field 1 nil)))
|
||
;; mirrors
|
||
;;
|
||
(should (equal (snippet--canonicalize-form '(&mirror 1))
|
||
'(&mirror 1 (&transform field-string))))
|
||
(should (equal (snippet--canonicalize-form '(&mirror 1 (foo)))
|
||
'(&mirror 1 (&transform (foo)))))
|
||
(should (equal (snippet--canonicalize-form '(&mirror 1 (&transform (foo))))
|
||
'(&mirror 1 (&transform (foo)))))
|
||
|
||
;; exit
|
||
;;
|
||
(should (equal (snippet--canonicalize-form '&exit)
|
||
'(&exit (&eval nil))))
|
||
(should (equal (snippet--canonicalize-form `(&exit))
|
||
'(&exit (&eval nil))))
|
||
(should (equal (snippet--canonicalize-form `(&exit (foo)))
|
||
'(&exit (&eval (foo)))))
|
||
;; constants
|
||
;;
|
||
(should (equal (snippet--canonicalize-form "bla")
|
||
'(&eval "bla")))
|
||
(should (equal (snippet--canonicalize-form '(&eval "bla"))
|
||
'(&eval "bla")))
|
||
(should (equal (snippet--canonicalize-form '(foo))
|
||
'(&eval (foo))))
|
||
(should (equal (snippet--canonicalize-form '(&eval (foo)))
|
||
'(&eval (foo)))))
|
||
|
||
(ert-deftest invalid-forms ()
|
||
;; fields
|
||
(should-error (snippet--canonicalize-form '(&field 1 (&transform (foo) (bar)))))
|
||
(should-error (snippet--canonicalize-form '(&field 1 (&eval (foo) (bar)))))
|
||
(should-error (snippet--canonicalize-form '(&mirror 1 (foo) (bar))))
|
||
(should-error (snippet--canonicalize-form '(&field 1 (foo) (bar))))
|
||
(should-error (snippet--canonicalize-form '(&eval (foo) (bar)))))
|
||
|
||
|
||
;; misc
|
||
;;
|
||
(cl-loop for sym in (list 'snippet--define-expansion-test)
|
||
for regexp = (format "(\\(%S\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
|
||
sym)
|
||
do (font-lock-add-keywords
|
||
'emacs-lisp-mode
|
||
`((,regexp (1 font-lock-keyword-face)
|
||
(2 font-lock-variable-name-face)))))
|
||
|
||
(defun snippet--test-fixture (fixture &optional dynamic)
|
||
(with-current-buffer (get-buffer-create "*snippet-test*")
|
||
(erase-buffer)
|
||
(switch-to-buffer (current-buffer))
|
||
(if dynamic
|
||
(eval `(with-dynamic-snippet ,@(snippet--get-fixture fixture 'dynamic-p)))
|
||
(eval `(with-static-snippet ,@(snippet--get-fixture fixture nil))))))
|
||
|
||
(provide 'snippet-tests)
|
||
|