From 7750c03f4bac5f15b17598ef14c9842cb2f4bb0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 3 Apr 2015 22:40:32 +0100 Subject: [PATCH] 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 --- snippet-tests.el | 285 +++++++++++++++++++++++------------------------ snippet.el | 3 +- 2 files changed, 141 insertions(+), 147 deletions(-) diff --git a/snippet-tests.el b/snippet-tests.el index b8dfbd6..40ce0b6 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -108,167 +108,150 @@ (&field last) (&field 1))))) -(defun snippet--insert-test-snippet (name &optional dynamic-p) - (let* ((assoc (assoc name snippet--test-snippets-alist)) - (forms (if dynamic-p - (caddr assoc) - (cadr assoc)))) - (unless forms - (error "No %s definition for %s" (if dynamic-p "dynamic" "static") name)) - (cond (dynamic-p - (eval `(with-dynamic-snippet ,@forms))) - (t - (eval `(with-static-snippet ,@forms)))))) +(defun snippet--get-fixture (name &optional dynamic-p) + (let* ((assoc (assoc name snippet--test-snippets-alist))) + (if dynamic-p + (caddr assoc) + (cadr assoc)))) -(ert-deftest basic-expansion () - (with-temp-buffer - (snippet--insert-test-snippet 'basic) - (should (equal (buffer-string) "foo bar foo")) - (should (equal (buffer-substring (overlay-start snippet--field-overlay) - (overlay-end snippet--field-overlay)) - "foo" )))) +(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)))))) -(ert-deftest basic-clear-field () - (with-temp-buffer - (snippet--insert-test-snippet 'basic) - (ert-simulate-command '((lambda () (interactive) (insert "baz")))) - (should (equal (buffer-string) "baz bar baz")))) -(ert-deftest basic-delete-char-in-field () - (with-temp-buffer - (snippet--insert-test-snippet '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 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" ))) -(ert-deftest contrived () - (with-temp-buffer - (snippet--insert-test-snippet '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 basic-clear-field basic () + (ert-simulate-command '((lambda () (interactive) (insert "baz")))) + (should (equal (buffer-string) "baz bar baz"))) -(ert-deftest contrived-2 () - (with-temp-buffer - (snippet--insert-test-snippet '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 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"))) -(ert-deftest nested-expansion () - (with-temp-buffer - (snippet--insert-test-snippet '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 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"))) -(ert-deftest nested-skip-fields () - (with-temp-buffer - (snippet--insert-test-snippet '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 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"))) -(ert-deftest mirror-of-nested-field () - (with-temp-buffer - (snippet--insert-test-snippet '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 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"))) -(ert-deftest more-nesting () - (with-temp-buffer - (snippet--insert-test-snippet '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 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)))) -(ert-deftest printf-expansion () - (with-temp-buffer - (snippet--insert-test-snippet 'printf) - (should (equal (buffer-string) "printf (\"%s\",)")))) +(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"))) -(ert-deftest printf-mirrors () - (with-temp-buffer - (snippet--insert-test-snippet '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 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"))) -(ert-deftest printf-mirrors-and-navigation () - (with-temp-buffer - (snippet--insert-test-snippet '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-expansion printf () + (should (equal (buffer-string) "printf (\"%s\",)"))) -(ert-deftest printf-jump-to-second-field-right-away () - (with-temp-buffer - (snippet--insert-test-snippet '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 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\",)"))) -(ert-deftest sprintf-variation () - (with-temp-buffer - (snippet--insert-test-snippet 'sprintf-maybe 'dynamic) - (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 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)"))) -(ert-deftest constants-and-default-values () - (with-temp-buffer - (snippet--insert-test-snippet '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"))))) +(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 @@ -351,5 +334,15 @@ (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) diff --git a/snippet.el b/snippet.el index 54d4519..49a188d 100644 --- a/snippet.el +++ b/snippet.el @@ -237,7 +237,8 @@ As `define-static-snippet' but doesn't define a function." ("&field" sexp &or ("&nested" &rest snippet-form) def-form) def-form)) -(defmacro define-static-snippet (name _properties &optional docstring &rest forms) +(defmacro define-static-snippet (name _properties &optional docstring + &rest snippet-forms) "Make a snippet-inserting function from FORMS. Each form in SNIPPET-FORMS, inserted at point in order, can be: