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

   1 ;;; yasnippet-tests.el --- some yasnippet tests  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2012, 2013, 2014, 2015  Free Software Foundation, Inc.
   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 (require 'cl)
  31
  32 \f
  33 ;;; Snippet mechanics
  34
  35 (defun yas--buffer-contents ()
  36   (buffer-substring-no-properties (point-min) (point-max)))
  37
  38 (ert-deftest field-navigation ()
  39   (with-temp-buffer
  40     (yas-minor-mode 1)
  41     (yas-expand-snippet "${1:brother} from another ${2:mother}")
  42     (should (string= (yas--buffer-contents)
  43                      "brother from another mother"))
  44
  45     (should (looking-at "brother"))
  46     (ert-simulate-command '(yas-next-field-or-maybe-expand))
  47     (should (looking-at "mother"))
  48     (ert-simulate-command '(yas-prev-field))
  49     (should (looking-at "brother"))))
  50
  51 (ert-deftest simple-mirror ()
  52   (with-temp-buffer
  53     (yas-minor-mode 1)
  54     (yas-expand-snippet "${1:brother} from another $1")
  55     (should (string= (yas--buffer-contents)
  56                      "brother from another brother"))
  57     (ert-simulate-command `(yas-mock-insert "bla"))
  58     (should (string= (yas--buffer-contents)
  59                      "bla from another bla"))))
  60
  61 (ert-deftest mirror-with-transformation ()
  62   (with-temp-buffer
  63     (yas-minor-mode 1)
  64     (yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
  65     (should (string= (yas--buffer-contents)
  66                      "brother from another BROTHER"))
  67     (ert-simulate-command `(yas-mock-insert "bla"))
  68     (should (string= (yas--buffer-contents)
  69                      "bla from another BLA"))))
  70
  71 (ert-deftest primary-field-transformation ()
  72   (with-temp-buffer
  73     (yas-minor-mode 1)
  74     (let ((snippet "${1:$$(upcase yas-text)}${1:$(concat \"bar\" yas-text)}"))
  75       (yas-expand-snippet snippet)
  76       (should (string= (yas--buffer-contents) "bar"))
  77       (ert-simulate-command `(yas-mock-insert "foo"))
  78       (should (string= (yas--buffer-contents) "FOObarFOO")))))
  79
  80 (ert-deftest nested-placeholders-kill-superfield ()
  81   (with-temp-buffer
  82     (yas-minor-mode 1)
  83     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
  84     (should (string= (yas--buffer-contents)
  85                      "brother from another mother!"))
  86     (ert-simulate-command `(yas-mock-insert "bla"))
  87     (should (string= (yas--buffer-contents)
  88                      "brother from bla!"))))
  89
  90 (ert-deftest nested-placeholders-use-subfield ()
  91   (with-temp-buffer
  92     (yas-minor-mode 1)
  93     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
  94     (ert-simulate-command '(yas-next-field-or-maybe-expand))
  95     (ert-simulate-command `(yas-mock-insert "bla"))
  96     (should (string= (yas--buffer-contents)
  97                      "brother from another bla!"))))
  98
  99 (ert-deftest mirrors-adjacent-to-fields-with-nested-mirrors ()
 100   (with-temp-buffer
 101     (yas-minor-mode 1)
 102     (yas-expand-snippet "<%= f.submit \"${1:Submit}\"${2:$(and (yas-text) \", :disable_with => '\")}${2:$1ing...}${2:$(and (yas-text) \"'\")} %>")
 103     (should (string= (yas--buffer-contents)
 104                      "<%= f.submit \"Submit\", :disable_with => 'Submiting...' %>"))
 105     (ert-simulate-command `(yas-mock-insert "Send"))
 106     (should (string= (yas--buffer-contents)
 107                      "<%= f.submit \"Send\", :disable_with => 'Sending...' %>"))))
 108
 109 (ert-deftest deep-nested-mirroring-issue-351 ()
 110   (with-temp-buffer
 111     (yas-minor-mode 1)
 112     (yas-expand-snippet "${1:FOOOOOOO}${2:$1}${3:$2}${4:$3}")
 113     (ert-simulate-command `(yas-mock-insert "abc"))
 114     (should (string= (yas--buffer-contents) "abcabcabcabc"))))
 115
 116 (ert-deftest delete-numberless-inner-snippet-issue-562 ()
 117   (with-temp-buffer
 118     (yas-minor-mode 1)
 119     (yas-expand-snippet "${3:${test}bla}$0${2:ble}")
 120     (ert-simulate-command '(yas-next-field-or-maybe-expand))
 121     (should (looking-at "testblable"))
 122     (ert-simulate-command '(yas-next-field-or-maybe-expand))
 123     (ert-simulate-command '(yas-skip-and-clear-or-delete-char))
 124     (should (looking-at "ble"))
 125     (should (null (yas--snippets-at-point)))))
 126
 127 ;; (ert-deftest in-snippet-undo ()
 128 ;;   (with-temp-buffer
 129 ;;     (yas-minor-mode 1)
 130 ;;     (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
 131 ;;     (ert-simulate-command '(yas-next-field-or-maybe-expand))
 132 ;;     (ert-simulate-command `(yas-mock-insert "bla"))
 133 ;;     (ert-simulate-command '(undo))
 134 ;;     (should (string= (yas--buffer-contents)
 135 ;;                      "brother from another mother!"))))
 136
 137 \f
 138 ;;; Snippet expansion and character escaping
 139 ;;; Thanks to @zw963 (Billy) for the testing
 140 ;;;
 141 (ert-deftest escape-dollar ()
 142   (with-temp-buffer
 143     (yas-minor-mode 1)
 144     (yas-expand-snippet "bla\\${1:bla}ble")
 145     (should (string= (yas--buffer-contents) "bla${1:bla}ble"))))
 146
 147 (ert-deftest escape-closing-brace ()
 148   (with-temp-buffer
 149     (yas-minor-mode 1)
 150     (yas-expand-snippet "bla${1:bla\\}}ble")
 151     (should (string= (yas--buffer-contents) "blabla}ble"))
 152     (should (string= (yas-field-value 1) "bla}"))))
 153
 154 (ert-deftest escape-backslashes ()
 155   (with-temp-buffer
 156     (yas-minor-mode 1)
 157     (yas-expand-snippet "bla\\ble")
 158     (should (string= (yas--buffer-contents) "bla\\ble"))))
 159
 160 (ert-deftest escape-backquotes ()
 161   (with-temp-buffer
 162     (yas-minor-mode 1)
 163     (yas-expand-snippet "bla`(upcase \"foo\\`bar\")`ble")
 164     (should (string= (yas--buffer-contents) "blaFOO`BARble"))))
 165
 166 (ert-deftest escape-some-elisp-with-strings ()
 167   "elisp with strings and unbalance parens inside it"
 168   (with-temp-buffer
 169     (yas-minor-mode 1)
 170     ;; The rules here is: to output a literal `"' you need to escape
 171     ;; it with one backslash. You don't need to escape them in
 172     ;; embedded elisp.
 173     (yas-expand-snippet "soon \\\"`(concat (upcase \"(my arms\")\"\\\" were all around her\")`")
 174     (should (string= (yas--buffer-contents) "soon \"(MY ARMS\" were all around her"))))
 175
 176 (ert-deftest escape-some-elisp-with-backslashes ()
 177   (with-temp-buffer
 178     (yas-minor-mode 1)
 179     ;; And the rule here is: to output a literal `\' inside a string
 180     ;; inside embedded elisp you need a total of six `\'
 181     (yas-expand-snippet "bla`(upcase \"hey\\\\\\yo\")`ble")
 182     (should (string= (yas--buffer-contents) "blaHEY\\YOble"))))
 183
 184 (ert-deftest be-careful-when-escaping-in-yas-selected-text ()
 185   (with-temp-buffer
 186     (yas-minor-mode 1)
 187     (let ((yas-selected-text "He\\\\o world!"))
 188       (yas-expand-snippet "Look ma! `(yas-selected-text)`")
 189       (should (string= (yas--buffer-contents) "Look ma! He\\\\o world!")))
 190     (yas-exit-all-snippets)
 191     (erase-buffer)
 192     (let ((yas-selected-text "He\"o world!"))
 193       (yas-expand-snippet "Look ma! `(yas-selected-text)`")
 194       (should (string= (yas--buffer-contents) "Look ma! He\"o world!")))
 195     (yas-exit-all-snippets)
 196     (erase-buffer)
 197     (let ((yas-selected-text "He\"\)\\o world!"))
 198       (yas-expand-snippet "Look ma! `(yas-selected-text)`")
 199       (should (string= (yas--buffer-contents) "Look ma! He\"\)\\o world!")))
 200     (yas-exit-all-snippets)
 201     (erase-buffer)))
 202
 203 (ert-deftest be-careful-when-escaping-in-yas-selected-text-2 ()
 204   (with-temp-buffer
 205     (yas-minor-mode 1)
 206     (let ((yas-selected-text "He)}o world!"))
 207       (yas-expand-snippet "Look ma! ${1:`(yas-selected-text)`} OK?")
 208       (should (string= (yas--buffer-contents) "Look ma! He)}o world! OK?")))))
 209
 210 (ert-deftest example-for-issue-271 ()
 211   (with-temp-buffer
 212     (yas-minor-mode 1)
 213     (let ((yas-selected-text "aaa")
 214           (snippet "if ${1:condition}\n`yas-selected-text`\nelse\n$3\nend"))
 215       (yas-expand-snippet snippet)
 216       (yas-next-field)
 217       (ert-simulate-command `(yas-mock-insert "bbb"))
 218       (should (string= (yas--buffer-contents) "if condition\naaa\nelse\nbbb\nend")))))
 219
 220 (defmacro yas--with-font-locked-temp-buffer (&rest body)
 221   "Like `with-temp-buffer', but ensure `font-lock-mode'."
 222   (declare (indent 0) (debug t))
 223   (let ((temp-buffer (make-symbol "temp-buffer")))
 224     ;; NOTE: buffer name must not start with a space, otherwise
 225     ;; `font-lock-mode' doesn't turn on.
 226     `(let ((,temp-buffer (generate-new-buffer "*yas-temp*")))
 227        (with-current-buffer ,temp-buffer
 228          ;; pretend we're interactive so `font-lock-mode' turns on
 229          (let ((noninteractive nil)
 230                ;; turn on font locking after major mode change
 231                (change-major-mode-after-body-hook #'font-lock-mode))
 232            (unwind-protect
 233                (progn (require 'font-lock)
 234                       ;; turn on font locking before major mode change
 235                       (font-lock-mode +1)
 236                       ,@body)
 237              (and (buffer-name ,temp-buffer)
 238                   (kill-buffer ,temp-buffer))))))))
 239
 240 (defmacro yas-saving-variables (&rest body)
 241   `(yas-call-with-saving-variables #'(lambda () ,@body)))
 242
 243 (defmacro yas-with-snippet-dirs (dirs &rest body)
 244   (declare (indent defun))
 245   `(yas-call-with-snippet-dirs ,dirs
 246                                #'(lambda ()
 247                                    ,@body)))
 248
 249 (ert-deftest example-for-issue-474 ()
 250   (yas--with-font-locked-temp-buffer
 251     (c-mode)
 252     (yas-minor-mode 1)
 253     (insert "#include <foo>\n")
 254     (let ((yas-good-grace nil)) (yas-expand-snippet "`\"TODO: \"`"))
 255     (should (string= (yas--buffer-contents) "#include <foo>\nTODO: "))))
 256
 257 (ert-deftest example-for-issue-404 ()
 258   (yas--with-font-locked-temp-buffer
 259     (c++-mode)
 260     (yas-minor-mode 1)
 261     (insert "#include <foo>\n")
 262     (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
 263     (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
 264
 265 (ert-deftest example-for-issue-404-c-mode ()
 266   (yas--with-font-locked-temp-buffer
 267     (c-mode)
 268     (yas-minor-mode 1)
 269     (insert "#include <foo>\n")
 270     (let ((yas-good-grace nil)) (yas-expand-snippet "main"))
 271     (should (string= (yas--buffer-contents) "#include <foo>\nmain"))))
 272
 273 (ert-deftest middle-of-buffer-snippet-insertion ()
 274   (with-temp-buffer
 275     (yas-minor-mode 1)
 276     (insert "beginning")
 277     (save-excursion (insert "end"))
 278     (yas-expand-snippet "-middle-")
 279     (should (string= (yas--buffer-contents) "beginning-middle-end"))))
 280
 281 (ert-deftest another-example-for-issue-271 ()
 282   ;; expect this to fail in batch mode since `region-active-p' doesn't
 283   ;; used by `yas-expand-snippet' doesn't make sense in that context.
 284   ;;
 285   :expected-result (if noninteractive
 286                        :failed
 287                      :passed)
 288   (with-temp-buffer
 289     (yas-minor-mode 1)
 290     (let ((snippet "\\${${1:1}:`yas-selected-text`}"))
 291       (insert "aaabbbccc")
 292       (set-mark 4)
 293       (goto-char 7)
 294       (yas-expand-snippet snippet)
 295       (should (string= (yas--buffer-contents) "aaa${1:bbb}ccc")))))
 296
 297 (ert-deftest string-match-with-subregexp-in-embedded-elisp ()
 298   (with-temp-buffer
 299     (yas-minor-mode 1)
 300     ;; the rule here is: To use regexps in embedded `(elisp)` expressions, write
 301     ;; it like you would normal elisp, i.e. no need to escape the backslashes.
 302     (let ((snippet "`(if (string-match \"foo\\\\(ba+r\\\\)foo\" \"foobaaaaaaaaaarfoo\")
 303                          \"ok\"
 304                          \"fail\")`"))
 305       (yas-expand-snippet snippet))
 306     (should (string= (yas--buffer-contents) "ok"))))
 307
 308 (ert-deftest string-match-with-subregexp-in-mirror-transformations ()
 309   (with-temp-buffer
 310     (yas-minor-mode 1)
 311     ;; the rule here is: To use regexps in embedded `(elisp)` expressions,
 312     ;; escape backslashes once, i.e. to use \\( \\) constructs, write \\\\( \\\\).
 313     (let ((snippet "$1${1:$(if (string-match \"foo\\\\\\\\(ba+r\\\\\\\\)baz\" yas-text)
 314                                 \"ok\"
 315                                 \"fail\")}"))
 316       (yas-expand-snippet snippet)
 317       (should (string= (yas--buffer-contents) "fail"))
 318       (ert-simulate-command `(yas-mock-insert "foobaaar"))
 319       (should (string= (yas--buffer-contents) "foobaaarfail"))
 320       (ert-simulate-command `(yas-mock-insert "baz"))
 321       (should (string= (yas--buffer-contents) "foobaaarbazok")))))
 322
 323 \f
 324 ;;; Misc tests
 325 ;;;
 326 (ert-deftest protection-overlay-no-cheating ()
 327   "Protection overlays at the very end of the buffer are dealt
 328   with by cheatingly inserting a newline!
 329
 330 TODO: correct this bug!"
 331   :expected-result :failed
 332   (with-temp-buffer
 333     (yas-minor-mode 1)
 334     (yas-expand-snippet "${2:brother} from another ${1:mother}")
 335     (should (string= (yas--buffer-contents)
 336                      "brother from another mother") ;; no newline should be here!
 337             )))
 338
 339 (defvar yas--barbaz)
 340 (defvar yas--foobarbaz)
 341
 342 ;; See issue #497. To understand this test, follow the example of the
 343 ;; `yas-key-syntaxes' docstring.
 344 ;;
 345 (ert-deftest complicated-yas-key-syntaxes ()
 346   (with-temp-buffer
 347     (yas-saving-variables
 348      (yas-with-snippet-dirs
 349        '((".emacs.d/snippets"
 350           ("emacs-lisp-mode"
 351            ("foo-barbaz" . "# condition: yas--foobarbaz\n# --\nOKfoo-barbazOK")
 352            ("barbaz" . "# condition: yas--barbaz\n# --\nOKbarbazOK")
 353            ("baz" . "OKbazOK")
 354            ("'quote" . "OKquoteOK"))))
 355        (yas-reload-all)
 356        (emacs-lisp-mode)
 357        (yas-minor-mode-on)
 358        (let ((yas-key-syntaxes '("w" "w_")))
 359          (let ((yas--barbaz t))
 360            (yas-should-expand '(("foo-barbaz" . "foo-OKbarbazOK")
 361                                 ("barbaz" . "OKbarbazOK"))))
 362          (let ((yas--foobarbaz t))
 363            (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK"))))
 364          (let ((yas-key-syntaxes
 365                 (cons #'(lambda (_start-point)
 366                           (unless (looking-back "-")
 367                             (backward-char)
 368                             'again))
 369                       yas-key-syntaxes))
 370                (yas--foobarbaz t))
 371            (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))))
 372        (let ((yas-key-syntaxes '(yas-try-key-from-whitespace)))
 373          (yas-should-expand '(("xxx\n'quote" . "xxx\nOKquoteOK")
 374                               ("xxx 'quote" . "xxx OKquoteOK"))))
 375        (let ((yas-key-syntaxes '(yas-shortest-key-until-whitespace))
 376              (yas--foobarbaz t) (yas--barbaz t))
 377          (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))
 378          (setq yas-key-syntaxes '(yas-longest-key-from-whitespace))
 379          (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK")
 380                               ("foo " . "foo "))))))))
 381
 382 \f
 383 ;;; Loading
 384 ;;;
 385 (defun yas--call-with-temporary-redefinitions (function
 386                                                &rest function-names-and-overriding-functions)
 387   (let* ((overrides (remove-if-not #'(lambda (fdef)
 388                                        (fboundp (first fdef)))
 389                                    function-names-and-overriding-functions))
 390          (definition-names (mapcar #'first overrides))
 391          (overriding-functions (mapcar #'second overrides))
 392          (saved-functions (mapcar #'symbol-function definition-names)))
 393     ;; saving all definitions before overriding anything ensures FDEFINITION
 394     ;; errors don't cause accidental permanent redefinitions.
 395     ;;
 396     (cl-labels ((set-fdefinitions (names functions)
 397                                   (loop for name in names
 398                                         for fn in functions
 399                                         do (fset name fn))))
 400       (set-fdefinitions definition-names overriding-functions)
 401       (unwind-protect (funcall function)
 402         (set-fdefinitions definition-names saved-functions)))))
 403
 404 (defmacro yas--with-temporary-redefinitions (fdefinitions &rest body)
 405   ;; "Temporarily (but globally) redefine each function in FDEFINITIONS.
 406   ;; E.g.: (yas--with-temporary-redefinitions ((foo (x) ...)
 407   ;;                                           (bar (x) ...))
 408   ;;         ;; code that eventually calls foo, bar of (setf foo)
 409   ;;         ...)"
 410   ;; FIXME: This is hideous!  Better use defadvice (or at least letf).
 411   `(yas--call-with-temporary-redefinitions
 412     (lambda () ,@body)
 413     ,@(mapcar #'(lambda (thingy)
 414                   `(list ',(first thingy)
 415                          (lambda ,@(rest thingy))))
 416               fdefinitions)))
 417
 418 (defmacro yas-with-overriden-buffer-list (&rest body)
 419   (let ((saved-sym (make-symbol "yas--buffer-list")))
 420     `(let ((,saved-sym (symbol-function 'buffer-list)))
 421        (yas--with-temporary-redefinitions
 422            ((buffer-list ()
 423                          (remove-if #'(lambda (buf)
 424                                         (with-current-buffer buf
 425                                           (eq major-mode 'lisp-interaction-mode)))
 426                                     (funcall ,saved-sym))))
 427          ,@body))))
 428
 429
 430 (defmacro yas-with-some-interesting-snippet-dirs (&rest body)
 431   `(yas-saving-variables
 432     (yas-with-overriden-buffer-list
 433      (yas-with-snippet-dirs
 434        '((".emacs.d/snippets"
 435           ("c-mode"
 436            (".yas-parents" . "cc-mode")
 437            ("printf" . "printf($1);"))  ;; notice the overriding for issue #281
 438           ("emacs-lisp-mode" ("ert-deftest" . "(ert-deftest ${1:name} () $0)"))
 439           ("lisp-interaction-mode" (".yas-parents" . "emacs-lisp-mode")))
 440          ("library/snippets"
 441           ("c-mode"
 442            (".yas-parents" . "c++-mode")
 443            ("printf" . "printf"))
 444           ("cc-mode" ("def" . "# define"))
 445           ("emacs-lisp-mode" ("dolist" . "(dolist)"))
 446           ("lisp-interaction-mode" ("sc" . "brother from another mother"))))
 447        ,@body))))
 448
 449
 450 (ert-deftest basic-jit-loading ()
 451   "Test basic loading and expansion of snippets"
 452   (yas-with-some-interesting-snippet-dirs
 453    (yas-reload-all)
 454    (yas--basic-jit-loading-1)))
 455
 456 (ert-deftest basic-jit-loading-with-compiled-snippets ()
 457   "Test basic loading and expansion of snippets"
 458   (yas-with-some-interesting-snippet-dirs
 459    (yas-reload-all)
 460    (yas-recompile-all)
 461    (yas--with-temporary-redefinitions ((yas--load-directory-2
 462                                         (&rest _dummies)
 463                                         (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled")))
 464      (yas-reload-all)
 465      (yas--basic-jit-loading-1))))
 466
 467 (ert-deftest loading-with-cyclic-parenthood ()
 468   "Test loading when cyclic parenthood is setup."
 469   (yas-saving-variables
 470    (yas-with-snippet-dirs '((".emacs.d/snippets"
 471                              ("c-mode"
 472                               (".yas-parents" . "cc-mode"))
 473                              ("cc-mode"
 474                               (".yas-parents" . "yet-another-c-mode and-that-one"))
 475                              ("yet-another-c-mode"
 476                               (".yas-parents" . "c-mode and-also-this-one lisp-interaction-mode"))))
 477      (yas-reload-all)
 478      (with-temp-buffer
 479        (let* ((major-mode 'c-mode)
 480               (expected `(c-mode
 481                           cc-mode
 482                           yet-another-c-mode
 483                           and-also-this-one
 484                           and-that-one
 485                           ;; prog-mode doesn't exit in emacs 24.3
 486                           ,@(if (fboundp 'prog-mode)
 487                                 '(prog-mode))
 488                           emacs-lisp-mode
 489                           lisp-interaction-mode))
 490               (observed (yas--modes-to-activate)))
 491          (should (null (cl-set-exclusive-or expected observed)))
 492          (should (= (length expected)
 493                     (length observed))))))))
 494
 495 (defalias 'yas--phony-c-mode 'c-mode)
 496
 497 (ert-deftest issue-492-and-494 ()
 498   (define-derived-mode yas--test-mode yas--phony-c-mode "Just a test mode")
 499   (yas-with-snippet-dirs '((".emacs.d/snippets"
 500                             ("yas--test-mode")))
 501                          (yas-reload-all)
 502                          (with-temp-buffer
 503                            (let* ((major-mode 'yas--test-mode)
 504                                   (expected `(c-mode
 505                                               ,@(if (fboundp 'prog-mode)
 506                                                     '(prog-mode))
 507                                               yas--phony-c-mode
 508                                               yas--test-mode))
 509                                   (observed (yas--modes-to-activate)))
 510                              (should (null (cl-set-exclusive-or expected observed)))
 511                              (should (= (length expected)
 512                                         (length observed)))))))
 513
 514 (define-derived-mode yas--test-mode c-mode "Just a test mode")
 515 (define-derived-mode yas--another-test-mode c-mode "Another test mode")
 516
 517 (ert-deftest issue-504-tricky-jit ()
 518   (yas-with-snippet-dirs
 519    '((".emacs.d/snippets"
 520       ("yas--another-test-mode"
 521        (".yas-parents" . "yas--test-mode"))
 522       ("yas--test-mode")))
 523    (let ((b (with-current-buffer (generate-new-buffer "*yas-test*")
 524               (yas--another-test-mode)
 525               (current-buffer))))
 526      (unwind-protect
 527          (progn
 528            (yas-reload-all)
 529            (should (= 0 (hash-table-count yas--scheduled-jit-loads))))
 530        (kill-buffer b)))))
 531
 532 (defun yas--basic-jit-loading-1 ()
 533   (with-temp-buffer
 534     (should (= 4 (hash-table-count yas--scheduled-jit-loads)))
 535     (should (= 0 (hash-table-count yas--tables)))
 536     (lisp-interaction-mode)
 537     (yas-minor-mode 1)
 538     (should (= 2 (hash-table-count yas--scheduled-jit-loads)))
 539     (should (= 2 (hash-table-count yas--tables)))
 540     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'lisp-interaction-mode yas--tables)))))
 541     (should (= 2 (hash-table-count (yas--table-uuidhash (gethash 'emacs-lisp-mode yas--tables)))))
 542     (yas-should-expand '(("sc" . "brother from another mother")
 543                          ("dolist" . "(dolist)")
 544                          ("ert-deftest" . "(ert-deftest name () )")))
 545     (c-mode)
 546     (yas-minor-mode 1)
 547     (should (= 0 (hash-table-count yas--scheduled-jit-loads)))
 548     (should (= 4 (hash-table-count yas--tables)))
 549     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'c-mode yas--tables)))))
 550     (should (= 1 (hash-table-count (yas--table-uuidhash (gethash 'cc-mode yas--tables)))))
 551     (yas-should-expand '(("printf" . "printf();")
 552                          ("def" . "# define")))
 553     (yas-should-not-expand '("sc" "dolist" "ert-deftest"))))
 554
 555 \f
 556 ;;; Menu
 557 ;;;
 558 (defmacro yas-with-even-more-interesting-snippet-dirs (&rest body)
 559   `(yas-saving-variables
 560     (yas-with-snippet-dirs
 561       `((".emacs.d/snippets"
 562          ("c-mode"
 563           (".yas-make-groups" . "")
 564           ("printf" . "printf($1);")
 565           ("foo-group-a"
 566            ("fnprintf" . "fprintf($1);")
 567            ("snprintf" . "snprintf($1);"))
 568           ("foo-group-b"
 569            ("strcmp" . "strecmp($1);")
 570            ("strcasecmp" . "strcasecmp($1);")))
 571          ("lisp-interaction-mode"
 572           ("ert-deftest" . "# group: barbar\n# --\n(ert-deftest ${1:name} () $0)"))
 573          ("fancy-mode"
 574           ("a-guy" . "# uuid: 999\n# --\nyo!")
 575           ("a-sir" . "# uuid: 12345\n# --\nindeed!")
 576           ("a-lady" . "# uuid: 54321\n# --\noh-la-la!")
 577           ("a-beggar" . "# uuid: 0101\n# --\narrrgh!")
 578           ("an-outcast" . "# uuid: 666\n# --\narrrgh!")
 579           (".yas-setup.el" . , (pp-to-string
 580                                 '(yas-define-menu 'fancy-mode
 581                                                   '((yas-ignore-item "0101")
 582                                                     (yas-item "999")
 583                                                     (yas-submenu "sirs"
 584                                                                  ((yas-item "12345")))
 585                                                     (yas-submenu "ladies"
 586                                                                  ((yas-item "54321"))))
 587                                                   '("666")))))))
 588       ,@body)))
 589
 590 (ert-deftest test-yas-define-menu ()
 591   (let ((yas-use-menu t))
 592     (yas-with-even-more-interesting-snippet-dirs
 593      (yas-reload-all 'no-jit)
 594      (let ((menu (cdr (gethash 'fancy-mode yas--menu-table))))
 595        (should (eql 4 (length menu)))
 596        (dolist (item '("a-guy" "a-beggar"))
 597          (should (find item menu :key #'third :test #'string=)))
 598        (should-not (find "an-outcast" menu :key #'third :test #'string=))
 599        (dolist (submenu '("sirs" "ladies"))
 600          (should (keymapp
 601                   (fourth
 602                    (find submenu menu :key #'third :test #'string=)))))
 603        ))))
 604
 605 (ert-deftest test-group-menus ()
 606   "Test group-based menus using .yas-make-groups and the group directive"
 607   (let ((yas-use-menu t))
 608     (yas-with-even-more-interesting-snippet-dirs
 609      (yas-reload-all 'no-jit)
 610      ;; first the subdir-based groups
 611      ;;
 612      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 613        (should (eql 3 (length menu)))
 614        (dolist (item '("printf" "foo-group-a" "foo-group-b"))
 615          (should (find item menu :key #'third :test #'string=)))
 616        (dolist (submenu '("foo-group-a" "foo-group-b"))
 617          (should (keymapp
 618                   (fourth
 619                    (find submenu menu :key #'third :test #'string=))))))
 620      ;; now group directives
 621      ;;
 622      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 623        (should (eql 1 (length menu)))
 624        (should (find "barbar" menu :key #'third :test #'string=))
 625        (should (keymapp
 626                 (fourth
 627                  (find "barbar" menu :key #'third :test #'string=))))))))
 628
 629 (ert-deftest test-group-menus-twisted ()
 630   "Same as similarly named test, but be mean.
 631
 632 TODO: be meaner"
 633   (let ((yas-use-menu t))
 634     (yas-with-even-more-interesting-snippet-dirs
 635      ;; add a group directive conflicting with the subdir and watch
 636      ;; behaviour
 637      (with-temp-buffer
 638        (insert "# group: foo-group-c\n# --\nstrecmp($1)")
 639        (write-region nil nil (concat (first (yas-snippet-dirs))
 640                                      "/c-mode/foo-group-b/strcmp")))
 641      (yas-reload-all 'no-jit)
 642      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 643        (should (eql 4 (length menu)))
 644        (dolist (item '("printf" "foo-group-a" "foo-group-b" "foo-group-c"))
 645          (should (find item menu :key #'third :test #'string=)))
 646        (dolist (submenu '("foo-group-a" "foo-group-b" "foo-group-c"))
 647          (should (keymapp
 648                   (fourth
 649                    (find submenu menu :key #'third :test #'string=))))))
 650      ;; delete the .yas-make-groups file and watch behaviour
 651      ;;
 652      (delete-file (concat (first (yas-snippet-dirs))
 653                           "/c-mode/.yas-make-groups"))
 654      (yas-reload-all 'no-jit)
 655      (let ((menu (cdr (gethash 'c-mode yas--menu-table))))
 656        (should (eql 5 (length menu))))
 657      ;; Change a group directive and reload
 658      ;;
 659      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 660        (should (find "barbar" menu :key #'third :test #'string=)))
 661
 662      (with-temp-buffer
 663        (insert "# group: foofoo\n# --\n(ert-deftest ${1:name} () $0)")
 664        (write-region nil nil (concat (first (yas-snippet-dirs))
 665                                      "/lisp-interaction-mode/ert-deftest")))
 666      (yas-reload-all 'no-jit)
 667      (let ((menu (cdr (gethash 'lisp-interaction-mode yas--menu-table))))
 668        (should (eql 1 (length menu)))
 669        (should (find "foofoo" menu :key #'third :test #'string=))
 670        (should (keymapp
 671                 (fourth
 672                  (find "foofoo" menu :key #'third :test #'string=))))))))
 673
 674 \f
 675 ;;; The infamous and problematic tab keybinding
 676 ;;;
 677 (ert-deftest test-yas-tab-binding ()
 678   (with-temp-buffer
 679     (yas-minor-mode -1)
 680     (should (not (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand)))
 681     (yas-minor-mode 1)
 682     (should (eq (key-binding (yas--read-keybinding "<tab>")) 'yas-expand))
 683     (yas-expand-snippet "$1 $2 $3")
 684     (should (eq (key-binding [(tab)]) 'yas-next-field-or-maybe-expand))
 685     (should (eq (key-binding (kbd "TAB")) 'yas-next-field-or-maybe-expand))
 686     (should (eq (key-binding [(shift tab)]) 'yas-prev-field))
 687     (should (eq (key-binding [backtab]) 'yas-prev-field))))
 688
 689 (ert-deftest test-rebindings ()
 690   (unwind-protect
 691       (progn
 692         (define-key yas-minor-mode-map [tab] nil)
 693         (define-key yas-minor-mode-map (kbd "TAB") nil)
 694         (define-key yas-minor-mode-map (kbd "SPC") 'yas-expand)
 695         (with-temp-buffer
 696           (yas-minor-mode 1)
 697           (should (not (eq (key-binding (yas--read-keybinding "TAB")) 'yas-expand)))
 698           (should (eq (key-binding (yas--read-keybinding "SPC")) 'yas-expand))
 699           (yas-reload-all)
 700           (should (not (eq (key-binding (yas--read-keybinding "TAB")) 'yas-expand)))
 701           (should (eq (key-binding (yas--read-keybinding "SPC")) 'yas-expand))))
 702     ;; FIXME: actually should restore to whatever saved values where there.
 703     ;;
 704     (define-key yas-minor-mode-map [tab] 'yas-expand)
 705     (define-key yas-minor-mode-map (kbd "TAB") 'yas-expand)
 706     (define-key yas-minor-mode-map (kbd "SPC") nil)))
 707
 708 (ert-deftest test-yas-in-org ()
 709   (with-temp-buffer
 710     (org-mode)
 711     (yas-minor-mode 1)
 712     (should (eq (key-binding [(tab)]) 'yas-expand))
 713     (should (eq (key-binding (kbd "TAB")) 'yas-expand))))
 714
 715 (ert-deftest test-yas-activate-extra-modes ()
 716   "Given a symbol, `yas-activate-extra-mode' should be able to
 717 add the snippets associated with the given mode."
 718   (with-temp-buffer
 719     (yas-saving-variables
 720      (yas-with-snippet-dirs
 721        '((".emacs.d/snippets"
 722           ("markdown-mode"
 723            ("_" . "_Text_ "))
 724           ("emacs-lisp-mode"
 725            ("car" . "(car )"))))
 726        (yas-reload-all)
 727        (emacs-lisp-mode)
 728        (yas-minor-mode-on)
 729        (yas-activate-extra-mode 'markdown-mode)
 730        (should (eq 'markdown-mode (car yas--extra-modes)))
 731        (yas-should-expand '(("_" . "_Text_ ")))
 732        (yas-should-expand '(("car" . "(car )")))
 733        (yas-deactivate-extra-mode 'markdown-mode)
 734        (should-not (eq 'markdown-mode (car yas--extra-modes)))
 735        (yas-should-not-expand '("_"))
 736        (yas-should-expand '(("car" . "(car )")))))))
 737
 738 \f
 739 ;;; Helpers
 740 ;;;
 741 (defun yas-should-expand (keys-and-expansions)
 742   (dolist (key-and-expansion keys-and-expansions)
 743     (yas-exit-all-snippets)
 744     (narrow-to-region (point) (point))
 745     (insert (car key-and-expansion))
 746     (let ((yas-fallback-behavior nil))
 747       (ert-simulate-command '(yas-expand)))
 748     (unless (string= (yas--buffer-contents) (cdr key-and-expansion))
 749       (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
 750                         (car key-and-expansion)
 751                         (cdr key-and-expansion)
 752                         (yas--buffer-contents)))))
 753   (yas-exit-all-snippets))
 754
 755 (defun yas-should-not-expand (keys)
 756   (dolist (key keys)
 757     (yas-exit-all-snippets)
 758     (narrow-to-region (point) (point))
 759     (insert key)
 760     (let ((yas-fallback-behavior nil))
 761       (ert-simulate-command '(yas-expand)))
 762     (unless (string= (yas--buffer-contents) key)
 763       (ert-fail (format "\"%s\" should have stayed put, but instead expanded to \"%s\""
 764                         key
 765                         (yas--buffer-contents))))))
 766
 767 (defun yas-mock-insert (string)
 768   (interactive)
 769   (do ((i 0 (1+ i)))
 770       ((= i (length string)))
 771     (insert (aref string i))))
 772
 773 (defun yas-make-file-or-dirs (ass)
 774   (let ((file-or-dir-name (car ass))
 775         (content (cdr ass)))
 776     (cond ((listp content)
 777            (make-directory file-or-dir-name 'parents)
 778            (let ((default-directory (concat default-directory "/" file-or-dir-name)))
 779              (mapc #'yas-make-file-or-dirs content)))
 780           ((stringp content)
 781            (with-temp-buffer
 782              (insert content)
 783              (write-region nil nil file-or-dir-name nil 'nomessage)))
 784           (t
 785            (message "[yas] oops don't know this content")))))
 786
 787
 788 (defun yas-variables ()
 789   (let ((syms))
 790     (mapatoms #'(lambda (sym)
 791                   (if (and (string-match "^yas-[^/]" (symbol-name sym))
 792                            (boundp sym))
 793                       (push sym syms))))
 794     syms))
 795
 796 (defun yas-call-with-saving-variables (fn)
 797   (let* ((vars (yas-variables))
 798          (saved-values (mapcar #'symbol-value vars)))
 799     (unwind-protect
 800         (funcall fn)
 801       (loop for var in vars
 802             for saved in saved-values
 803             do (set var saved)))))
 804
 805 (defun yas-call-with-snippet-dirs (dirs fn)
 806   (let* ((default-directory (make-temp-file "yasnippet-fixture" t))
 807          (yas-snippet-dirs (mapcar #'car dirs)))
 808     (with-temp-message ""
 809       (unwind-protect
 810           (progn
 811             (mapc #'yas-make-file-or-dirs dirs)
 812             (funcall fn))
 813         (when (>= emacs-major-version 24)
 814           (delete-directory default-directory 'recursive))))))
 815
 816 ;;; Older emacsen
 817 ;;;
 818 (unless (fboundp 'special-mode)
 819   ;; FIXME: Why provide this default definition here?!?
 820   (defalias 'special-mode 'fundamental))
 821
 822 ;;; btw to test this in emacs22 mac osx:
 823 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
 824 ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
 825 ;;; /usr/bin/emacs -nw -Q -L . -l yasnippet-tests.el --batch -e ert
 826
 827
 828 (put 'yas-saving-variables                   'edebug-form-spec t)
 829 (put 'yas-with-snippet-dirs                  'edebug-form-spec t)
 830 (put 'yas-with-overriden-buffer-list         'edebug-form-spec t)
 831 (put 'yas-with-some-interesting-snippet-dirs 'edebug-form-spec t)
 832
 833
 834 (put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
 835 (put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
 836
 837
 838
 839
 840 (provide 'yasnippet-tests)
 841 ;; Local Variables:
 842 ;; indent-tabs-mode: nil
 843 ;; byte-compile-warnings: (not cl-functions)
 844 ;; End:
 845 ;;; yasnippet-tests.el ends here