; Tcl-on-SX error handling tests (Phase 4)
(define tcl-err-pass 0)
(define tcl-err-fail 0)
(define tcl-err-failures (list))

(define
  tcl-err-assert
  (fn
    (label expected actual)
    (if
      (equal? expected actual)
      (set! tcl-err-pass (+ tcl-err-pass 1))
      (begin
        (set! tcl-err-fail (+ tcl-err-fail 1))
        (append!
          tcl-err-failures
          (str label ": expected=" (str expected) " got=" (str actual)))))))

(define
  tcl-run-error-tests
  (fn
    ()
    (set! tcl-err-pass 0)
    (set! tcl-err-fail 0)
    (set! tcl-err-failures (list))
    (define interp (fn () (make-default-tcl-interp)))
    (define run (fn (src) (tcl-eval-string (interp) src)))
    (define
      ok
      (fn (label actual expected) (tcl-err-assert label expected actual)))
    (define
      ok?
      (fn (label condition) (tcl-err-assert label true condition)))

    ; --- catch basic ---
    (ok "catch-ok-code" (get (run "catch {set x 1}") :result) "0")
    (ok "catch-ok-result-var" (tcl-var-get (run "catch {set x hello} r") "r") "hello")
    (ok "catch-ok-returns-0" (get (run "catch {set x hello} r") :result) "0")

    ; --- catch error ---
    (ok "catch-error-code" (get (run "catch {error oops} r") :result) "1")
    (ok "catch-error-result-var" (tcl-var-get (run "catch {error oops} r") "r") "oops")

    ; --- catch outer code stays 0 ---
    (ok? "catch-outer-code-ok" (= (get (run "catch {error boom} r") :code) 0))

    ; --- catch code 2 (return) ---
    (ok "catch-return-code" (get (run "proc p {} {return hello}\ncatch {p} r") :result) "0")
    (ok "catch-return-val" (tcl-var-get (run "proc p {} {return hello}\ncatch {p} r") "r") "hello")

    ; --- catch code 3 (break) ---
    (ok "catch-break-code" (get (run "catch {break} r") :result) "3")

    ; --- catch code 4 (continue) ---
    (ok "catch-continue-code" (get (run "catch {continue} r") :result) "4")

    ; --- catch no resultVar ---
    (ok "catch-no-var-ok" (get (run "catch {set x 1}") :result) "0")
    (ok "catch-no-var-err" (get (run "catch {error boom}") :result) "1")

    ; --- catch with optsVar ---
    (ok? "catch-opts-var-set"
      (let
        ((i (run "catch {error boom} r opts")))
        (not (equal? (tcl-var-get i "opts") ""))))
    (ok? "catch-opts-contains-code"
      (let
        ((i (run "catch {error boom} r opts")))
        (let
          ((opts-str (tcl-var-get i "opts")))
          (not (equal? (tcl-string-first "-code" opts-str 0) "-1")))))

    ; --- catch nested ---
    (ok "catch-nested"
      (tcl-var-get (run "catch {catch {error inner} r2} outer") "r2")
      "inner")

    ; --- return -code error ---
    (ok "return-code-error-code"
      (get (run "catch {return -code error oops} r") :result)
      "1")
    (ok "return-code-error-val"
      (tcl-var-get (run "catch {return -code error oops} r") "r")
      "oops")

    ; --- return -code ok ---
    (ok "return-code-ok"
      (get (run "catch {return -code ok hello} r") :result)
      "0")
    (ok "return-code-ok-val"
      (tcl-var-get (run "catch {return -code ok hello} r") "r")
      "hello")

    ; --- return -code break ---
    (ok "return-code-break"
      (get (run "catch {return -code break} r") :result)
      "3")

    ; --- return -code continue ---
    (ok "return-code-continue"
      (get (run "catch {return -code continue} r") :result)
      "4")

    ; --- return -code numeric ---
    (ok "return-code-numeric-5"
      (get (run "catch {return -code 5 msg} r") :result)
      "5")

    ; --- return plain still code 2 (catch sees raw return code) ---
    (ok "return-plain-code"
      (get (run "catch {return hello} r") :result)
      "2")
    (ok "return-plain-val"
      (tcl-var-get (run "catch {return hello} r") "r")
      "hello")

    ; --- proc return -code error ---
    (ok "proc-return-code-error"
      (get (run "proc p {} {return -code error bad}\ncatch {p} r") :result)
      "1")
    (ok "proc-return-code-error-val"
      (tcl-var-get (run "proc p {} {return -code error bad}\ncatch {p} r") "r")
      "bad")

    ; --- error with info/code args ---
    (ok? "error-errorinfo-stored"
      (let
        ((i (run "catch {error msg myinfo mycode} r")))
        (= (get i :code) 0)))

    ; --- throw ---
    (ok "throw-code" (get (run "catch {throw MYERR something} r") :result) "1")
    (ok "throw-msg" (tcl-var-get (run "catch {throw MYERR something} r") "r") "something")

    ; --- try basic ok ---
    (ok "try-ok-result"
      (get (run "try {set x hello} on ok {r} {set r2 $r}") :result)
      "hello")

    ; --- try on error ---
    (ok "try-on-error-handled"
      (get (run "try {error boom} on error {e} {set caught $e}") :result)
      "boom")
    (ok "try-on-error-var"
      (tcl-var-get (run "try {error boom} on error {e} {set caught $e}") "caught")
      "boom")

    ; --- try finally always runs ---
    (ok "try-finally-ok"
      (tcl-var-get (run "try {set x 1} finally {set done yes}") "done")
      "yes")
    (ok "try-finally-error"
      (tcl-var-get (run "catch {try {error boom} finally {set done yes}} r") "done")
      "yes")

    ; --- try on error + finally ---
    (ok "try-error-finally"
      (tcl-var-get
        (run "try {error oops} on error {e} {set caught $e} finally {set cleaned yes}")
        "cleaned")
      "yes")
    (ok "try-error-finally-caught"
      (tcl-var-get
        (run "try {error oops} on error {e} {set caught $e} finally {set cleaned yes}")
        "caught")
      "oops")

    ; --- try on ok and on error ---
    (ok "try-multi-clause-ok"
      (tcl-var-get
        (run "try {set x 1} on ok {r} {set which ok} on error {e} {set which err}")
        "which")
      "ok")
    (ok "try-multi-clause-err"
      (tcl-var-get
        (run "try {error boom} on ok {r} {set which ok} on error {e} {set which err}")
        "which")
      "err")

    ; --- catch preserves output ---
    (ok "catch-output-preserved"
      (get (run "puts -nonewline before\ncatch {puts -nonewline inside\nerror oops}\nputs -nonewline after")
        :output)
      "beforeinsideafter")

    (dict
      "passed"
      tcl-err-pass
      "failed"
      tcl-err-fail
      "failures"
      tcl-err-failures)))