sly-indentation-tests.el (4807B)
1 ;; -*- lexical-binding: t; -*- 2 (require 'sly-indentation) 3 (require 'sly-tests "lib/sly-tests") 4 5 (sly-define-common-lisp-style "common-lisp-indent-test" 6 ;; Used to specify a few complex indentation specs for testing. 7 ;; (:inherit "basic") ; Commented: unnecessatily messes up test 58 8 (:indentation 9 (complex-indent.1 ((&whole 4 (&whole 1 1 1 1 (&whole 1 1) &rest 1) 10 &body) &body)) 11 (complex-indent.2 (4 (&whole 4 &rest 1) &body)) 12 (complex-indent.3 (4 &body)))) 13 14 (defun sly-indentation-mess-up-indentation () 15 (while (not (eobp)) 16 (forward-line 1) 17 (unless (looking-at "^$") 18 (cl-case (random 2) 19 (0 20 ;; Delete all leading whitespace -- except for 21 ;; comment lines. 22 (while (and (looking-at " ") (not (looking-at " ;"))) 23 (delete-char 1))) 24 (1 25 ;; Insert whitespace random. 26 (let ((n (1+ (random 24)))) 27 (while (> n 0) (cl-decf n) (insert " "))))))) 28 (buffer-string)) 29 30 (defvar sly-indentation--test-function nil 31 "Can be set indentation tests to `indent-region' if need be.") 32 33 (defun sly-indentation-test--1 (bindings expected) 34 (cl-flet ((count-leading 35 (line) 36 (cl-loop for char across line 37 while (eq char ? ) 38 count 1))) 39 (with-temp-buffer 40 (lisp-mode) 41 (setq indent-tabs-mode nil) 42 (sly-common-lisp-set-style "common-lisp-indent-test") 43 (cl-loop for (sym value) in bindings 44 do (set (make-local-variable sym) value)) 45 (insert expected) 46 (goto-char (point-min)) 47 (let ((mess (sly-indentation-mess-up-indentation))) 48 (when (string= mess expected) 49 (ert-fail "Could not mess up indentation?")) 50 (goto-char (point-min)) 51 (indent-region (point-min) (point-max)) ;; Used to be 52 ;; ‘indent-sexp’, but 53 ;; was super unstable 54 ;; on travis, for 55 ;; some reason. 56 (delete-trailing-whitespace) 57 (let ((expected-lines (split-string expected "\n")) 58 (observed-lines (split-string (buffer-string) "\n"))) 59 (should (= (length expected-lines) 60 (length observed-lines))) 61 (cl-loop for expected in expected-lines 62 for observed in observed-lines 63 for n-expected = (count-leading expected) 64 for n-observed = (count-leading observed) 65 unless (= n-expected n-observed) 66 do (message "Starting with this mess:\n%s" mess) 67 (message "\nGot this result:\n%s" (buffer-string)) 68 (ert-fail 69 (format 70 "Expected line `%s' to have %d leading spaces. Got %d" 71 expected n-expected n-observed))) 72 ;; (should (equal expected (buffer-string))) 73 ))))) 74 75 (eval-and-compile 76 (defun sly-indentation-test-form (test-name bindings expected) 77 `(define-sly-ert-test ,test-name () 78 ,(format "An indentation test named `%s'" test-name) 79 (sly-indentation-test--1 ',bindings ,expected))) 80 81 (defun sly-indentation-test-forms-for-file (file) 82 (with-current-buffer 83 (find-file-noselect (expand-file-name file sly-path)) 84 (goto-char (point-min)) 85 (cl-loop 86 while (re-search-forward ";;; Test:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t) 87 for test-name = (intern (match-string-no-properties 1)) 88 for bindings = 89 (save-restriction 90 (narrow-to-region (point) 91 (progn (forward-comment 92 (point-max)) 93 (point))) 94 (save-excursion 95 (goto-char (point-min)) 96 (cl-loop while 97 (re-search-forward 98 "\\([^\s]*\\)[\t\n\s]*:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t) 99 collect (list 100 (intern (match-string-no-properties 1)) 101 (car 102 (read-from-string (match-string-no-properties 2))))))) 103 for expected = (buffer-substring-no-properties (point) 104 (scan-sexps (point) 105 1)) 106 collect (sly-indentation-test-form test-name bindings expected))))) 107 108 (defmacro sly-indentation-define-tests () 109 `(progn 110 ,@(sly-indentation-test-forms-for-file "test/sly-cl-indent-test.txt"))) 111 112 (sly-indentation-define-tests) 113 114 (provide 'sly-indentation-tests)