;; tests/ursa.lsp — acceptance tests for Zoë Trout's favorite programs.
;; Runs both Scheme-port (examples/ursa-scheme.lsp) and CL-original
;; (examples/ursa.lisp.txt via cl-compat.lsp) paths, verifies matching
;; answers. See ticket 0004 and whitepaper §9.2.

(define *pass* 0)
(define *fail* 0)
(define (check name got expected)
  (cond ((equal? got expected)
         (set! *pass* (+ *pass* 1))
         (display "PASS: ") (display name) (newline))
        (else
         (set! *fail* (+ *fail* 1))
         (display "FAIL: ") (display name)
         (display " got=") (write got)
         (display " expected=") (write expected) (newline))))

;; ── Scheme port ──────────────────────────────────────────────────
(load "examples/ursa-scheme.lsp")
(random-seed! 42)

(check "s:expt-mod-3^7%100"   (expt-mod 3 7 100)        87)
(check "s:expt-mod-big"       (expt-mod 2 100 1000)     376)
(check "s:primep-97"          (primep 97)               97)
(check "s:primep-100"         (primep 100)              #f)
(check "s:factor-12"          (factor 12)               '(2 2 3))
(check "s:factor-1001"        (factor 1001)             '(7 11 13))
(check "s:mersenne-5"         (mersenne-number 5)       31)
(check "s:ll-residue-5"       (lucas-lehmer-residue 5)  0)
(check "s:ll-primep-5"        (lucas-lehmer-primep 5)   #t)
(check "s:ll-primep-11"       (lucas-lehmer-primep 11)  #f)
(check "s:ll-primep-13"       (lucas-lehmer-primep 13)  #t)
(check "s:repunit-5"          (repunit-value 5)         31)
(check "s:digits-42-2"        (digits 42 2)             #(1 0 1 0 1 0))
(check "s:digits-roundtrip"   (digits (digits 1234 16) 16) 1234)
(let ((v (of-n-bits 8)))
  (check "s:of-n-bits"        (and (>= v 128) (< v 256)) #t))

;; ── CL original (loaded via cl-compat) ──────────────────────────
;; Load cl-compat + ursa.lisp.txt. The CL file REDEFINES the same
;; symbols (expt-mod, miller-rabin, ...) via defun macro — after this
;; load, the names point at the CL-path implementations.
(load "examples/ursa.lisp.txt")
(random-seed! 42)

(check "c:expt-mod-3^7%100"   (expt-mod 3 7 100)        87)
;; (expt-mod 2 k m) takes the (ash 1 k) fast path in Zoë's CL; keep
;; k small enough that (expt 2 k) fits lumbda-C's 48-bit int domain.
(check "c:expt-mod-2^30"      (expt-mod 2 30 1000)      824)
(check "c:primep-97"          (primep 97)               97)
(check "c:primep-100"         (primep 100)              #f)
(check "c:mersenne-5"         (mersenne-number 5)       31)
(check "c:ll-primep-5"        (lucas-lehmer-primep 5)   #t)
(check "c:ll-primep-11"       (lucas-lehmer-primep 11)  #f)
(check "c:ll-primep-13"       (lucas-lehmer-primep 13)  #t)
(check "c:repunit-5"          (repunit-value 5)         31)
(check "c:repunit-4-10"       (repunit-value 4 1 10)    1111)
(let ((v (of-n-bits 8)))
  (check "c:of-n-bits"        (and (>= v 128) (< v 256)) #t))
(let ((p (prime-of-n-bits 8)))
  (check "c:prime-of-n-bits"  (and (primep p) (>= p 128) (< p 256)) #t))
;; rhoff is probabilistic — retries are expected. factor (from the
;; Scheme port, still bound after CL load) wraps rhoff with the retry
;; loop. Composed with CL's rhoff, the final factoring still holds.
(check "c:factor-via-rhoff"   (factor 15)               '(3 5))

(display "══════════════════════════════") (newline)
(display "ursa: ") (display *pass*) (display " passed, ")
(display *fail*) (display " failed") (newline)
(if (> *fail* 0) (exit 1))
