yaml-mode-test.el (6144B)
1 ;;;; yaml-mode-test.el --- Tests for yaml-mode -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2022 - Shohei YOSHIDA 4 5 ;; Author: Shohei YOSHIDA <syohex@gmail.com> 6 7 ;; This file is not part of GNU Emacs. 8 9 ;; This program is free software; you can redistribute it and/or modify 10 ;; it under the terms of the GNU General Public License as published by 11 ;; the Free Software Foundation, either version 3 of the License, or 12 ;; (at your option) any later version. 13 14 ;; This program is distributed in the hope that it will be useful, 15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 ;; GNU General Public License for more details. 18 19 ;; You should have received a copy of the GNU General Public License 20 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 21 22 ;;; Commentary: 23 24 ;; many test utilities are copied from markdown-mode 25 26 ;;; Code: 27 28 (require 'yaml-mode) 29 (require 'ert) 30 31 ;; for version < 25 32 (defconst yaml-test-font-lock-function 33 (if (fboundp 'font-lock-ensure) 34 #'font-lock-ensure 35 #'font-lock-fontify-buffer)) 36 37 (defun yaml-test-font-lock--ranges (string) 38 (let (ranges) 39 (with-temp-buffer 40 (insert string) 41 (goto-char (point-min)) 42 (while (search-forward "«" nil t) 43 (let ((beg (match-beginning 0))) 44 (replace-match "") 45 (when (not (search-forward "»" nil t)) 46 (user-error "unmatched range on line %d (%d)" 47 (line-number-at-pos beg) beg)) 48 (let ((end (match-beginning 0))) 49 (replace-match "") 50 (push (cons beg end) ranges))))) 51 (nreverse ranges))) 52 53 (defun yaml-test-font-lock (string faces) 54 "Ensure that STRING contains specified FACES in `yaml-mode'. 55 STRING contains areas delimited by chevrons («...») that 56 correspond to FACES in the listed order." 57 (declare (indent 1)) 58 (let ((win (selected-window)) 59 (ranges (yaml-test-font-lock--ranges string))) 60 (when (not (= (length ranges) (length faces))) 61 (user-error "Mismatch between number of ranges and specified faces.")) 62 (with-temp-buffer 63 (set-window-buffer win (current-buffer) t) 64 (insert (replace-regexp-in-string "[«»]" "" string)) 65 (yaml-mode) 66 (funcall yaml-test-font-lock-function) 67 (dolist (face faces) 68 (let* ((range (pop ranges)) 69 (beg (car range)) 70 (end (1- (cdr range)))) 71 (yaml-test-range-has-face beg end face)))))) 72 73 (defun yaml-test-report-property-range (begin end prop) 74 "Report buffer substring and property PROP from BEGIN to END." 75 (message "Buffer substring: %s" (buffer-substring begin (1+ end))) 76 (message "Properties in range are as follows:") 77 (dolist (loc (number-sequence begin end)) 78 (message "%d: %s" loc (get-char-property loc prop)))) 79 80 (defun yaml-test-range-has-property (begin end prop value) 81 "Verify that range BEGIN to END has PROP equal to or containing VALUE." 82 (let ((fail-loc 83 (catch 'fail 84 (dolist (loc (number-sequence begin end)) 85 (let ((vals (get-char-property loc prop))) 86 (if (and vals (listp vals)) 87 (unless (memq value vals) 88 (throw 'fail loc)) 89 (unless (eq vals value) 90 (throw 'fail loc)))))))) 91 (when fail-loc 92 (message "Testing range (%d,%d) for property %s equal to %s." 93 begin end prop value) 94 (message "Expected value (%s) not found in property (%s) at location %d" value prop fail-loc) 95 (yaml-test-report-property-range begin end prop)) 96 (should-not fail-loc))) 97 98 (defun yaml-test-range-has-face (begin end face) 99 "Verify that the range from BEGIN to END has face FACE." 100 (yaml-test-range-has-property begin end 'face face)) 101 102 (defmacro yaml-test-string (string &rest body) 103 "Run BODY in a temporary buffer containing STRING in `yaml-mode'." 104 (declare (indent 1)) 105 `(let ((win (selected-window))) 106 (with-temp-buffer 107 (set-window-buffer win (current-buffer) t) 108 (insert ,string) 109 (yaml-mode) 110 (funcall yaml-test-font-lock-function) 111 (setq-default indent-tabs-mode nil) 112 (goto-char (point-min)) 113 ,@body))) 114 (def-edebug-spec yaml-test-string (form body)) 115 116 ;;; major-mode tests: 117 118 (ert-deftest test-yaml-major-mode () 119 "Test auto-mode-alist setting." 120 (dolist (extension '(".yml" ".yaml" ".eyml" ".eyaml" ".raml")) 121 (let ((file (make-temp-file "a" nil extension))) 122 (unwind-protect 123 (with-current-buffer (find-file-noselect file) 124 (should (eq major-mode 'yaml-mode))) 125 (delete-file file))))) 126 127 ;;; Regression tests: 128 129 (ert-deftest highlighting/string-syntax () 130 "Highlighting of string syntax. 131 Detail: https://github.com/yoshiki/yaml-mode/issues/75 132 PR: https://github.com/yoshiki/yaml-mode/pull/76" 133 (yaml-test-font-lock "«some's'strings'some's'nots»: 134 - here: «syntax is not string» 135 - this: «'is a string with \"quotes\"'» 136 - and: «'to express one single quote, use '' two of them'» 137 - finally: «syntax is not string» 138 - singlequotedoesntfreeze: ' 139 " 140 '(font-lock-variable-name-face 141 nil 142 font-lock-string-face 143 font-lock-string-face 144 nil))) 145 146 (ert-deftest highlighting/list-of-dicts-containing-literal-block () 147 "Highlighting literal blocks in list of dicts. 148 PR: https://github.com/yoshiki/yaml-mode/pull/81" 149 (yaml-test-font-lock "example: 150 - key1: «Correctly propertized» 151 key2: | 152 «Correctly propertized.» 153 - key3: | 154 «Correctly propertized» 155 key4: «Incorrectly propertized as part of preceding yaml-literal-block» 156 " 157 '(nil 158 font-lock-string-face 159 font-lock-string-face 160 nil))) 161 162 (ert-deftest highlighting/constant-before-comment () 163 "Highlighting constant before comment. 164 Detail: https://github.com/yoshiki/yaml-mode/issues/96" 165 (yaml-test-font-lock "services: 166 - keystone: 167 tls: «True» 168 - horizon: 169 tls: «True» # comment 170 - nova: 171 tls: «True#123» 172 " 173 '(font-lock-constant-face 174 font-lock-constant-face 175 nil))) 176 177 (provide 'yaml-mode-test) 178 179 ;;; yaml-mode-test.el ends here