From 04591a4a86209c8a89a9abca0bece80a998019a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 4 Apr 2015 15:07:15 +0100 Subject: [PATCH] Make dynamic version of all tests and fix bugs * 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. --- snippet-tests.el | 151 +++++++++++++++++++++++++++++++++-------------- snippet.el | 33 +++++++---- 2 files changed, 129 insertions(+), 55 deletions(-) diff --git a/snippet-tests.el b/snippet-tests.el index e9e9f50..d174514 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -27,25 +27,37 @@ (require 'snippet) (require 'ert) (require 'ert-x) +(require 'cl-lib) -(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))) +(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 - ;; + ;; static version ("a " (&field 1 (&nested (&field 2 "nested") " " (&field 3 "field"))) " and its mirror: " (&mirror 1)) - ;; dynamic + ;; dynamic version ((insert "a ") (&field 1 (&field 2 (insert "nested")) @@ -54,29 +66,65 @@ (insert " and its mirror: ") (&mirror 1 (s e) (insert s)))) - (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) "\)" "")))) + (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 ;; @@ -106,22 +154,37 @@ (&mirror 1 (field-string _field-empty-p) (if (string-match "%" field-string) "\)" "")))) - (emacs-version ((&field 1 emacs-version) - " " (upcase (emacs-version)) " " - (&mirror 1))) + (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 ("foo" - &exit - (&field 2) - &field - (&field last) - (&field 1))))) + (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--test-snippets-alist))) + (let* ((assoc (assoc name snippet--fixtures))) (if dynamic-p (caddr assoc) (cadr assoc)))) diff --git a/snippet.el b/snippet.el index 1b6ec2c..ab6084a 100644 --- a/snippet.el +++ b/snippet.el @@ -314,7 +314,9 @@ pairs. Its meaning is not decided yet" (snippet--current-field) (snippet--prev-object) (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)) (field (setf (gethash ',field-name snippet--fields) @@ -324,14 +326,21 @@ pairs. Its meaning is not decided yet" (snippet--inserting-object field snippet--prev-object (setf snippet--prev-object field) - (let ((snippet--current-field field)) - (funcall fn))) + (let* ((snippet--current-field field) + (retval (funcall fn))) + (when (stringp retval) (insert retval)))) (push field snippet--all-objects))) - (&mirror (field-name mirror-args &body mirror-forms) - (cond ((> (length mirror-args) 2) + (&mirror (field-name &optional (mirror-args nil mirror-args-provided-p) &body mirror-forms) + (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")) - ((not (cadr mirror-args)) - (setcdr mirror-args '(_--snippet-ignored)))) + (t + (nconc mirror-args + (cl-loop for i from (length mirror-args) + below 2 + collect (make-symbol "_ignored"))))) `(let* ((fn (lambda ,mirror-args ,@mirror-forms)) (mirror (make-instance 'snippet--mirror :parent snippet--current-field @@ -369,7 +378,7 @@ pairs. Its meaning is not decided yet" `(defun ,name ,args ,docstring (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)) (put '&field 'lisp-indent-function 'defun) @@ -419,14 +428,16 @@ pairs. Its meaning is not decided yet" (snippet--object-end (snippet--object-parent prev))) ((and prev + (snippet--object-end prev) (= (point) (snippet--object-end prev))) (snippet--object-end prev)) (t (point-marker))))) (funcall fn) - ;; Only set the object's end if not set yet, i.e. when running its function - ;; some nested field might have set it already. - (unless (snippet--object-end object) + ;; Don't set the object's end if its already set and matches point. i.e. when + ;; running its function some nested field might have set it already and + (unless (and (snippet--object-end object) + (= (snippet--object-end object) (point))) (setf (snippet--object-end object) (point-marker))) (when (snippet--object-parent object)