dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

sly-fontifying-fu-tests.el (3028B)

      1 ;; -*- lexical-binding: t; -*-
      2 (require 'sly-fontifying-fu)
      3 (require 'sly-tests "lib/sly-tests")
      4 (require 'sly-autodoc)
      5 
      6 (cl-defun sly-initialize-lisp-buffer-for-test-suite
      7     (&key (font-lock-magic t) (autodoc t))
      8   (let ((hook lisp-mode-hook))
      9     (unwind-protect
     10         (progn
     11           (set (make-local-variable 'sly-highlight-suppressed-forms)
     12                font-lock-magic)
     13           (setq lisp-mode-hook nil)
     14           (lisp-mode)
     15           (sly-mode 1)
     16           (when (boundp 'sly-autodoc-mode)
     17             (if autodoc
     18                 (sly-autodoc-mode 1)
     19               (sly-autodoc-mode -1))))
     20       (setq lisp-mode-hook hook))))
     21 
     22 (def-sly-test font-lock-magic (buffer-content)
     23     "Some testing for the font-lock-magic. *YES* should be
     24     highlighted as a suppressed form, *NO* should not."
     25 
     26     '(("(defun *NO* (x y) (+ x y))")
     27       ("(defun *NO*")
     28       ("*NO*) #-(and) (*YES*) (*NO* *NO*")
     29       ("\(
     30 \(defun *NO*")
     31       ("\)
     32 \(defun *NO*
     33     \(
     34 \)")
     35       ("#+#.foo
     36 \(defun *NO* (x y) (+ x y))")
     37       ("#+#.foo
     38 \(defun *NO* (x ")
     39       ("#+(
     40 \(defun *NO* (x ")
     41       ("#+(test)
     42 \(defun *NO* (x ")
     43 
     44       ("(eval-when (...)
     45 \(defun *NO* (x ")
     46 
     47       ("(eval-when (...)
     48 #+(and)
     49 \(defun *NO* (x ")
     50 
     51       ("#-(and) (defun *YES* (x y) (+ x y))")
     52       ("
     53 #-(and) (defun *YES* (x y) (+ x y))
     54 #+(and) (defun *NO* (x y) (+ x y))")
     55 
     56       ("#+(and) (defun *NO* (x y) #-(and) (+ *YES* y))")
     57       ("#| #+(or) |# *NO*")
     58       ("#| #+(or) x |# *NO*")
     59       ("*NO* \"#| *NO* #+(or) x |# *NO*\" *NO*")
     60       ("#+#.foo (defun foo (bar))
     61 #-(and) *YES* *NO* bar
     62 ")
     63       ("#+(foo) (defun foo (bar))
     64 #-(and) *YES* *NO* bar")
     65       ("#| #+(or) |# *NO* foo
     66 #-(and) *YES* *NO*")
     67       ("#- (and)
     68 \(*YES*)
     69 \(*NO*)
     70 #-(and)
     71 \(*YES*)
     72 \(*NO*)")
     73       ("#+nil (foo)
     74 
     75 #-(and)
     76 #+nil (
     77        asdf *YES* a
     78             fsdfad)
     79 
     80 \( asdf *YES*
     81 
     82        )
     83 \(*NO*)
     84 
     85 ")
     86       ("*NO*
     87 
     88 #-(and) \(progn
     89    #-(and)
     90    (defun *YES* ...)
     91 
     92    #+(and)
     93    (defun *YES* ...)
     94 
     95    (defun *YES* ...)
     96 
     97    *YES*
     98 
     99    *YES*
    100 
    101    *YES*
    102 
    103    *YES*
    104 \)
    105 
    106 *NO*")
    107       ("#-(not) *YES* *NO*
    108 
    109 *NO*
    110 
    111 #+(not) *NO* *NO*
    112 
    113 *NO*
    114 
    115 #+(not a b c) *NO* *NO*
    116 
    117 *NO*"))
    118   (sly-check-top-level)
    119   (with-temp-buffer
    120     (insert buffer-content)
    121     (sly-initialize-lisp-buffer-for-test-suite
    122      :autodoc t :font-lock-magic t)
    123     ;; Can't use `font-lock-fontify-buffer' because for the case when
    124     ;; `jit-lock-mode' is enabled. Jit-lock-mode fontifies only on
    125     ;; actual display.
    126     (font-lock-default-fontify-buffer)
    127     (when (search-backward "*NO*" nil t)
    128       (sly-test-expect "Not suppressed by reader conditional?"
    129                          'sly-reader-conditional-face
    130                          (get-text-property (point) 'face)
    131                          #'(lambda (x y) (not (eq x y)))))
    132     (goto-char (point-max))
    133     (when (search-backward "*YES*" nil t)
    134       (sly-test-expect "Suppressed by reader conditional?"
    135                          'sly-reader-conditional-face
    136                          (get-text-property (point) 'face)))))
    137 
    138 (provide 'sly-fontifying-fu-tests)