82 lines
3.2 KiB
EmacsLisp
82 lines
3.2 KiB
EmacsLisp
|
(require 'slime-indentation)
|
||
|
|
(require 'slime-tests)
|
||
|
|
|
||
|
|
(define-common-lisp-style "common-lisp-indent-test"
|
||
|
|
;; Used to specify a few complex indentation specs for testing.
|
||
|
|
(:inherit "basic")
|
||
|
|
(:indentation
|
||
|
|
(complex-indent.1 ((&whole 4 (&whole 1 1 1 1 (&whole 1 1) &rest 1)
|
||
|
|
&body) &body))
|
||
|
|
(complex-indent.2 (4 (&whole 4 &rest 1) &body))
|
||
|
|
(complex-indent.3 (4 &body))))
|
||
|
|
|
||
|
|
(defun slime-indentation-mess-up-indentation ()
|
||
|
|
(while (not (eobp))
|
||
|
|
(forward-line 1)
|
||
|
|
(unless (looking-at "^$")
|
||
|
|
(cl-case (random 2)
|
||
|
|
(0
|
||
|
|
;; Delete all leading whitespace -- except for
|
||
|
|
;; comment lines.
|
||
|
|
(while (and (looking-at " ") (not (looking-at " ;")))
|
||
|
|
(delete-char 1)))
|
||
|
|
(1
|
||
|
|
;; Insert whitespace random.
|
||
|
|
(let ((n (1+ (random 24))))
|
||
|
|
(while (> n 0) (cl-decf n) (insert " ")))))))
|
||
|
|
(buffer-string))
|
||
|
|
|
||
|
|
(eval-and-compile
|
||
|
|
(defun slime-indentation-test-form (test-name bindings expected)
|
||
|
|
`(define-slime-ert-test ,test-name ()
|
||
|
|
,(format "An indentation test named `%s'" test-name)
|
||
|
|
(with-temp-buffer
|
||
|
|
(lisp-mode)
|
||
|
|
(setq indent-tabs-mode nil)
|
||
|
|
(common-lisp-set-style "common-lisp-indent-test")
|
||
|
|
(let ,(cons `(expected ,expected) bindings)
|
||
|
|
(insert expected)
|
||
|
|
(goto-char (point-min))
|
||
|
|
(let ((mess (slime-indentation-mess-up-indentation)))
|
||
|
|
(when (string= mess expected)
|
||
|
|
(ert-fail "Could not mess up indentation?"))
|
||
|
|
(indent-region (point-min) (point-max))
|
||
|
|
(delete-trailing-whitespace)
|
||
|
|
(should (equal expected (buffer-string))))))))
|
||
|
|
|
||
|
|
(defun slime-indentation-test-forms-for-file (file)
|
||
|
|
(with-current-buffer
|
||
|
|
(find-file-noselect (concat slime-path
|
||
|
|
"/contrib/test/slime-cl-indent-test.txt"))
|
||
|
|
(goto-char (point-min))
|
||
|
|
(cl-loop
|
||
|
|
while (re-search-forward ";;; Test:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t)
|
||
|
|
for test-name = (intern (match-string-no-properties 1))
|
||
|
|
for bindings =
|
||
|
|
(save-restriction
|
||
|
|
(narrow-to-region (point)
|
||
|
|
(progn (forward-comment
|
||
|
|
(point-max))
|
||
|
|
(point)))
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (point-min))
|
||
|
|
(cl-loop while
|
||
|
|
(re-search-forward
|
||
|
|
"\\([^\s]*\\)[\t\n\s]*:[\t\n\s]*\\(.*\\)[\t\n\s]" nil t)
|
||
|
|
collect (list
|
||
|
|
(intern (match-string-no-properties 1))
|
||
|
|
(car
|
||
|
|
(read-from-string (match-string-no-properties 2)))))))
|
||
|
|
for expected = (buffer-substring-no-properties (point)
|
||
|
|
(scan-sexps (point)
|
||
|
|
1))
|
||
|
|
collect (slime-indentation-test-form test-name bindings expected)))))
|
||
|
|
|
||
|
|
(defmacro slime-indentation-define-tests ()
|
||
|
|
`(progn
|
||
|
|
,@(slime-indentation-test-forms-for-file "slime-cl-indent-test.txt")))
|
||
|
|
|
||
|
|
(slime-indentation-define-tests)
|
||
|
|
|
||
|
|
(provide 'slime-indentation-tests)
|