;; lib/tcl/tests/runtime.sx — Tests for lib/tcl/runtime.sx

(define tcl-test-pass 0)
(define tcl-test-fail 0)
(define tcl-test-fails (list))

(define
  (tcl-test name got expected)
  (if
    (= got expected)
    (set! tcl-test-pass (+ tcl-test-pass 1))
    (begin
      (set! tcl-test-fail (+ tcl-test-fail 1))
      (set! tcl-test-fails (append tcl-test-fails (list {:got got :expected expected :name name}))))))

;; ---------------------------------------------------------------------------
;; 1. String buffer
;; ---------------------------------------------------------------------------

(define sb1 (tcl-sb-new))
(tcl-test "sb? new" (tcl-sb? sb1) true)
(tcl-test "sb? non-sb" (tcl-sb? "hello") false)
(tcl-test "sb value empty" (tcl-sb-value sb1) "")
(tcl-test "sb length empty" (tcl-sb-length sb1) 0)
(tcl-sb-append! sb1 "hello")
(tcl-test "sb value after append" (tcl-sb-value sb1) "hello")
(tcl-sb-append! sb1 " ")
(tcl-sb-append! sb1 "world")
(tcl-test "sb value after multi-append" (tcl-sb-value sb1) "hello world")
(tcl-test "sb length" (tcl-sb-length sb1) 11)
(tcl-sb-clear! sb1)
(tcl-test "sb value after clear" (tcl-sb-value sb1) "")
(tcl-test "sb length after clear" (tcl-sb-length sb1) 0)

;; ---------------------------------------------------------------------------
;; 2. String port (channel)
;; ---------------------------------------------------------------------------

(define chin1 (tcl-chan-in-new "hello\nworld\nfoo"))
(tcl-test "chan? read" (tcl-chan? chin1) true)
(tcl-test "chan eof? no" (tcl-chan-eof? chin1) false)
(tcl-test "chan gets line1" (tcl-chan-gets chin1) "hello")
(tcl-test "chan gets line2" (tcl-chan-gets chin1) "world")
(tcl-test "chan gets line3" (tcl-chan-gets chin1) "foo")
(tcl-test "chan eof? yes" (tcl-chan-eof? chin1) true)
(tcl-test "chan gets at eof" (tcl-chan-gets chin1) "")

(define chin2 (tcl-chan-in-new "abcdef"))
(tcl-test "chan read all" (tcl-chan-read chin2) "abcdef")
(tcl-test "chan read empty" (tcl-chan-read chin2) "")

(define chout1 (tcl-chan-out-new))
(tcl-test "chan? write" (tcl-chan? chout1) true)
(tcl-chan-puts! chout1 "hello")
(tcl-chan-puts! chout1 " world")
(tcl-test "chan string" (tcl-chan-string chout1) "hello world")
(tcl-chan-puts-line! chout1 "!")
(tcl-test "chan string with newline" (tcl-chan-string chout1) "hello world!\n")

(define chout2 (tcl-chan-out-new))
(tcl-chan-puts-line! chout2 "line1")
(tcl-chan-puts-line! chout2 "line2")
(tcl-test "chan multi-line" (tcl-chan-string chout2) "line1\nline2\n")

;; ---------------------------------------------------------------------------
;; 3. Regexp
;; ---------------------------------------------------------------------------

(define rx1 (tcl-re-new "hel+o"))
(tcl-test "re? yes" (tcl-re? rx1) true)
(tcl-test "re? no" (tcl-re? "hello") false)
(tcl-test "re match? yes" (tcl-re-match? rx1 "say hello") true)
(tcl-test "re match? no" (tcl-re-match? rx1 "goodbye") false)

(define m1 (tcl-re-match rx1 "say hello world"))
(tcl-test "re match result" (get m1 "match") "hello")

(define rx2 (tcl-re-new "[0-9]+"))
(define all (tcl-re-match-all rx2 "a1b22c333"))
(tcl-test "re match-all count" (len all) 3)
(tcl-test "re match-all last" (get (nth all 2) "match") "333")

(tcl-test "re sub" (tcl-re-sub rx2 "a1b2" "N") "aNb2")
(tcl-test "re sub-all" (tcl-re-sub-all rx2 "a1b2" "N") "aNbN")

(define rx3 (tcl-re-new "[ ,]+"))
(tcl-test "re split" (tcl-re-split rx3 "a b,c") (list "a" "b" "c"))

;; ---------------------------------------------------------------------------
;; 4. Format
;; ---------------------------------------------------------------------------

(tcl-test "format %s" (tcl-format "hello %s" (list "world")) "hello world")
(tcl-test "format %d" (tcl-format "n=%d" (list 42)) "n=42")
(tcl-test "format %d truncates float" (tcl-format "n=%d" (list 3.9)) "n=3")
(tcl-test
  "format %s %d"
  (tcl-format "%s is %d" (list "age" 30))
  "age is 30")
(tcl-test "format %%" (tcl-format "100%% done" (list)) "100% done")
(tcl-test "format %x" (tcl-format "%x" (list 255)) "ff")
(tcl-test "format %x 16" (tcl-format "0x%x" (list 16)) "0x10")
(tcl-test "format %o" (tcl-format "%o" (list 8)) "10")
(tcl-test "format %o 255" (tcl-format "%o" (list 255)) "377")
(tcl-test "format no spec" (tcl-format "plain text" (list)) "plain text")
(tcl-test
  "format multiple"
  (tcl-format "%s=%d (0x%x)" (list "val" 255 255))
  "val=255 (0xff)")

;; ---------------------------------------------------------------------------
;; 5. Coroutine
;;    tcl-co-yield works from top-level helper functions.
;; ---------------------------------------------------------------------------

(define
  co1
  (tcl-co-new
    (fn () (tcl-co-yield 1) (tcl-co-yield 2) 3)))

(tcl-test "co? yes" (tcl-co? co1) true)
(tcl-test "co? no" (tcl-co? 42) false)
(tcl-test "co alive? before" (tcl-co-alive? co1) true)
(define cor1 (tcl-co-resume co1))
(tcl-test "co resume 1" cor1 1)
(tcl-test "co alive? mid" (tcl-co-alive? co1) true)
(define cor2 (tcl-co-resume co1))
(tcl-test "co resume 2" cor2 2)
(define cor3 (tcl-co-resume co1))
(tcl-test "co resume 3 completion" cor3 3)
(tcl-test "co alive? dead" (tcl-co-alive? co1) false)

;; Top-level helper for recursive yield (avoids JIT letrec limitation)
(define
  (tcl-co-count-down i)
  (when
    (>= i 1)
    (tcl-co-yield i)
    (tcl-co-count-down (- i 1))))

(define co2 (tcl-co-new (fn () (tcl-co-count-down 3) "done")))
(tcl-test "co loop 3" (tcl-co-resume co2) 3)
(tcl-test "co loop 2" (tcl-co-resume co2) 2)
(tcl-test "co loop 1" (tcl-co-resume co2) 1)
(tcl-test "co loop done" (tcl-co-resume co2) "done")
(tcl-test "co loop dead" (tcl-co-alive? co2) false)