code.delx.au - gnu-emacs-elpa/blob - yasnippet-tests.el

   1 ;;; yasnippet-tests.el --- some yasnippet tests
   2
   3 ;; Copyright (C) 2012  João Távora
   4
   5 ;; Author: João Távora <joaot@siscog.pt>
   6 ;; Keywords: emulations, convenience
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; Test basic snippet mechanics and the loading system
  24
  25 ;;; Code:
  26
  27 (require 'yasnippet)
  28 (require 'ert)
  29 (require 'ert-x)
  30
  31 \f
  32 ;;; Snippet mechanics
  33
  34 (ert-deftest field-navigation ()
  35   (with-temp-buffer
  36     (yas-minor-mode 1)
  37     (yas-expand-snippet "${1:brother} from another ${2:mother}")
  38     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  39                      "brother from another mother"))
  40
  41     (should (looking-at "brother"))
  42     (ert-simulate-command '(yas-next-field-or-maybe-expand))
  43     (should (looking-at "mother"))
  44     (ert-simulate-command '(yas-prev-field))
  45     (should (looking-at "brother"))))
  46
  47 (ert-deftest simple-mirror ()
  48   (with-temp-buffer
  49     (yas-minor-mode 1)
  50     (yas-expand-snippet "${1:brother} from another $1")
  51     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  52                      "brother from another brother"))
  53     (ert-simulate-command `(yas-mock-insert "bla"))
  54     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  55                      "bla from another bla"))))
  56
  57 (ert-deftest mirror-with-transformation ()
  58   (with-temp-buffer
  59     (yas-minor-mode 1)
  60     (yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
  61     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  62                      "brother from another BROTHER"))
  63     (ert-simulate-command `(yas-mock-insert "bla"))
  64     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  65                      "bla from another BLA"))))
  66
  67 (ert-deftest nested-placeholders-kill-superfield ()
  68   (with-temp-buffer
  69     (yas-minor-mode 1)
  70     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
  71     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  72                      "brother from another mother!"))
  73     (ert-simulate-command `(yas-mock-insert "bla"))
  74     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  75                      "brother from bla!"))))
  76
  77 (ert-deftest nested-placeholders-use-subfield ()
  78   (with-temp-buffer
  79     (yas-minor-mode 1)
  80     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
  81     (ert-simulate-command '(yas-next-field-or-maybe-expand))
  82     (ert-simulate-command `(yas-mock-insert "bla"))
  83     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  84                      "brother from another bla!"))))
  85
  86 ;; (ert-deftest in-snippet-undo ()
  87 ;;   (with-temp-buffer
  88 ;;     (yas-minor-mode 1)
  89 ;;     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
  90 ;;     (ert-simulate-command '(yas-next-field-or-maybe-expand))
  91 ;;     (ert-simulate-command `(yas-mock-insert "bla"))
  92 ;;     (ert-simulate-command '(undo))
  93 ;;     (should (string= (buffer-substring-no-properties (point-min) (point-max))
  94 ;;                      "brother from another mother!"))))
  95
  96 \f
  97 ;;; Misc tests
  98 ;;;
  99
 100 (ert-deftest protection-overlay-no-cheating ()
 101   "Protection overlays at the very end of the buffer, are dealt by cheatingly inserting a newline!
 102
 103 TODO: correct this bug!"
 104   :expected-result :failed
 105   (with-temp-buffer
 106     (yas-minor-mode 1)
 107     (yas-expand-snippet "${2:brother} from another ${1:mother}")
 108     (should (string= (buffer-substring-no-properties (point-min) (point-max))
 109                      "brother from another mother") ;; no newline should be here!
 110             )))
 111 \f
 112 ;;; Loading
 113 ;;;
 114 (defmacro yas-with-some-interesting-snippet-dirs (&rest body)
 115   `(yas-saving-variables
 116     (yas-with-snippet-dirs
 117      '((".emacs.d/snippets"
 118         ("c-mode"
 119          (".yas-parents" . "cc-mode")
 120          ("printf" . "printf($1);"))
 121         ("emacs-lisp-mode" ("ert-deftest" . "(ert-deftest ${1:name} () $0)"))
 122         ("lisp-interaction-mode" (".yas-parents" . "emacs-lisp-mode")))
 123        ("library/snippets"
 124         ("c-mode" (".yas-parents" . "c++-mode"))
 125         ("cc-mode" ("def" . "# define"))
 126         ("emacs-lisp-mode" ("dolist" . "(dolist)"))
 127         ("lisp-interaction-mode" ("sc" . "brother from another mother"))))
 128      ,@body)))
 129
 130 (ert-deftest basic-jit-loading ()
 131   "Test basic loading and expansion of snippets"
 132   (yas-with-some-interesting-snippet-dirs
 133    (yas-reload-all)
 134    (yas--basic-jit-loading-1)))
 135
 136 (ert-deftest basic-jit-loading-with-compiled-snippets ()
 137   "Test basic loading and expansion of snippets"
 138   (yas-with-some-interesting-snippet-dirs
 139    (yas-reload-all)
 140    (yas-recompile-all)
 141    (flet ((yas--load-directory-2
 142            (&rest dummies)
 143            (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled")))
 144      (yas-reload-all)
 145      (yas--basic-jit-loading-1))))
 146
 147 (defun yas--basic-jit-loading-1 (&optional compile)
 148   (with-temp-buffer
 149     (should (= 4 (hash-table-count yas--scheduled-jit-loads)))
 150     (should (= 0 (hash-table-count yas--tables)))
 151     (lisp-interaction-mode)
 152     (yas-minor-mode 1)
 153     (should (= 2 (hash-table-count yas--scheduled-jit-loads)))
 154     (should (= 2 (hash-table-count yas--tables)))
 155     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'lisp-interaction-mode yas--tables)))))
 156     (should (= 2 (hash-table-count (yas--table-uuidhash (gethash 'emacs-lisp-mode yas--tables)))))
 157     (yas-should-expand '(("sc" . "brother from another mother")
 158                          ("dolist" . "(dolist)")
 159                          ("ert-deftest" . "(ert-deftest name () )")))
 160     (c-mode)
 161     (yas-minor-mode 1)
 162     (should (= 0 (hash-table-count yas--scheduled-jit-loads)))
 163     (should (= 4 (hash-table-count yas--tables)))
 164     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'c-mode yas--tables)))))
 165     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'cc-mode yas--tables)))))
 166     (yas-should-expand '(("printf" . "printf();")
 167                          ("def" . "# define")))
 168     (yas-should-not-expand '("sc" "dolist" "ert-deftest"))))
 169
 170 \f
 171 ;;; Menu
 172 ;;;
 173 (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
 174   `(yas-saving-variables
 175     (yas-with-snippet-dirs
 176      `((".emacs.d/snippets"
 177         ("c-mode"
 178          (".yas-make-groups" . "")
 179          ("printf" . "printf($1);")
 180          ("foo-group-a"
 181           ("fnprintf" . "fprintf($1);")
 182           ("snprintf" . "snprintf($1);"))
 183          ("foo-group-b"
 184           ("strcmp" . "strecmp($1);")
 185           ("strcasecmp" . "strcasecmp($1);")))
 186         ("lisp-interaction-mode"
 187          ("ert-deftest" . "# group: barbar\n# --\n(ert-deftest ${1:name} () $0)"))
 188         ("fancy-mode"
 189          ("a-guy" . "# uuid: 999\n# --\nyo!")
 190          ("a-sir" . "# uuid: 12345\n# --\nindeed!")
 191          ("a-lady" . "# uuid: 54321\n# --\noh-la-la!")
 192          ("a-beggar" . "# uuid: 0101\n# --\narrrgh!")
 193          ("an-outcast" . "# uuid: 666\n# --\narrrgh!")
 194          (".yas-setup.el" . , (pp-to-string
 195                                '(yas-define-menu 'fancy-mode
 196                                                  '((yas-ignore-item "0101")
 197                                                    (yas-item "999")
 198                                                    (yas-submenu "sirs"
 199                                                                 ((yas-item "12345")))
 200                                                    (yas-submenu "ladies"
 201                                                                 ((yas-item "54321"))))
 202                                                  '("666")))))))
 203      ,@body)))
 204
 205 (ert-deftest test-yas-define-menu ()
 206   (let ((yas-use-menu t))
 207     (yas-with-even-more-interesting-snippet-dirs
 208      (yas-reload-all 'no-jit)
 209      (let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
 210        (should (eql 4 (length menu)))
 211        (dolist (item '("a-guy" "a-beggar"))
 212          (should (find item menu :key #'third :test #'string=)))
 213        (should-not (find "an-outcast" menu :key #'third :test #'string=))
 214        (dolist (submenu '("sirs" "ladies"))
 215          (should (keymapp
 216                   (fourth
 217                    (find submenu menu :key #'third :test #'string=)))))
 218        ))))
 219
 220 (ert-deftest test-group-menus ()
 221   "Test group-based menus using .yas-make-groups and the group directive"
 222   (let ((yas-use-menu t))
 223     (yas-with-even-more-interesting-snippet-dirs
 224      (yas-reload-all 'no-jit)
 225      ;; first the subdir-based groups
 226      ;;
 227      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 228        (should (eql 3 (length menu)))
 229        (dolist (item '("printf" "foo-group-a" "foo-group-b"))
 230          (should (find item menu :key #'third :test #'string=)))
 231        (dolist (submenu '("foo-group-a" "foo-group-b"))
 232          (should (keymapp
 233                   (fourth
 234                    (find submenu menu :key #'third :test #'string=))))))
 235      ;; now group directives
 236      ;;
 237      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 238        (should (eql 1 (length menu)))
 239        (should (find "barbar" menu :key #'third :test #'string=))
 240        (should (keymapp
 241                 (fourth
 242                  (find "barbar" menu :key #'third :test #'string=))))))))
 243
 244 (ert-deftest test-group-menus-twisted ()
 245   "Same as similarly named test, but be mean.
 246
 247 TODO: be meaner"
 248   (let ((yas-use-menu t))
 249     (yas-with-even-more-interesting-snippet-dirs
 250      ;; add a group directive conflicting with the subdir and watch
 251      ;; behaviour
 252      (with-temp-buffer
 253        (insert "# group: foo-group-c\n# --\nstrecmp($1)")
 254        (write-region nil nil (concat (first (yas-snippet-dirs))
 255                                      "/c-mode/foo-group-b/strcmp")))
 256      (yas-reload-all 'no-jit)
 257      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 258        (should (eql 4 (length menu)))
 259        (dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
 260          (should (find item menu :key #'third :test #'string=)))
 261        (dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
 262          (should (keymapp
 263                   (fourth
 264                    (find submenu menu :key #'third :test #'string=))))))
 265      ;; delete the .yas-make-groups file and watch behaviour
 266      ;;
 267      (delete-file (concat (first (yas-snippet-dirs))
 268                           "/c-mode/.yas-make-groups"))
 269      (yas-reload-all 'no-jit)
 270      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 271        (should (eql 5 (length menu))))
 272      ;; Change a group directive and reload
 273      ;;
 274      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 275        (should (find "barbar" menu :key #'third :test #'string=)))
 276
 277      (with-temp-buffer
 278        (insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
 279        (write-region nil nil (concat (first (yas-snippet-dirs))
 280                                      "/lisp-interaction-mode/ert-deftest")))
 281      (yas-reload-all 'no-jit)
 282      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 283        (should (eql 1 (length menu)))
 284        (should (find "foofoo" menu :key #'third :test #'string=))
 285        (should (keymapp
 286                 (fourth
 287                  (find "foofoo" menu :key #'third :test #'string=))))))))
 288
 289 \f
 290 ;;; Helpers
 291 ;;;
 292
 293 (defun yas-should-expand (keys-and-expansions)
 294   (dolist (key-and-expansion keys-and-expansions)
 295     (yas-exit-all-snippets)
 296     (erase-buffer)
 297     (insert (car key-and-expansion))
 298     (let ((yas-fallback-behavior nil))
 299       (ert-simulate-command '(yas-expand)))
 300     (should (string= (buffer-substring-no-properties (point-min) (point-max))
 301                        (cdr key-and-expansion))))
 302   (yas-exit-all-snippets))
 303
 304 (defun yas-should-not-expand (keys)
 305   (dolist (key keys)
 306     (yas-exit-all-snippets)
 307     (erase-buffer)
 308     (insert key)
 309     (let ((yas-fallback-behavior nil))
 310       (ert-simulate-command '(yas-expand)))
 311     (should (string= (buffer-substring-no-properties (point-min) (point-max)) key))))
 312
 313 (defun yas-mock-insert (string)
 314   (interactive)
 315   (do ((i 0 (1+ i)))
 316       ((= i (length string)))
 317     (insert (aref string i))))
 318
 319 (defun yas-make-file-or-dirs (ass)
 320   (let ((file-or-dir-name (car ass))
 321         (content (cdr ass)))
 322     (cond ((listp content)
 323            (make-directory file-or-dir-name 'parents)
 324            (let ((default-directory (concat default-directory "/" file-or-dir-name)))
 325              (mapc #'yas-make-file-or-dirs content)))
 326           ((stringp content)
 327            (with-temp-buffer
 328              (insert content)
 329              (write-region nil nil file-or-dir-name nil 'nomessage)))
 330           (t
 331            (message "[yas] oops don't know this content")))))
 332
 333
 334 (defun yas-variables ()
 335   (let ((syms))
 336     (mapatoms #'(lambda (sym)
 337                   (if (and (string-match "^yas-[^/]" (symbol-name sym))
 338                            (boundp sym))
 339                       (push sym syms))))
 340     syms))
 341
 342 (defun yas-call-with-saving-variables (fn)
 343   (let* ((vars (yas-variables))
 344          (saved-values (mapcar #'symbol-value vars)))
 345     (unwind-protect
 346         (funcall fn)
 347       (loop for var in vars
 348             for saved in saved-values
 349             do (set var saved)))))
 350
 351 (defmacro yas-saving-variables (&rest body)
 352   `(yas-call-with-saving-variables #'(lambda () ,@body)))
 353
 354
 355 (defun yas-call-with-snippet-dirs (dirs fn)
 356   (let* ((default-directory (make-temp-file "yasnippet-fixture" t))
 357          (yas-snippet-dirs (mapcar #'car dirs)))
 358     (with-temp-message ""
 359       (unwind-protect
 360           (progn
 361             (mapc #'yas-make-file-or-dirs dirs)
 362             (funcall fn))
 363         (when (>= emacs-major-version 23)
 364           (delete-directory default-directory 'recursive))))))
 365
 366 (defmacro yas-with-snippet-dirs (dirs &rest body)
 367   `(yas-call-with-snippet-dirs ,dirs
 368                                #'(lambda ()
 369                                    ,@body)))
 370
 371 ;;; Older emacsen
 372 ;;;
 373 (unless (fboundp 'special-mode)
 374   (define-minor-mode special-mode "Just a placeholder for something isn't in emacs 22"))
 375
 376 ;;; btw to test this in emacs22 mac osx:
 377 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
 378 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
 379 ;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
 380
 381
 382 (provide 'yasnippet-tests)
 383 ;;; yasnippet-tests.el ends here
 384 ;; Local Variables:
 385 ;; lexical-binding: t
 386 ;; End: