Improve diagnostics and Guile corpus handling

gulie/cli.scm

@@ -121,6 +121,13 @@
                                      (string->symbol cli-severity))
                                config)
                          config))
+             ;; Wire up --output
+             (cli-output (option-ref options 'output #f))
+             (config (if cli-output
+                         (cons (cons '%output
+                                     (string->symbol cli-output))
+                               config)
+                         config))
              (paths (if (null? rest) (list ".") rest))
              (ignore-pats (config-ignore-patterns config))
              (files (discover-scheme-files paths ignore-pats)))

gulie/compiler.scm

@@ -17,21 +17,30 @@
 (define *warning-re*
   (make-regexp "^;;; ([^:]+):([0-9]+):([0-9]+): warning: (.+)$"))
 
+(define (same-file? a b)
+  (or (string=? a b)
+      (let ((ca (false-if-exception (canonicalize-path a)))
+            (cb (false-if-exception (canonicalize-path b))))
+        (and ca cb (string=? ca cb)))))
+
 (define (parse-warning-line text file)
-  "Parse a warning line from Guile's compiler output into a <diagnostic>."
+  "Parse a warning line from Guile's compiler output into a <diagnostic>.
+Filters out warnings attributed to files other than FILE."
   (let ((m (regexp-exec *warning-re* text)))
     (if m
-        (let ((wfile (match:substring m 1))
+        (let* ((wfile (match:substring m 1))
-              (wline (string->number (match:substring m 2)))
+               (wline (string->number (match:substring m 2)))
-              (wcol  (string->number (match:substring m 3)))
+               (wcol  (string->number (match:substring m 3)))
-              (wmsg  (match:substring m 4)))
+               (wmsg  (match:substring m 4))
-          (make-diagnostic
+               (resolved-file (if (string=? wfile "<unknown-location>") file wfile)))
-           (if (string=? wfile "<unknown-location>") file wfile)
+          (and (same-file? resolved-file file)
-           wline wcol
+               (make-diagnostic
-           'warning
+                resolved-file
-           (classify-warning wmsg)
+                wline wcol
-           wmsg
+                'warning
-           #f))
+                (classify-warning wmsg)
+                wmsg
+                #f)))
         #f)))
 
 (define (classify-warning msg)
@@ -51,6 +60,80 @@
    ((string-contains msg "cannot be meaningfully")    'bad-case-datum)
    (else                                              'compiler-warning)))
 
+(define (format-exception-message key args)
+  "Format compiler exception KEY and ARGS into a readable string."
+  (call-with-output-string
+   (lambda (p)
+     (display key p)
+     (display ": " p)
+     (catch #t
+       (lambda ()
+         (match args
+           ((subr fmt fmt-args . _)
+            (when subr
+              (display subr p)
+              (display ": " p))
+            (if fmt-args
+                (apply format p fmt (if (list? fmt-args)
+                                        fmt-args
+                                        (list fmt-args)))
+                (display fmt p)))
+           (_ (for-each (lambda (a)
+                          (display a p) (display " " p))
+                        args))))
+       (lambda _
+         ;; Fallback: just display the raw args
+         (for-each (lambda (a)
+                     (display a p) (display " " p))
+                   args))))))
+
+(define (source-location-ref loc key . default)
+  (let ((pair (and (list? loc) (assq key loc))))
+    (if pair
+        (cdr pair)
+        (if (null? default) #f (car default)))))
+
+(define (find-source-location args)
+  (find (lambda (arg)
+          (and (list? arg)
+               (every pair? arg)
+               (or (assq 'line arg)
+                   (assq 'column arg)
+                   (assq 'filename arg))))
+        args))
+
+(define (extract-location-from-args args file)
+  (let ((loc (find-source-location args)))
+    (and loc
+         (let* ((loc-file (or (source-location-ref loc 'filename #f) file))
+                (loc-line (source-location-ref loc 'line #f))
+                (loc-col  (source-location-ref loc 'column #f)))
+           (and (same-file? loc-file file)
+                (list loc-file
+                      (if (number? loc-line) (1+ loc-line) 1)
+                      (if (number? loc-col) (max 0 loc-col) 0)))))))
+
+(define (extract-location-from-message msg file)
+  (let* ((anchor (string-append file ":"))
+         (pos (string-contains msg anchor)))
+    (and pos
+         (let* ((located (substring msg pos))
+                (m (regexp-exec (make-regexp "^([^:]+):([0-9]+):([0-9]+): (.+)$")
+                                located)))
+           (and m
+                (let* ((loc-file (match:substring m 1))
+                       (resolved-file (if (string=? loc-file "<unknown-location>")
+                                          file
+                                          loc-file))
+                       (loc-line (string->number (match:substring m 2)))
+                       (loc-col-1 (string->number (match:substring m 3)))
+                       (clean-msg (match:substring m 4)))
+                  (and (same-file? resolved-file file)
+                       (list resolved-file
+                             loc-line
+                             (max 0 (1- loc-col-1))
+                             clean-msg))))))))
+
 (define (compile-and-capture-warnings file text config)
   "Compile TEXT (as if from FILE) and capture all compiler warnings.
 Returns a list of <diagnostic> records."
@@ -68,34 +151,19 @@ Returns a list of <diagnostic> records."
                               #:warning-level 3
                               #:env (make-fresh-user-module))))
         (lambda (key . args)
-          ;; Format the error message properly.
+          (let* ((raw-msg (format-exception-message key args))
-          ;; Guile exceptions typically have args: (subr fmt fmt-args data)
+                 (located-msg (extract-location-from-message raw-msg file))
-          (let ((msg (call-with-output-string
+                 (located-args (extract-location-from-args args file))
-                       (lambda (p)
+                 (location (or located-args located-msg))
-                         (display key p)
+                 (diag-file (if location (car location) file))
-                         (display ": " p)
+                 (diag-line (if location (cadr location) 1))
-                         (catch #t
+                 (diag-col (if location (caddr location) 0))
-                           (lambda ()
+                 (msg (if (and located-msg (= (length located-msg) 4))
-                             (match args
+                          (list-ref located-msg 3)
-                               ((subr fmt fmt-args . _)
+                          raw-msg)))
-                                (when subr
-                                  (display subr p)
-                                  (display ": " p))
-                                (if fmt-args
-                                    (apply format p fmt (if (list? fmt-args)
-                                                           fmt-args
-                                                           (list fmt-args)))
-                                    (display fmt p)))
-                               (_ (for-each (lambda (a)
-                                              (display a p) (display " " p))
-                                            args))))
-                           (lambda _
-                             ;; Fallback: just display the raw args
-                             (for-each (lambda (a)
-                                         (display a p) (display " " p))
-                                       args)))))))
             (set! diagnostics
-              (cons (make-diagnostic file 1 0 'error 'compile-error msg #f)
+              (cons (make-diagnostic diag-file diag-line diag-col
+                                     'error 'compile-error msg #f)
                     diagnostics))))))
     ;; Parse captured warnings
     (let* ((output (get-output-string warning-output))

gulie/diagnostic.scm

@@ -83,9 +83,116 @@
           (diagnostic-rule diag)
           (diagnostic-message diag)))
 
-(define (format-diagnostics diags port)
+(define (normalize-output-format output-format)
-  "Write all diagnostics to PORT, sorted by location."
+  (cond
-  (for-each (lambda (d)
+   ((or (not output-format)
-              (display (format-diagnostic d) port)
+        (eq? output-format 'standard)
-              (newline port))
+        (and (string? output-format)
-            (sort diags diagnostic<?)))
+             (string=? output-format "standard")))
+    'standard)
+   ((or (eq? output-format 'compact)
+        (and (string? output-format)
+             (string=? output-format "compact")))
+    'compact)
+   ((or (eq? output-format 'json)
+        (and (string? output-format)
+             (string=? output-format "json")))
+    'json)
+   (else 'standard)))
+
+(define (format-diagnostic-compact diag)
+  (format #f "~a:~a:~a: ~a: ~a"
+          (diagnostic-file diag)
+          (diagnostic-line diag)
+          (diagnostic-column diag)
+          (diagnostic-rule diag)
+          (diagnostic-message diag)))
+
+(define (write-json-string port str)
+  (display #\" port)
+  (string-for-each
+   (lambda (ch)
+     (cond
+      ((char=? ch #\\) (display "\\\\" port))
+      ((char=? ch #\") (display "\\\"" port))
+      ((char=? ch #\newline) (display "\\n" port))
+      ((char=? ch #\return) (display "\\r" port))
+      ((char=? ch #\tab) (display "\\t" port))
+      ((char=? ch #\page) (display "\\f" port))
+      ((char=? ch #\backspace) (display "\\b" port))
+      ((< (char->integer ch) 32)
+       (format port "\\u~4,'0x" (char->integer ch)))
+      (else (display ch port))))
+   str)
+  (display #\" port))
+
+(define (write-json-fix port fix)
+  (if fix
+      (begin
+        (display "{" port)
+        (display "\"type\":" port)
+        (write-json-string port (symbol->string (fix-type fix)))
+        (display ",\"line\":" port)
+        (display (fix-line fix) port)
+        (display ",\"column\":" port)
+        (display (fix-column fix) port)
+        (display ",\"endLine\":" port)
+        (display (fix-end-line fix) port)
+        (display ",\"endColumn\":" port)
+        (display (fix-end-column fix) port)
+        (display ",\"replacement\":" port)
+        (if (fix-replacement fix)
+            (write-json-string port (fix-replacement fix))
+            (display "null" port))
+        (display "}" port))
+      (display "null" port)))
+
+(define (write-json-diagnostic port diag)
+  (display "{" port)
+  (display "\"file\":" port)
+  (write-json-string port (diagnostic-file diag))
+  (display ",\"line\":" port)
+  (display (diagnostic-line diag) port)
+  (display ",\"column\":" port)
+  (display (diagnostic-column diag) port)
+  (display ",\"severity\":" port)
+  (write-json-string port (severity->string (diagnostic-severity diag)))
+  (display ",\"rule\":" port)
+  (write-json-string port (symbol->string (diagnostic-rule diag)))
+  (display ",\"message\":" port)
+  (write-json-string port (diagnostic-message diag))
+  (display ",\"fix\":" port)
+  (write-json-fix port (diagnostic-fix diag))
+  (display "}" port))
+
+(define (format-diagnostics diags port . maybe-format)
+  "Write all diagnostics to PORT.
+OUTPUT-FORMAT may be standard, compact, or json."
+  (let* ((output-format (normalize-output-format
+                         (if (null? maybe-format)
+                             'standard
+                             (car maybe-format))))
+         (sorted (sort diags diagnostic<?)))
+    (case output-format
+      ((json)
+       (display "[" port)
+       (let lp ((remaining sorted) (first? #t))
+         (when (pair? remaining)
+           (if first?
+               (write-json-diagnostic port (car remaining))
+               (begin
+                 (display "," port)
+                 (write-json-diagnostic port (car remaining))))
+           (lp (cdr remaining) #f)))
+       (display "]" port)
+       (newline port))
+      ((compact)
+       (for-each (lambda (d)
+                   (display (format-diagnostic-compact d) port)
+                   (newline port))
+                 sorted))
+      (else
+       (for-each (lambda (d)
+                   (display (format-diagnostic d) port)
+                   (newline port))
+                 sorted)))))

gulie/engine.scm

@@ -30,6 +30,17 @@
 (define (severity>=? sev min-sev)
   "Is SEV at least as severe as MIN-SEV?"
   (>= (severity-rank sev) (severity-rank min-sev)))
+(define (rule-family-name rule-name)
+  "Map internal fixup rule names back to their user-facing family name."
+  (let* ((name (symbol->string rule-name))
+         (suffix "-fixup")
+         (suffix-len (string-length suffix))
+         (name-len (string-length name)))
+    (if (and (>= name-len suffix-len)
+             (string=? (substring name (- name-len suffix-len)) suffix))
+        (string->symbol (substring name 0 (- name-len suffix-len)))
+        rule-name)))
+
 (define (filter-rules-by-config rules config)
   "Filter RULES according to enable/disable lists in CONFIG.
 If enable is non-empty, only those rules are kept.
@@ -46,6 +57,46 @@ Then any rules in disable are removed."
           (filter (lambda (r)
                     (not (memq (rule-name r) disabled)))
                   rules)))))
+
+(define (filter-diagnostics-by-config diagnostics config)
+  "Filter DIAGNOSTICS by config enable/disable lists.
+This applies to semantic diagnostics as well as surface diagnostics."
+  (let ((enabled  (or (assq-ref config 'enable) '()))
+        (disabled (or (assq-ref config 'disable) '())))
+    (let ((diagnostics (if (null? enabled)
+                           diagnostics
+                           (filter (lambda (d)
+                                     (memq (rule-family-name (diagnostic-rule d))
+                                           enabled))
+                                   diagnostics))))
+      (if (null? disabled)
+          diagnostics
+          (filter (lambda (d)
+                    (not (memq (rule-family-name (diagnostic-rule d))
+                               disabled)))
+                  diagnostics)))))
+
+(define (page-break-line? line-text)
+  "Is LINE-TEXT a form-feed page separator line?"
+  (and (> (string-length line-text) 0)
+       (let lp ((i 0) (saw-page? #f))
+         (if (= i (string-length line-text))
+             saw-page?
+             (let ((ch (string-ref line-text i)))
+               (cond
+                ((char=? ch #\page)
+                 (lp (1+ i) #t))
+                ((or (char=? ch #\space)
+                     (char=? ch #\tab))
+                 (lp (1+ i) saw-page?))
+                (else #f)))))))
+
+(define (surface-blank-line? line-text)
+  "Should LINE-TEXT count as a blank line for surface rules?"
+  (and (or (string-null? line-text)
+           (string-every char-whitespace? line-text))
+       (not (page-break-line? line-text))))
+
 (define (run-line-rules file lines config)
   "Run all line-type rules against LINES. Returns list of diagnostics."
   (let ((line-rules (filter-rules-by-config (rules-of-type 'line) config))
@@ -55,8 +106,7 @@ Then any rules in disable are removed."
       (let lp ((remaining lines) (line-num 1))
         (when (not (null? remaining))
           (let* ((line-text (car remaining))
-                 (is-blank (or (string-null? line-text)
+                 (is-blank (surface-blank-line? line-text)))
-                               (string-every char-whitespace? line-text))))
             (set! consecutive-blanks
               (if is-blank (1+ consecutive-blanks) 0))
             (let ((augmented-config
@@ -118,6 +168,9 @@ and '%min-severity with value 'error, 'warning, or 'info (default)."
     ;; Filter suppressions
     (let ((suppressions (parse-suppressions text)))
       (set! diagnostics (filter-suppressions diagnostics suppressions)))
+    ;; Filter by enable/disable config at the diagnostic level too,
+    ;; so semantic diagnostics respect rule selection.
+    (set! diagnostics (filter-diagnostics-by-config diagnostics config))
     ;; Filter by minimum severity
     (when (not (eq? min-severity 'info))
       (set! diagnostics
@@ -222,17 +275,27 @@ with the greatest edit distance from the original is chosen."
                           (set! first #f)))
                       (lp (1+ i))))))))
           count))))
+(define (parallel-safe-pass? pass)
+  "Can PASS be linted safely in parallel?
+The semantic pass uses compiler state and warning ports that are not
+currently thread-safe, so only surface-only runs use parallel workers."
+  (eq? pass 'surface))
+
 (define (lint-files files config)
-  "Lint multiple FILES in parallel. Returns total diagnostic count.
+  "Lint multiple FILES. Returns total diagnostic count.
-Uses n-par-map to distribute work across threads, then outputs
+Surface-only runs use n-par-map; semantic runs are processed sequentially
-diagnostics sequentially to maintain deterministic file order.
+for deterministic compiler diagnostics.
 When '%fix is #t in config, apply auto-fixes and report unfixed."
-  (let* ((ncpus (max 1 (total-processor-count)))
+  (let* ((pass (or (assq-ref config '%pass) 'all))
+         (output-format (or (assq-ref config '%output) 'standard))
          (fix-mode? (assq-ref config '%fix))
-         (results (n-par-map ncpus
+         (lint-one (lambda (file)
-                             (lambda (file)
+                     (cons file (lint-file file config))))
-                               (cons file (lint-file file config)))
+         (results (if (parallel-safe-pass? pass)
-                             files))
+                      (let ((ncpus (max 1 (total-processor-count))))
+                        (n-par-map ncpus lint-one files))
+                      (map lint-one files)))
+         (reported-diags '())
          (total-diags 0)
          (total-fixed 0))
     (for-each
@@ -245,12 +308,13 @@ When '%fix is #t in config, apply auto-fixes and report unfixed."
                     (unfixed (filter (lambda (d) (not (diagnostic-fix d))) diags)))
                (set! total-fixed (+ total-fixed fixed-count))
                (set! total-diags (+ total-diags (length unfixed)))
-               (format-diagnostics unfixed (current-output-port)))
+               (set! reported-diags (append unfixed reported-diags)))
              ;; Normal mode: report everything
              (begin
                (set! total-diags (+ total-diags (length diags)))
-               (format-diagnostics diags (current-output-port))))))
+               (set! reported-diags (append diags reported-diags))))))
      results)
+    (format-diagnostics reported-diags (current-output-port) output-format)
     (when (and fix-mode? (> total-fixed 0))
       (format (current-error-port) "Fixed ~a issue~a.~%"
               total-fixed (if (= total-fixed 1) "" "s")))

gulie/rules/surface.scm

@@ -7,6 +7,99 @@
   #:use-module (gulie rule)
   #:use-module (gulie diagnostic))
 
+(define (page-break-line? line-text)
+  "Is LINE-TEXT a form-feed page separator line?"
+  (and (> (string-length line-text) 0)
+       (let lp ((i 0) (saw-page? #f))
+         (if (= i (string-length line-text))
+             saw-page?
+             (let ((ch (string-ref line-text i)))
+               (cond
+                ((char=? ch #\page)
+                 (lp (1+ i) #t))
+                ((or (char=? ch #\space)
+                     (char=? ch #\tab))
+                 (lp (1+ i) saw-page?))
+                (else #f)))))))
+
+(define (surface-blank-line? line-text)
+  "Should LINE-TEXT count as a blank line for surface rules?"
+  (and (or (string-null? line-text)
+           (string-every char-whitespace? line-text))
+       (not (page-break-line? line-text))))
+
+(define (advance-column col ch)
+  (if (char=? ch #\tab)
+      (+ col (- 8 (modulo col 8)))
+      (1+ col)))
+
+(define (find-tab-in-code line-text)
+  "Return the column of the first tab outside strings and comments, or #f."
+  (let ((len (string-length line-text)))
+    (let lp ((i 0) (in-string? #f) (escaped? #f))
+      (if (= i len)
+          #f
+          (let ((ch (string-ref line-text i)))
+            (cond
+             (in-string?
+              (cond
+               (escaped?
+                (lp (1+ i) #t #f))
+               ((char=? ch #\\)
+                (lp (1+ i) #t #t))
+               ((char=? ch #\")
+                (lp (1+ i) #f #f))
+               (else
+                (lp (1+ i) #t #f))))
+             ((char=? ch #\;)
+              #f)
+             ((char=? ch #\")
+              (lp (1+ i) #t #f))
+             ((char=? ch #\tab)
+              i)
+             (else
+              (lp (1+ i) #f #f))))))))
+
+(define (expand-tabs-in-code line-text)
+  "Expand tabs outside strings and comments, preserving other tabs as-is."
+  (let ((len (string-length line-text)))
+    (let lp ((i 0) (col 0) (in-string? #f) (escaped? #f)
+             (in-comment? #f) (acc '()))
+      (if (= i len)
+          (list->string (reverse acc))
+          (let ((ch (string-ref line-text i)))
+            (cond
+             (in-comment?
+              (lp (1+ i) (advance-column col ch) #f #f #t
+                  (cons ch acc)))
+             (in-string?
+              (cond
+               (escaped?
+                (lp (1+ i) (advance-column col ch) #t #f #f
+                    (cons ch acc)))
+               ((char=? ch #\\)
+                (lp (1+ i) (advance-column col ch) #t #t #f
+                    (cons ch acc)))
+               ((char=? ch #\")
+                (lp (1+ i) (advance-column col ch) #f #f #f
+                    (cons ch acc)))
+               (else
+                (lp (1+ i) (advance-column col ch) #t #f #f
+                    (cons ch acc)))))
+             ((char=? ch #\;)
+              (lp (1+ i) (advance-column col ch) #f #f #t
+                  (cons ch acc)))
+             ((char=? ch #\")
+              (lp (1+ i) (advance-column col ch) #t #f #f
+                  (cons ch acc)))
+             ((char=? ch #\tab)
+              (let ((spaces (- 8 (modulo col 8))))
+                (lp (1+ i) (+ col spaces) #f #f #f
+                    (append (make-list spaces #\space) acc))))
+             (else
+              (lp (1+ i) (advance-column col ch) #f #f #f
+                  (cons ch acc)))))))))
+
 ;;; trailing-whitespace — trailing spaces or tabs at end of line
 
 (register-rule!
@@ -15,18 +108,20 @@
   "Line has trailing whitespace"
   'warning 'format 'line
   (lambda (file line-num line-text config)
-    (let ((trimmed (string-trim-right line-text)))
+    (if (page-break-line? line-text)
-      (if (and (not (string=? line-text trimmed))
+        '()
-               (> (string-length line-text) 0))
+        (let ((trimmed (string-trim-right line-text)))
-          (list (make-diagnostic
+          (if (and (not (string=? line-text trimmed))
-                 file line-num
+                   (> (string-length line-text) 0))
-                 (string-length trimmed)
+              (list (make-diagnostic
-                 'warning 'trailing-whitespace
+                     file line-num
-                 "trailing whitespace"
+                     (string-length trimmed)
-                 (make-fix 'replace-line line-num 0
+                     'warning 'trailing-whitespace
-                           line-num (string-length line-text)
+                     "trailing whitespace"
-                           trimmed)))
+                     (make-fix 'replace-line line-num 0
-          '())))
+                               line-num (string-length line-text)
+                               trimmed)))
+              '()))))
   #f))
 
 ;;; line-length — line exceeds maximum width
@@ -59,20 +154,9 @@
   "Tab character found in source"
   'warning 'format 'line
   (lambda (file line-num line-text config)
-    (let ((pos (string-index line-text #\tab)))
+    (let ((pos (find-tab-in-code line-text)))
       (if pos
-          (let ((fixed (string-trim-right
+          (let ((fixed (string-trim-right (expand-tabs-in-code line-text))))
-                        (let expand ((s line-text) (col 0) (i 0) (acc '()))
-                          (cond
-                           ((= i (string-length s))
-                            (list->string (reverse acc)))
-                           ((char=? (string-ref s i) #\tab)
-                            (let ((spaces (- 8 (modulo col 8))))
-                              (expand s (+ col spaces) (1+ i)
-                                      (append (make-list spaces #\space) acc))))
-                           (else
-                            (expand s (1+ col) (1+ i)
-                                    (cons (string-ref s i) acc))))))))
             (list (make-diagnostic
                    file line-num pos
                    'warning 'no-tabs
@@ -98,7 +182,7 @@
           (consecutive (or (assq-ref config '%consecutive-blanks) 0)))
       (cond
        ;; First excess blank line: emit warning + delete fix
-       ((and (string-every char-whitespace? line-text)
+       ((and (surface-blank-line? line-text)
              (= consecutive (1+ max-blanks)))
         (list (make-diagnostic
                file (- line-num max-blanks) 0
@@ -106,7 +190,7 @@
                (format #f "more than ~a consecutive blank lines" max-blanks)
                (make-fix 'delete-line line-num 0 line-num 0 ""))))
        ;; Subsequent excess blanks: fix-only (not displayed)
-       ((and (string-every char-whitespace? line-text)
+       ((and (surface-blank-line? line-text)
              (> consecutive (1+ max-blanks)))
         (list (make-diagnostic
                file line-num 0

test/run-tests.scm

@@ -33,4 +33,5 @@
   (load-test "test-suppression.scm")
   (load-test "test-compiler.scm")
   (load-test "test-config.scm")
-  (load-test "test-engine.scm"))
+  (load-test "test-engine.scm")
+  (load-test "test-cli.scm"))

test/test-cli.scm

@@ -0,0 +1,38 @@
+;;; Tests for (gulie cli)
+
+(use-modules (srfi srfi-64)
+             (ice-9 textual-ports)
+             (gulie cli)
+             (gulie rules surface)
+             (gulie rules comments))
+
+(test-begin "cli")
+
+(test-group "output-json"
+  (let ((tmp (string-append (tmpnam) ".scm"))
+        (cfg (string-append (tmpnam) ".sexp")))
+    (call-with-output-file tmp
+      (lambda (p) (display "(define x 42)  \n" p)))
+    (call-with-output-file cfg
+      (lambda (p) (display "()\n" p)))
+    (let* ((code #f)
+           (output (call-with-output-string
+                    (lambda (port)
+                      (parameterize ((current-output-port port))
+                        (set! code
+                              (main (list "gulie"
+                                          "--pass" "surface"
+                                          "--config" cfg
+                                          "--output" "json"
+                                          tmp))))))))
+      (test-equal "exit code reports findings" 1 code)
+      (test-assert "json array output"
+        (string-prefix? "[" output))
+      (test-assert "contains json rule"
+        (string-contains output "\"rule\":\"trailing-whitespace\""))
+      (test-assert "does not use standard formatter"
+        (not (string-contains output ": warning: trailing-whitespace:"))))
+    (delete-file tmp)
+    (delete-file cfg)))
+
+(test-end "cli")

test/test-compiler.scm

@@ -47,10 +47,29 @@
 (test-group "syntax-error"
   (let ((diags (compile-and-capture-warnings
                 "test.scm"
-                "(define (foo x) (+ x"
+                "(define (foo x)\n  (+ x"
                 '())))
     (test-assert "catches syntax error"
       (any (lambda (d) (eq? (diagnostic-severity d) 'error))
-           diags))))
+           diags))
+    (let ((err (find (lambda (d) (eq? (diagnostic-severity d) 'error))
+                     diags)))
+      (test-assert "read error has useful line"
+        (> (diagnostic-line err) 1))
+      (test-assert "read error has useful message"
+        (not (string-contains (diagnostic-message err) "test.scm:"))))))
+
+(test-group "syntax-error-source-location"
+  (let* ((diags (compile-and-capture-warnings
+                 "test.scm"
+                 "(define-syntax foo\n  (syntax-rules (...)\n    ((_ x) x)))\n"
+                 '()))
+         (err (find (lambda (d) (eq? (diagnostic-severity d) 'error))
+                    diags)))
+    (test-assert "has compile error" err)
+    (test-equal "syntax error line from source props" 2
+      (diagnostic-line err))
+    (test-equal "syntax error column from source props" 2
+      (diagnostic-column err))))
 
 (test-end "compiler")

test/test-engine.scm

@@ -58,6 +58,14 @@
   (test-assert "info not >= warning"
     (not ((@@ (gulie engine) severity>=?) 'info 'warning))))
 
+(test-group "lint-files-execution-strategy"
+  (test-assert "surface pass can run in parallel"
+    ((@@ (gulie engine) parallel-safe-pass?) 'surface))
+  (test-assert "semantic pass runs sequentially"
+    (not ((@@ (gulie engine) parallel-safe-pass?) 'semantic)))
+  (test-assert "all pass runs sequentially"
+    (not ((@@ (gulie engine) parallel-safe-pass?) 'all))))
+
 ;;; lint-file with pass control
 
 (test-group "lint-file-pass-surface"
@@ -104,6 +112,34 @@
                   diags))))
     (delete-file tmp)))
 
+(test-group "lint-file-disable-semantic-rule"
+  (let ((tmp (tmpnam)))
+    (call-with-output-file tmp
+      (lambda (p) (display "(define x y)\n" p)))
+    (let ((diags (lint-file tmp '((%pass . semantic)
+                                  (disable unbound-variable)))))
+      (test-assert "disabled semantic rule produces no diagnostics"
+        (not (any (lambda (d) (eq? (diagnostic-rule d) 'unbound-variable))
+                  diags))))
+    (delete-file tmp)))
+
+(test-group "lint-file-page-break-separators"
+  (let ((tmp (tmpnam)))
+    (call-with-output-file tmp
+      (lambda (p)
+        (display "(define x 1)\n\n" p)
+        (display (string #\page) p)
+        (display "\n\n(define y 2)\n" p)))
+    (let ((diags (lint-file tmp '((%pass . surface)
+                                  (max-blank-lines . 1)))))
+      (test-assert "page break does not create blank-lines warning"
+        (not (any (lambda (d) (eq? (diagnostic-rule d) 'blank-lines))
+                  diags)))
+      (test-assert "page break does not trigger trailing-whitespace"
+        (not (any (lambda (d) (eq? (diagnostic-rule d) 'trailing-whitespace))
+                  diags))))
+    (delete-file tmp)))
+
 ;;; Fix mode
 
 (test-group "fix-trailing-whitespace"
@@ -252,7 +288,27 @@
         (test-assert "contains module name"
           (string-contains msg "nonexistent"))))))
 
-;;; Integration: lint-files with fix mode
+;;; Integration: lint-files output and fix mode
+
+(test-group "lint-files-json-output"
+  (let ((tmp (tmpnam))
+        (count #f))
+    (call-with-output-file tmp
+      (lambda (p) (display "(define x 42)  \n" p)))
+    (let ((output (call-with-output-string
+                   (lambda (port)
+                     (parameterize ((current-output-port port))
+                       (set! count
+                             (lint-files (list tmp)
+                                         '((%pass . surface)
+                                           (%output . json)))))))))
+      (test-equal "count preserved" 1 count)
+      (test-assert "json array output" (string-prefix? "[" output))
+      (test-assert "contains json rule"
+        (string-contains output "\"rule\":\"trailing-whitespace\""))
+      (test-assert "does not use standard formatter"
+        (not (string-contains output ": warning: trailing-whitespace:"))))
+    (delete-file tmp)))
 
 (test-group "lint-files-fix-mode"
   (let ((tmp (tmpnam)))

test/test-rules.scm

@@ -27,7 +27,11 @@
 
     (test-equal "empty line no diagnostic"
       '()
-      ((rule-check-proc rule) "f.scm" 1 "" '()))))
+      ((rule-check-proc rule) "f.scm" 1 "" '()))
+
+    (test-equal "page-break separator line ok"
+      '()
+      ((rule-check-proc rule) "f.scm" 1 (string #\page) '()))))
 
 (test-group "line-length"
   (let ((rule (find-rule 'line-length)))
@@ -55,7 +59,25 @@
       ((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-equal "tab detected" 1 (length diags)))
+
+    (test-equal "tabs in comments ignored"
+      '()
+      ((rule-check-proc rule) "f.scm" 1
+       (string-append ";;" (string #\tab) " comment")
+       '()))
+
+    (test-equal "tabs after inline comment ignored"
+      '()
+      ((rule-check-proc rule) "f.scm" 1
+       (string-append "(define x 1) ;" (string #\tab) " comment")
+       '()))
+
+    (test-equal "tabs in strings ignored"
+      '()
+      ((rule-check-proc rule) "f.scm" 1
+       (string-append "(display \"" (string #\tab) "\")")
+       '()))))
 
 (test-group "blank-lines"
   (let ((rule (find-rule 'blank-lines)))