ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 13:13:03 +00:00
Code Issues Packages Projects Releases Wiki Activity
yasnippet/snippet-tests.el
João Távora 7750c03f4b Arrange for same tests to run over dynamic fixtures 
* snippet-tests.el (snippet--insert-test-snippet): Removed.
(basic-expansion, basic-clear-field, basic-delete-char-in-field)
(contrived, contrived-2, nested-expansion, nested-skip-fields)
(mirror-of-nested-field, more-nesting, printf-expansion)
(printf-mirrors, printf-mirrors-and-navigation)
(printf-jump-to-second-field-right-away, sprintf-variation)
(constants-and-default-values): Converted to
`snippet--define-expansion-test'
(snippet--get-fixture): New function.
(snippet--define-expansion-test): New helper macro.

* snippet.el: Improve documentation slightly.
(define-static-snippet): Take `properties' instead of
`args'. Re-add debug spec.

* snippet.el (define-static-snippet): forms -> snippet-forms
2015-04-03 22:40:32 +01:00

349 lines
15 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; 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)
(defvar snippet--test-snippets-alist nil)
(setq snippet--test-snippets-alist
`((basic ((&field 1 "foo")
" bar "
(&mirror 1)))
(contrived ((&field 1)
(&field 2)
(&field 3)))
(nested ("a "
(&field 1 (&nested (&field 2 "nested")
" "
(&field 3 "field")))
" and its mirror: "
(&mirror 1)))
(mirror-of-nested-field ("a "
(&field 1 (&nested (&field 2 "nested")
" "
(&field 3 "field")))
(&mirror 3 (concat ", nested mirroring: "
field-string))))
(more-nesting ("a "
(&field 1 (&nested
"'"
(&field 2 "rain")
(&mirror 2 (apply #'string
(reverse
(string-to-list
field-string))))
"'"))
(&field 3 " and a field:")
" "
(&mirror 1)))
(printf ("printf (\""
(&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(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 ((&field 1 emacs-version)
" " (upcase (emacs-version)) " "
(&mirror 1)))
(wrap-selected-region ("foo"
selected-text
"baz"
(&field 1 selected-text)))
(navigate-fields ("foo"
&exit
(&field 2)
&field
(&field last)
(&field 1)))))
(defun snippet--get-fixture (name &optional dynamic-p)
(let* ((assoc (assoc name snippet--test-snippets-alist)))
(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 (overlay-buffer 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))
(snippet--insert-test-snippet 'wrap-selected-region)
(should (equal (buffer-string)
"foobarbazbar"))))
(ert-deftest navigate-fields-and-exit ()
(with-temp-buffer
(snippet--insert-test-snippet '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 (overlay-buffer 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)))))
;; pretty forms
(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)))))
(provide 'snippet-tests)
Reference in New Issue View Git Blame Copy Permalink