105 lines
3.4 KiB
Scheme
105 lines
3.4 KiB
Scheme
;;; Tests for rule modules
|
|
|
|
(use-modules (srfi srfi-64)
|
|
(srfi srfi-1)
|
|
(gulie rule)
|
|
(gulie diagnostic)
|
|
(gulie rules surface)
|
|
(gulie rules comments))
|
|
|
|
(test-begin "rules")
|
|
|
|
;;; Surface rules
|
|
|
|
(test-group "trailing-whitespace"
|
|
(let ((rule (find-rule 'trailing-whitespace)))
|
|
(test-assert "rule registered" rule)
|
|
|
|
(test-equal "clean line produces no diagnostics"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 1 "(define x 42)" '()))
|
|
|
|
(let ((diags ((rule-check-proc rule) "f.scm" 1 "(define x 42) " '())))
|
|
(test-equal "trailing spaces detected" 1 (length diags))
|
|
(test-equal "correct column"
|
|
(string-length "(define x 42)")
|
|
(diagnostic-column (car diags))))
|
|
|
|
(test-equal "empty line no diagnostic"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 1 "" '()))))
|
|
|
|
(test-group "line-length"
|
|
(let ((rule (find-rule 'line-length)))
|
|
(test-assert "rule registered" rule)
|
|
|
|
(test-equal "short line ok"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 1 "(define x 42)" '()))
|
|
|
|
(let* ((long-line (make-string 119 #\x))
|
|
(diags ((rule-check-proc rule) "f.scm" 1 long-line '())))
|
|
(test-equal "long line detected" 1 (length diags)))
|
|
|
|
(let* ((config '((line-length . 120)))
|
|
(line (make-string 100 #\x))
|
|
(diags ((rule-check-proc rule) "f.scm" 1 line config)))
|
|
(test-equal "respects config" 0 (length diags)))))
|
|
|
|
(test-group "no-tabs"
|
|
(let ((rule (find-rule 'no-tabs)))
|
|
(test-assert "rule registered" rule)
|
|
|
|
(test-equal "no tabs ok"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 1 " (define x 1)" '()))
|
|
|
|
(let ((diags ((rule-check-proc rule) "f.scm" 1 "\t(define x 1)" '())))
|
|
(test-equal "tab detected" 1 (length diags)))))
|
|
|
|
(test-group "blank-lines"
|
|
(let ((rule (find-rule 'blank-lines)))
|
|
(test-assert "rule registered" rule)
|
|
|
|
(test-equal "normal blank ok"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 5 ""
|
|
'((max-blank-lines . 2) (%consecutive-blanks . 1))))
|
|
|
|
(let ((diags ((rule-check-proc rule) "f.scm" 5 ""
|
|
'((max-blank-lines . 2) (%consecutive-blanks . 3)))))
|
|
(test-equal "excessive blanks detected" 1 (length diags)))))
|
|
|
|
;;; Comment rules
|
|
|
|
(test-group "comment-semicolons"
|
|
(let ((rule (find-rule 'comment-semicolons)))
|
|
(test-assert "rule registered" rule)
|
|
|
|
(test-equal "double semicolon on own line ok"
|
|
'()
|
|
((rule-check-proc rule) "f.scm" 1 " ;; good comment" '()))
|
|
|
|
;; Single semicolon on own line
|
|
(let ((diags ((rule-check-proc rule) "f.scm" 1 " ; bad comment" '())))
|
|
(test-equal "single ; on own line flagged" 1 (length diags)))))
|
|
|
|
;;; Diagnostic formatting
|
|
|
|
(test-group "diagnostic-format"
|
|
(let ((d (make-diagnostic "foo.scm" 10 5 'warning 'test-rule "oops" #f)))
|
|
(test-equal "format matches expected"
|
|
"foo.scm:10:5: warning: test-rule: oops"
|
|
(format-diagnostic d))))
|
|
|
|
(test-group "diagnostic-sorting"
|
|
(let ((d1 (make-diagnostic "a.scm" 10 0 'warning 'r "m" #f))
|
|
(d2 (make-diagnostic "a.scm" 5 0 'warning 'r "m" #f))
|
|
(d3 (make-diagnostic "b.scm" 1 0 'warning 'r "m" #f)))
|
|
(let ((sorted (sort (list d1 d2 d3) diagnostic<?)))
|
|
(test-equal "first is a.scm:5" 5 (diagnostic-line (car sorted)))
|
|
(test-equal "second is a.scm:10" 10 (diagnostic-line (cadr sorted)))
|
|
(test-equal "third is b.scm" "b.scm" (diagnostic-file (caddr sorted))))))
|
|
|
|
(test-end "rules")
|