First iteration

test/fixtures/clean/well-formatted.scm

@@ -0,0 +1,13 @@
+;;; A well-formatted Guile source file.
+;;; This should produce zero surface diagnostics.
+
+(define-module (test well-formatted)
+  #:export (greet add))
+
+;; Greet a person by name.
+(define (greet name)
+  (string-append "Hello, " name "!"))
+
+;; Add two numbers.
+(define (add a b)
+  (+ a b))

test/fixtures/violations/semantic.scm

@@ -0,0 +1,9 @@
+(define-module (test semantic)
+  #:use-module (ice-9 format))
+
+(define (foo x y)
+  (let ((unused 42))
+    (+ x 1)))
+
+(define (bar a)
+  (baz a))

test/fixtures/violations/surface.scm

@@ -0,0 +1,12 @@
+(define x 42)
+(define y "hello")
+(define z (+ x y))
+
+;; This line is fine
+(define (long-function-name-that-exceeds-the-default-eighty-character-limit arg1 arg2 arg3 arg4 arg5)
+  (+ arg1 arg2))
+
+
+
+;; After too many blank lines
+(define w 99)

test/run-tests.scm

@@ -0,0 +1,34 @@
+#!/usr/bin/env -S guile --no-auto-compile -s
+!#
+;;; Test runner for gulie
+
+;; Add project root to load path
+(let ((dir (dirname (dirname (current-filename)))))
+  (set! %load-path (cons dir %load-path)))
+
+(use-modules (srfi srfi-64))
+
+;; Configure test runner for CI-friendly output
+(test-runner-current
+ (let ((runner (test-runner-simple)))
+   (test-runner-on-final! runner
+     (lambda (runner)
+       (let ((pass (test-runner-pass-count runner))
+             (fail (test-runner-fail-count runner))
+             (skip (test-runner-skip-count runner)))
+         (newline)
+         (format #t "Results: ~a passed, ~a failed, ~a skipped~%"
+                 pass fail skip)
+         (when (> fail 0)
+           (exit 1)))))
+   runner))
+
+;; Load and run all test files (paths relative to project root)
+(let ((root (dirname (dirname (current-filename)))))
+  (define (load-test name)
+    (load (string-append root "/test/" name)))
+  (load-test "test-tokenizer.scm")
+  (load-test "test-cst.scm")
+  (load-test "test-rules.scm")
+  (load-test "test-suppression.scm")
+  (load-test "test-compiler.scm"))

test/test-compiler.scm

@@ -0,0 +1,56 @@
+;;; Tests for (gulie compiler) — semantic analysis pass
+
+(use-modules (srfi srfi-64)
+             (srfi srfi-1)
+             (gulie compiler)
+             (gulie diagnostic))
+
+(test-begin "compiler")
+
+(test-group "unused-variable"
+  (let ((diags (compile-and-capture-warnings
+                "test.scm"
+                "(define (foo x)\n  (let ((unused 42))\n    x))\n"
+                '())))
+    (test-assert "detects unused variable"
+      (any (lambda (d) (eq? (diagnostic-rule d) 'unused-variable))
+           diags))))
+
+(test-group "unbound-variable"
+  (let ((diags (compile-and-capture-warnings
+                "test.scm"
+                "(define (foo x)\n  (+ x unknown-thing))\n"
+                '())))
+    (test-assert "detects unbound variable"
+      (any (lambda (d) (eq? (diagnostic-rule d) 'unbound-variable))
+           diags))))
+
+(test-group "arity-mismatch"
+  (let ((diags (compile-and-capture-warnings
+                "test.scm"
+                "(define (foo x) x)\n(define (bar) (foo 1 2 3))\n"
+                '())))
+    (test-assert "detects arity mismatch"
+      (any (lambda (d) (eq? (diagnostic-rule d) 'arity-mismatch))
+           diags))))
+
+(test-group "clean-code"
+  (let ((diags (compile-and-capture-warnings
+                "test.scm"
+                "(define (foo x) (+ x 1))\n"
+                '())))
+    ;; May have unused-toplevel but no real errors
+    (test-assert "no compile errors"
+      (not (any (lambda (d) (eq? (diagnostic-severity d) 'error))
+                diags)))))
+
+(test-group "syntax-error"
+  (let ((diags (compile-and-capture-warnings
+                "test.scm"
+                "(define (foo x) (+ x"
+                '())))
+    (test-assert "catches syntax error"
+      (any (lambda (d) (eq? (diagnostic-severity d) 'error))
+           diags))))
+
+(test-end "compiler")

test/test-cst.scm

@@ -0,0 +1,59 @@
+;;; Tests for (gulie cst)
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-64)
+             (gulie tokenizer)
+             (gulie cst))
+
+(test-begin "cst")
+
+(test-group "basic-parsing"
+  (let* ((tokens (tokenize "(define x 42)" "test.scm"))
+         (cst (parse-cst tokens)))
+    (test-assert "root is cst-node" (cst-node? cst))
+    (test-assert "root has no open paren" (not (cst-node-open cst)))
+    (let ((sig (cst-significant-children cst)))
+      (test-equal "one top-level form" 1 (length sig))
+      (test-assert "top-level is cst-node" (cst-node? (car sig))))))
+
+(test-group "form-name"
+  (let* ((tokens (tokenize "(define x 42)" "test.scm"))
+         (cst (parse-cst tokens))
+         (form (car (cst-significant-children cst))))
+    (test-equal "form name is define" "define" (cst-form-name form))))
+
+(test-group "nested-forms"
+  (let* ((tokens (tokenize "(let ((x 1)) (+ x 2))" "test.scm"))
+         (cst (parse-cst tokens))
+         (form (car (cst-significant-children cst))))
+    (test-equal "form name is let" "let" (cst-form-name form))
+    ;; Should have nested cst-nodes for ((x 1)) and (+ x 2)
+    (let ((inner-nodes (filter cst-node? (cst-node-children form))))
+      (test-assert "has nested nodes" (>= (length inner-nodes) 2)))))
+
+(test-group "multiple-top-level"
+  (let* ((tokens (tokenize "(define a 1)\n(define b 2)\n(define c 3)" "test.scm"))
+         (cst (parse-cst tokens))
+         (sig (cst-significant-children cst)))
+    (test-equal "three top-level forms" 3 (length sig))))
+
+(test-group "comments-preserved"
+  (let* ((tokens (tokenize ";; header\n(define x 1)\n" "test.scm"))
+         (cst (parse-cst tokens))
+         (children (cst-node-children cst)))
+    ;; Should include the comment as a token child
+    (test-assert "has comment token"
+      (any (lambda (c)
+             (and (token? c) (eq? (token-type c) 'line-comment)))
+           children))))
+
+(test-group "prefix-handling"
+  (let* ((tokens (tokenize "'(1 2 3)" "test.scm"))
+         (cst (parse-cst tokens))
+         (children (cst-node-children cst)))
+    (test-assert "has prefix token"
+      (any (lambda (c)
+             (and (token? c) (eq? (token-type c) 'prefix)))
+           children))))
+
+(test-end "cst")

test/test-rules.scm

@@ -0,0 +1,104 @@
+;;; 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 81 #\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")

test/test-suppression.scm

@@ -0,0 +1,43 @@
+;;; Tests for (gulie suppression)
+
+(use-modules (srfi srfi-64)
+             (gulie suppression)
+             (gulie diagnostic))
+
+(test-begin "suppression")
+
+(test-group "parse-inline-suppress"
+  (let ((supps (parse-suppressions
+                "(define x 1) ; gulie:suppress trailing-whitespace\n")))
+    (test-equal "one suppression" 1 (length supps))
+    (test-equal "this-line kind" 'this-line (caddr (car supps)))))
+
+(test-group "parse-next-line-suppress"
+  (let ((supps (parse-suppressions
+                ";; gulie:suppress line-length\n(define x 1)\n")))
+    (test-equal "one suppression" 1 (length supps))
+    (test-equal "targets line 2" 2 (car (car supps)))))
+
+(test-group "parse-suppress-all"
+  (let ((supps (parse-suppressions
+                "(define x 1) ; gulie:suppress\n")))
+    (test-equal "one suppression" 1 (length supps))
+    (test-eq "all rules" #t (cadr (car supps)))))
+
+(test-group "filter-diagnostics"
+  (let ((diags (list (make-diagnostic "f.scm" 1 0 'warning 'trailing-whitespace "tw" #f)
+                     (make-diagnostic "f.scm" 2 0 'warning 'line-length "ll" #f)))
+        (supps (parse-suppressions
+                "(define x 1) ; gulie:suppress trailing-whitespace\n(define y 2)\n")))
+    (let ((filtered (filter-suppressions diags supps)))
+      (test-equal "one diagnostic filtered" 1 (length filtered))
+      (test-eq "remaining is line-length" 'line-length
+        (diagnostic-rule (car filtered))))))
+
+(test-group "region-suppression"
+  (let ((supps (parse-suppressions
+                ";; gulie:disable line-length\n(define x 1)\n(define y 2)\n;; gulie:enable line-length\n(define z 3)\n")))
+    ;; Should have region-start and region-end
+    (test-assert "has region entries" (>= (length supps) 2))))
+
+(test-end "suppression")

test/test-tokenizer.scm

@@ -0,0 +1,127 @@
+;;; Tests for (gulie tokenizer)
+
+(use-modules (srfi srfi-1)
+             (srfi srfi-64)
+             (ice-9 rdelim)
+             (gulie tokenizer))
+
+(test-begin "tokenizer")
+
+;;; Roundtrip invariant — the most critical test
+
+(test-group "roundtrip"
+  (define (roundtrip-ok? input)
+    (let* ((tokens (tokenize input "test.scm"))
+           (result (string-concatenate (map token-text tokens))))
+      (string=? input result)))
+
+  (test-assert "empty input"
+    (roundtrip-ok? ""))
+
+  (test-assert "simple expression"
+    (roundtrip-ok? "(define x 42)"))
+
+  (test-assert "nested expressions"
+    (roundtrip-ok? "(define (foo x)\n  (+ x 1))\n"))
+
+  (test-assert "string with escapes"
+    (roundtrip-ok? "(define s \"hello \\\"world\\\"\")"))
+
+  (test-assert "line comment"
+    (roundtrip-ok? ";; a comment\n(define x 1)\n"))
+
+  (test-assert "block comment"
+    (roundtrip-ok? "#| block\ncomment |#\n(define x 1)"))
+
+  (test-assert "nested block comment"
+    (roundtrip-ok? "#| outer #| inner |# outer |#"))
+
+  (test-assert "datum comment"
+    (roundtrip-ok? "#;(skip this) (keep this)"))
+
+  (test-assert "character literals"
+    (roundtrip-ok? "(list #\\space #\\newline #\\a #\\x41)"))
+
+  (test-assert "keywords"
+    (roundtrip-ok? "(foo #:bar #:baz)"))
+
+  (test-assert "booleans"
+    (roundtrip-ok? "(list #t #f #true #false)"))
+
+  (test-assert "vectors"
+    (roundtrip-ok? "#(1 2 3)"))
+
+  (test-assert "quasiquote and unquote"
+    (roundtrip-ok? "`(a ,b ,@c)"))
+
+  (test-assert "syntax shorthands"
+    (roundtrip-ok? "#'x #`x #,x #,@x"))
+
+  (test-assert "dot notation"
+    (roundtrip-ok? "(a . b)"))
+
+  (test-assert "numbers"
+    (roundtrip-ok? "(+ 1 2.5 -3 +4 1/3 #xff)"))
+
+  (test-assert "square brackets"
+    (roundtrip-ok? "(let ([x 1] [y 2]) (+ x y))"))
+
+  (test-assert "multiline with mixed content"
+    (roundtrip-ok? "(define-module (foo bar)
+  #:use-module (ice-9 format)
+  #:export (baz))
+
+;;; Section header
+
+(define (baz x)
+  ;; body comment
+  (format #t \"value: ~a\\n\" x))
+"))
+
+  ;; Real-world file roundtrip
+  (test-assert "real guile source file"
+    (let ((text (call-with-input-file "refs/guile/module/ice-9/pretty-print.scm"
+                  (lambda (port)
+                    (let lp ((acc '()))
+                      (let ((ch (read-char port)))
+                        (if (eof-object? ch)
+                            (list->string (reverse acc))
+                            (lp (cons ch acc)))))))))
+      (roundtrip-ok? text))))
+
+;;; Token type classification
+
+(test-group "token-types"
+  (define (first-token-type input)
+    (token-type (car (tokenize input "test.scm"))))
+
+  (test-eq "symbol" 'symbol (first-token-type "foo"))
+  (test-eq "number" 'number (first-token-type "42"))
+  (test-eq "string" 'string (first-token-type "\"hello\""))
+  (test-eq "open-paren" 'open-paren (first-token-type "("))
+  (test-eq "close-paren" 'close-paren (first-token-type ")"))
+  (test-eq "boolean-true" 'boolean (first-token-type "#t"))
+  (test-eq "boolean-false" 'boolean (first-token-type "#f"))
+  (test-eq "keyword" 'keyword (first-token-type "#:foo"))
+  (test-eq "character" 'character (first-token-type "#\\a"))
+  (test-eq "line-comment" 'line-comment (first-token-type ";; hi"))
+  (test-eq "prefix-quote" 'prefix (first-token-type "'"))
+  (test-eq "prefix-quasiquote" 'prefix (first-token-type "`"))
+  (test-eq "dot" 'dot (first-token-type ". "))
+  (test-eq "newline" 'newline (first-token-type "\n")))
+
+;;; Source location tracking
+
+(test-group "source-locations"
+  (let ((tokens (tokenize "(define\n  x\n  42)" "test.scm")))
+    (test-equal "first token line" 1 (token-line (car tokens)))
+    (test-equal "first token col" 0 (token-column (car tokens)))
+    ;; Find 'x' token
+    (let ((x-tok (find (lambda (t) (and (eq? (token-type t) 'symbol)
+                                        (string=? (token-text t) "x")))
+                       tokens)))
+      (test-assert "found x token" x-tok)
+      (test-equal "x on line 2" 2 (token-line x-tok))
+      (test-equal "x at column 2" 2 (token-column x-tok)))))
+
+(test-end "tokenizer")