;;; 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)\n  (+ x"
                '())))
    (test-assert "catches syntax error"
      (any (lambda (d) (eq? (diagnostic-severity d) 'error))
           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")