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