From 6dc717186e501f8b363693ddb1c9984e37cad714 Mon Sep 17 00:00:00 2001 From: Steffen Beyer Date: Sat, 4 Apr 2026 14:14:30 +0200 Subject: [PATCH] =?UTF-8?q?Expand=20test=20suite:=2084=20=E2=86=92=20139?= =?UTF-8?q?=20tests=20covering=20all=20bugfixes?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit New test files: - test-config.scm (15 tests): find-config directory walking, load-config with explicit/missing/auto-discovery paths, merge-configs override semantics, generate-template pretty-print output validity. - test-engine.scm (40 tests): filter-rules-by-config with enable/disable/combined, severity>=? helper, lint-file with --pass surface (no compile errors leak), severity filtering (info excluded at warning level), rule disabling via config. Fix mode tests: trailing-whitespace fix, comment-semicolons fix (single ; → ;;), no-tabs fix (8-space expansion), tab-stop alignment, blank-lines deletion, fix composition (tabs + trailing whitespace on same line), idempotency (second pass changes nothing), multi-pass convergence (3-way conflict: tabs + trailing + comment on same line converges in 2 passes). Compile-error formatting: no raw ~S/~A format specifiers in error messages, module name present in output. Integration: lint-files with %fix mode applies fixes and returns 0 unfixed count. --- test/run-tests.scm | 4 +- test/test-config.scm | 99 ++++++++++++++++ test/test-engine.scm | 273 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 375 insertions(+), 1 deletion(-) create mode 100644 test/test-config.scm create mode 100644 test/test-engine.scm diff --git a/test/run-tests.scm b/test/run-tests.scm index cc0efba..e1bf5bf 100644 --- a/test/run-tests.scm +++ b/test/run-tests.scm @@ -31,4 +31,6 @@ (load-test "test-cst.scm") (load-test "test-rules.scm") (load-test "test-suppression.scm") - (load-test "test-compiler.scm")) + (load-test "test-compiler.scm") + (load-test "test-config.scm") + (load-test "test-engine.scm")) diff --git a/test/test-config.scm b/test/test-config.scm new file mode 100644 index 0000000..3bc3f07 --- /dev/null +++ b/test/test-config.scm @@ -0,0 +1,99 @@ +;;; Tests for (gulie config) — config loading, auto-discovery, template + +(use-modules (srfi srfi-64) + (ice-9 textual-ports) + (gulie config)) + +(test-begin "config") + +;;; find-config — walk up directories + +(test-group "find-config" + ;; Create a temp directory tree with a config in the grandparent + (let* ((tmp (tmpnam)) + (child (string-append tmp "/a/b/c"))) + (system* "mkdir" "-p" child) + (call-with-output-file (string-append tmp "/.gulie.sexp") + (lambda (p) (display "((line-length . 42))" p))) + + (test-equal "finds config in ancestor" + (string-append tmp "/.gulie.sexp") + (find-config child)) + + (test-equal "finds config in same dir" + (string-append tmp "/.gulie.sexp") + (find-config tmp)) + + ;; No config above /tmp + (let ((no-config (string-append tmp "/a/b"))) + ;; Config is in tmp, so searching from tmp/a/b should still find it + (test-assert "finds config from intermediate dir" + (string? (find-config no-config)))) + + ;; Clean up + (system* "rm" "-rf" tmp))) + +(test-group "find-config-returns-false" + ;; A directory guaranteed to have no .gulie.sexp above it + (let ((tmp (tmpnam))) + (system* "mkdir" "-p" tmp) + (test-equal "returns #f when no config found" + #f + (find-config tmp)) + (system* "rm" "-rf" tmp))) + +;;; load-config — explicit path and auto-discovery + +(test-group "load-config-explicit-path" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "((line-length . 99) (indent . 4))" p))) + (let ((cfg (load-config tmp))) + (test-equal "reads line-length" 99 (assq-ref cfg 'line-length)) + (test-equal "reads indent" 4 (assq-ref cfg 'indent))) + (delete-file tmp))) + +(test-group "load-config-missing-path" + (test-equal "missing explicit path returns empty" + '() + (load-config "/nonexistent/path/.gulie.sexp"))) + +(test-group "load-config-auto-discovery" + ;; When path is #f, load-config should auto-discover + ;; We can't easily test this without controlling CWD, so just + ;; verify it doesn't crash with #f + (test-assert "does not crash with #f path" + (list? (load-config #f)))) + +;;; merge-configs + +(test-group "merge-configs" + (let ((base '((line-length . 80) (indent . 2) (enable))) + (override '((line-length . 120) (enable foo bar)))) + (let ((merged (merge-configs base override))) + (test-equal "override scalar" 120 (assq-ref merged 'line-length)) + (test-equal "base value preserved" 2 (assq-ref merged 'indent)) + (test-equal "override list" '(foo bar) (assq-ref merged 'enable))))) + +;;; generate-template + +(test-group "generate-template" + (let* ((output (call-with-output-string generate-template)) + (lines (string-split output #\newline))) + (test-assert "starts with comment" + (string-prefix? ";;;" (car lines))) + (test-assert "contains multiple lines (pretty-printed)" + (> (length lines) 5)) + ;; Should be valid sexp — skip comment lines, parse the rest + (let ((sexp-text (call-with-output-string + (lambda (p) + (for-each (lambda (line) + (unless (string-prefix? ";;;" line) + (display line p) + (newline p))) + lines))))) + (let ((data (call-with-input-string sexp-text read))) + (test-assert "output is valid alist" (list? data)) + (test-assert "contains line-length" (assq 'line-length data)))))) + +(test-end "config") diff --git a/test/test-engine.scm b/test/test-engine.scm new file mode 100644 index 0000000..cd9ed6b --- /dev/null +++ b/test/test-engine.scm @@ -0,0 +1,273 @@ +;;; Tests for (gulie engine) — rule filtering, pass control, severity, fix mode + +(use-modules (srfi srfi-64) + (srfi srfi-1) + (ice-9 textual-ports) + (gulie engine) + (gulie rule) + (gulie config) + (gulie diagnostic) + (gulie rules surface) + (gulie rules comments)) + +(test-begin "engine") + +;;; filter-rules-by-config + +(test-group "filter-rules-by-config" + (let ((all-rules (all-rules))) + ;; With empty enable/disable, all rules pass through + (test-equal "empty config keeps all rules" + (length all-rules) + (length ((@@ (gulie engine) filter-rules-by-config) + all-rules '()))) + + ;; Enable only one rule + (let ((filtered ((@@ (gulie engine) filter-rules-by-config) + all-rules '((enable trailing-whitespace))))) + (test-equal "enable filters to one" 1 (length filtered)) + (test-eq "correct rule kept" 'trailing-whitespace + (rule-name (car filtered)))) + + ;; Disable one rule + (let* ((before (length all-rules)) + (filtered ((@@ (gulie engine) filter-rules-by-config) + all-rules '((disable trailing-whitespace))))) + (test-equal "disable removes one" (1- before) (length filtered)) + (test-assert "disabled rule absent" + (not (find (lambda (r) (eq? (rule-name r) 'trailing-whitespace)) + filtered)))) + + ;; Enable + disable + (let ((filtered ((@@ (gulie engine) filter-rules-by-config) + all-rules '((enable trailing-whitespace no-tabs) + (disable no-tabs))))) + (test-equal "enable then disable" 1 (length filtered)) + (test-eq "only non-disabled remains" 'trailing-whitespace + (rule-name (car filtered)))))) + +;;; severity filtering + +(test-group "severity-helpers" + (test-assert "error >= warning" + ((@@ (gulie engine) severity>=?) 'error 'warning)) + (test-assert "warning >= warning" + ((@@ (gulie engine) severity>=?) 'warning 'warning)) + (test-assert "warning >= info" + ((@@ (gulie engine) severity>=?) 'warning 'info)) + (test-assert "info not >= warning" + (not ((@@ (gulie engine) severity>=?) 'info 'warning)))) + +;;; lint-file with pass control + +(test-group "lint-file-pass-surface" + ;; Create a temp file with issues + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 42) \n" p))) ;; trailing whitespace + (let ((diags (lint-file tmp '((%pass . surface))))) + (test-assert "finds trailing whitespace" + (any (lambda (d) (eq? (diagnostic-rule d) 'trailing-whitespace)) + diags)) + ;; Should NOT have compile-error since semantic pass is skipped + (test-assert "no compile errors in surface mode" + (not (any (lambda (d) (eq? (diagnostic-rule d) 'compile-error)) + diags)))) + (delete-file tmp))) + +(test-group "lint-file-severity-filter" + (let ((tmp (tmpnam))) + ;; Single ; on own line (info) + trailing whitespace (warning) + (call-with-output-file tmp + (lambda (p) (display " ; comment \n" p))) + (let ((all-diags (lint-file tmp '((%pass . surface)))) + (warn-diags (lint-file tmp '((%pass . surface) + (%min-severity . warning))))) + (test-assert "all includes info" + (any (lambda (d) (eq? (diagnostic-severity d) 'info)) all-diags)) + (test-assert "warning filter excludes info" + (not (any (lambda (d) (eq? (diagnostic-severity d) 'info)) + warn-diags))) + (test-assert "warning filter keeps warnings" + (any (lambda (d) (eq? (diagnostic-severity d) 'warning)) + warn-diags))) + (delete-file tmp))) + +(test-group "lint-file-disable-rule" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 42) \n" p))) + (let ((diags (lint-file tmp '((%pass . surface) + (disable trailing-whitespace))))) + (test-assert "disabled rule produces no diagnostics" + (not (any (lambda (d) (eq? (diagnostic-rule d) 'trailing-whitespace)) + diags)))) + (delete-file tmp))) + +;;; Fix mode + +(test-group "fix-trailing-whitespace" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 42) \n(define y 99)\n" p))) + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "trailing whitespace removed" + (not (string-contains result "42) "))) + (test-assert "content preserved" + (string-contains result "(define x 42)"))) + (delete-file tmp))) + +(test-group "fix-comment-semicolons" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display " ; bad comment\n ;; good comment\n" p))) + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "single ; fixed to ;;" + (string-contains result " ;; bad comment")) + (test-assert "double ;; preserved" + (string-contains result " ;; good comment"))) + (delete-file tmp))) + +(test-group "fix-no-tabs" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "\t(define x 1)\n" p))) + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "tab replaced with spaces" + (not (string-index result #\tab))) + (test-assert "8-space expansion" + (string-prefix? " (define x 1)" result))) + (delete-file tmp))) + +(test-group "fix-tabs-with-alignment" + ;; Tab at column 6 should expand to 2 spaces (next tab stop at 8) + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "abcdef\tg\n" p))) + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "tab expanded" + (not (string-index result #\tab))) + (test-assert "correct expansion" + (string-contains result "abcdef g"))) + (delete-file tmp))) + +(test-group "fix-blank-lines" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 1)\n\n\n\n\n(define y 2)\n" p))) + (let ((diags (lint-file tmp '((%pass . surface) + (max-blank-lines . 2))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let* ((result (call-with-input-file tmp get-string-all)) + (lines (string-split result #\newline))) + ;; Should have: (define x 1), 2 blanks, (define y 2) = 5 lines + ;; Original: (define x 1), 4 blanks, (define y 2) = 7 lines (incl final) + (test-assert "excess blank lines removed" + (<= (length lines) 5))) + (delete-file tmp))) + +(test-group "fix-composition-tabs-and-trailing" + ;; Line with BOTH tabs and trailing whitespace + ;; Should fix both in a single pass + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "\t(define x 1) \n" p))) + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "no tabs remain" + (not (string-index result #\tab))) + (test-assert "no trailing whitespace" + (not (string-suffix? " " (car (string-split result #\newline))))) + (test-assert "content preserved" + (string-contains result "(define x 1)"))) + (delete-file tmp))) + +(test-group "fix-idempotent" + ;; Running fix twice should produce the same result. + ;; Note: when multiple fix types target the same line (tabs + trailing + ;; whitespace + comment semicolons), convergence may take 2 passes. + ;; This test uses a case that converges in one pass. + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 1) \n\n\n\n\n(define y 2)\n" p))) + ;; First fix + (let ((diags (lint-file tmp '((%pass . surface) + (max-blank-lines . 1))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((after-first (call-with-input-file tmp get-string-all))) + ;; Second fix — should change nothing + (let ((diags (lint-file tmp '((%pass . surface) + (max-blank-lines . 1))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((after-second (call-with-input-file tmp get-string-all))) + (test-equal "second fix is idempotent" after-first after-second))) + (delete-file tmp))) + +(test-group "fix-multi-pass-convergence" + ;; Line with tabs + trailing whitespace + single semicolon: + ;; may need 2 fix passes since 3 fixes compete for the same line. + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "\t; comment \n" p))) + ;; Pass 1 + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + ;; Pass 2 + (let ((diags (lint-file tmp '((%pass . surface))))) + ((@@ (gulie engine) apply-fixes-to-file) tmp diags)) + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "tabs removed after 2 passes" + (not (string-index result #\tab))) + (test-assert "trailing whitespace removed" + (not (string-contains result " \n"))) + (test-assert "semicolon fixed to ;;" + (string-contains result ";; comment"))) + (delete-file tmp))) + +;;; Compile-error message formatting + +(test-group "compile-error-formatting" + ;; Compile a file that references a non-existent module + (let ((diags ((@@ (gulie compiler) compile-and-capture-warnings) + "test.scm" + "(use-modules (nonexistent module))\n(define x 1)\n" + '()))) + (let ((errors (filter (lambda (d) (eq? (diagnostic-severity d) 'error)) + diags))) + (test-assert "has compile error" (not (null? errors))) + (let ((msg (diagnostic-message (car errors)))) + (test-assert "no raw format specifiers in message" + (not (string-contains msg "~S"))) + (test-assert "no raw format specifiers ~A" + (not (string-contains msg "~A"))) + (test-assert "contains module name" + (string-contains msg "nonexistent")))))) + +;;; Integration: lint-files with fix mode + +(test-group "lint-files-fix-mode" + (let ((tmp (tmpnam))) + (call-with-output-file tmp + (lambda (p) (display "(define x 42) \n ; comment\n" p))) + (let ((count (lint-files (list tmp) + '((%pass . surface) (%fix . #t))))) + ;; After fix, only unfixable diagnostics should be counted + (test-equal "no unfixable issues" 0 count)) + ;; Verify file was actually modified + (let ((result (call-with-input-file tmp get-string-all))) + (test-assert "trailing whitespace fixed" + (not (string-contains result "42) "))) + (test-assert "comment fixed" + (string-contains result ";; comment"))) + (delete-file tmp))) + +(test-end "engine")