ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 21:13:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

Make dynamic version of all tests and fix bugs

Browse Source 
* 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.
This commit is contained in:
João Távora 2015-04-04 15:07:15 +01:00
parent 94bd529d08
commit 04591a4a86
2 changed files with 129 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
snippet-tests.el
View File

@ -27,25 +27,37 @@
(require 'snippet) (require 'snippet)
(require 'ert) (require 'ert)
(require 'ert-x) (require 'ert-x)
(require 'cl-lib)
(defvar snippet--test-snippets-alist nil) (defvar snippet--fixtures nil
(setq snippet--test-snippets-alist "An alist of (NAME . (STATIC-FIXTURE DYNAMIC-FIXTURE))")
`((basic ((&field 1 "foo") (setq snippet--fixtures
`((basic
;; static version
((&field 1 "foo")
" bar " " bar "
(&mirror 1))
;; dynamic version
((&field 1 "foo")
(insert " bar ")
(&mirror 1))) (&mirror 1)))
(contrived ((&field 1) (contrived
;; static version
((&field 1)
(&field 2) (&field 2)
(&field 3))) (&field 3))
;; dynamic version
((cl-loop for i from 1 upto 3
do (&field i))))
(nested (nested
;; static ;; static version
;;
("a " ("a "
(&field 1 (&nested (&field 2 "nested") (&field 1 (&nested (&field 2 "nested")
" " " "
(&field 3 "field"))) (&field 3 "field")))
" and its mirror: " " and its mirror: "
(&mirror 1)) (&mirror 1))
;; dynamic ;; dynamic version
((insert "a ") ((insert "a ")
(&field 1 (&field 1
(&field 2 (insert "nested")) (&field 2 (insert "nested"))
@ -54,13 +66,25 @@
(insert " and its mirror: ") (insert " and its mirror: ")
(&mirror 1 (s e) (&mirror 1 (s e)
(insert s)))) (insert s))))
(mirror-of-nested-field ("a " (mirror-of-nested-field
;; static
("a "
(&field 1 (&nested (&field 2 "nested") (&field 1 (&nested (&field 2 "nested")
" " " "
(&field 3 "field"))) (&field 3 "field")))
(&mirror 3 (concat ", nested mirroring: " (&mirror 3 (concat ", nested mirroring: "
field-string)))) field-string)))
(more-nesting ("a " ;; 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 1 (&nested
"'" "'"
(&field 2 "rain") (&field 2 "rain")
@ -71,12 +95,36 @@
"'")) "'"))
(&field 3 " and a field:") (&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))) (&mirror 1)))
(printf ("printf (\"" (printf
;; static
("printf (\""
(&field 1 "%s") (&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")")) (&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2) (&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" "")))) (&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 (sprintf-maybe
;; static version ;; static version
;; ;;
@ -106,22 +154,37 @@
(&mirror 1 (&mirror 1
(field-string _field-empty-p) (field-string _field-empty-p)
(if (string-match "%" field-string) "\)" "")))) (if (string-match "%" field-string) "\)" ""))))
(emacs-version ((&field 1 emacs-version) (emacs-version
;; static version
((&field 1 emacs-version)
" " (upcase (emacs-version)) " " " " (upcase (emacs-version)) " "
(&mirror 1))
;; dynamic version
((&field 1 emacs-version)
(insert " " (upcase (emacs-version)) " ")
(&mirror 1))) (&mirror 1)))
(wrap-selected-region ("foo" (wrap-selected-region ("foo"
selected-text selected-text
"baz" "baz"
(&field 1 selected-text))) (&field 1 selected-text)))
(navigate-fields ("foo" (navigate-fields
;; static version
("foo"
&exit &exit
(&field 2) (&field 2)
&field &field
(&field last) (&field last)
(&field 1))
;; dynamic version
((insert "foo")
(&exit)
(&field 2)
(&field)
(&field last)
(&field 1))))) (&field 1)))))
(defun snippet--get-fixture (name &optional dynamic-p) (defun snippet--get-fixture (name &optional dynamic-p)
(let* ((assoc (assoc name snippet--test-snippets-alist))) (let* ((assoc (assoc name snippet--fixtures)))
(if dynamic-p (if dynamic-p
(caddr assoc) (caddr assoc)
(cadr assoc)))) (cadr assoc))))

33
snippet.el
View File

@ -314,7 +314,9 @@ pairs. Its meaning is not decided yet"
(snippet--current-field) (snippet--current-field)
(snippet--prev-object) (snippet--prev-object)
(snippet--all-objects)) (snippet--all-objects))
(cl-macrolet ((&field (field-name &body field-forms) (cl-macrolet ((&field (&optional (field-name nil field-name-provided-p) &body field-forms)
(unless field-name-provided-p
(setf field-name (make-symbol "_ignored")))
`(let ((fn (lambda () ,@field-forms)) `(let ((fn (lambda () ,@field-forms))
(field (field
(setf (gethash ',field-name snippet--fields) (setf (gethash ',field-name snippet--fields)
@ -324,14 +326,21 @@ pairs. Its meaning is not decided yet"
(snippet--inserting-object (snippet--inserting-object
field snippet--prev-object field snippet--prev-object
(setf snippet--prev-object field) (setf snippet--prev-object field)
(let ((snippet--current-field field)) (let* ((snippet--current-field field)
(funcall fn))) (retval (funcall fn)))
(when (stringp retval) (insert retval))))
(push field snippet--all-objects))) (push field snippet--all-objects)))
(&mirror (field-name mirror-args &body mirror-forms) (&mirror (field-name &optional (mirror-args nil mirror-args-provided-p) &body mirror-forms)
(cond ((> (length mirror-args) 2) (cond ((not mirror-args-provided-p)
(setq mirror-args `(,(intern "field-string") ,(make-symbol "_ignored")))
(setq mirror-forms `((insert ,(intern "field-string")))))
((> (length mirror-args) 2)
(error "At most two args in mirror transforms")) (error "At most two args in mirror transforms"))
((not (cadr mirror-args)) (t
(setcdr mirror-args '(_--snippet-ignored)))) (nconc mirror-args
(cl-loop for i from (length mirror-args)
below 2
collect (make-symbol "_ignored")))))
`(let* ((fn (lambda ,mirror-args ,@mirror-forms)) `(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(mirror (make-instance 'snippet--mirror (mirror (make-instance 'snippet--mirror
:parent snippet--current-field :parent snippet--current-field
@ -369,7 +378,7 @@ pairs. Its meaning is not decided yet"
`(defun ,name ,args ,docstring `(defun ,name ,args ,docstring
(with-dynamic-snippet ,@body))) (with-dynamic-snippet ,@body)))
(def-edebug-spec &mirror (sexp sexp &rest form)) (def-edebug-spec &mirror (sexp &optional sexp &rest form))
(def-edebug-spec &field (sexp &rest form)) (def-edebug-spec &field (sexp &rest form))
(put '&field 'lisp-indent-function 'defun) (put '&field 'lisp-indent-function 'defun)
@ -419,14 +428,16 @@ pairs. Its meaning is not decided yet"
(snippet--object-end (snippet--object-end
(snippet--object-parent prev))) (snippet--object-parent prev)))
((and prev ((and prev
(snippet--object-end prev)
(= (point) (snippet--object-end prev))) (= (point) (snippet--object-end prev)))
(snippet--object-end prev)) (snippet--object-end prev))
(t (t
(point-marker))))) (point-marker)))))
(funcall fn) (funcall fn)
;; Only set the object's end if not set yet, i.e. when running its function ;; Don't set the object's end if its already set and matches point. i.e. when
;; some nested field might have set it already. ;; running its function some nested field might have set it already and
(unless (snippet--object-end object) (unless (and (snippet--object-end object)
(= (snippet--object-end object) (point)))
(setf (snippet--object-end object) (setf (snippet--object-end object)
(point-marker))) (point-marker)))
(when (snippet--object-parent object) (when (snippet--object-parent object)