rose-ash/lib/tcl/tests/namespace.sx

; Tcl-on-SX namespace tests (Phase 5)
(define tcl-ns-pass 0)
(define tcl-ns-fail 0)
(define tcl-ns-failures (list))

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

(define
  tcl-run-namespace-tests
  (fn
    ()
    (set! tcl-ns-pass 0)
    (set! tcl-ns-fail 0)
    (set! tcl-ns-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-ns-assert label expected actual)))
    (define
      ok?
      (fn (label condition) (tcl-ns-assert label true condition)))

    ; --- namespace current ---
    (ok "ns-current-global"
      (get (run "namespace current") :result)
      "::")

    ; --- namespace eval defines proc ---
    (ok "ns-eval-proc-result"
      (get (run "namespace eval myns { proc foo {} { return bar } }\nmyns::foo") :result)
      "bar")

    ; --- fully qualified call ---
    (ok "ns-qualified-call"
      (get (run "namespace eval myns { proc greet {name} { return \"hello $name\" } }\n::myns::greet World") :result)
      "hello World")

    ; --- namespace current inside eval ---
    (ok "ns-current-inside"
      (get (run "namespace eval myns { namespace current }") :result)
      "::myns")

    ; --- namespace current restored after eval ---
    (ok "ns-current-restored"
      (get (run "namespace eval myns { set x 1 }\nnamespace current") :result)
      "::")

    ; --- relative call from within namespace ---
    (ok "ns-relative-call"
      (get (run "namespace eval math {\n  proc double {x} { expr {$x * 2} }\n  proc quad {x} { double [double $x] }\n}\nmath::quad 3") :result)
      "12")

    ; --- proc defined as qualified name inside namespace eval ---
    (ok "ns-qualified-proc-name"
      (get (run "namespace eval utils { proc ::utils::helper {x} { return $x } }\n::utils::helper done") :result)
      "done")

    ; --- namespace exists ---
    (ok "ns-exists-yes"
      (get (run "namespace eval testns { proc p {} {} }\nnamespace exists testns") :result)
      "1")

    (ok "ns-exists-no"
      (get (run "namespace exists nosuchns") :result)
      "0")

    (ok "ns-exists-global"
      (get (run "proc top {} {}\nnamespace exists ::") :result)
      "1")

    ; --- namespace delete ---
    (ok "ns-delete-removes"
      (get (run "namespace eval todel { proc pp {} { return yes } }\nnamespace delete todel\nnamespace exists todel") :result)
      "0")

    ; --- namespace which ---
    (ok "ns-which-found"
      (get (run "namespace eval wns { proc wfn {} {} }\nnamespace which -command wns::wfn") :result)
      "::wns::wfn")

    (ok "ns-which-not-found"
      (get (run "namespace which -command nosuchfn") :result)
      "")

    ; --- namespace ensemble create auto-map ---
    (ok "ns-ensemble-add"
      (get (run "namespace eval mymath {\n  proc add {a b} { expr {$a + $b} }\n  proc mul {a b} { expr {$a * $b} }\n  namespace ensemble create\n}\nmymath add 3 4") :result)
      "7")

    (ok "ns-ensemble-mul"
      (get (run "namespace eval mymath {\n  proc add {a b} { expr {$a + $b} }\n  proc mul {a b} { expr {$a * $b} }\n  namespace ensemble create\n}\nmymath mul 3 4") :result)
      "12")

    ; --- namespace ensemble with -map ---
    (ok "ns-ensemble-map"
      (get (run "namespace eval ops {\n  proc do-add {a b} { expr {$a + $b} }\n  namespace ensemble create -map {plus ::ops::do-add}\n}\nops plus 5 6") :result)
      "11")

    ; --- proc inside namespace eval with args ---
    (ok "ns-proc-args"
      (get (run "namespace eval calc {\n  proc sum {a b c} { expr {$a + $b + $c} }\n}\ncalc::sum 1 2 3") :result)
      "6")

    ; --- info procs inside namespace ---
    (ok? "ns-info-procs-in-ns"
      (let
        ((r (get (run "namespace eval foo { proc bar {} {} }\nnamespace eval foo { info procs }") :result)))
        (contains? (tcl-list-split r) "bar")))

    ; --- variable inside namespace eval ---
    (ok "ns-variable-inside"
      (get (run "namespace eval storage {\n  variable count 0\n  proc bump {} { global count\n    incr count\n    return $count }\n}\n::storage::bump\n::storage::bump") :result)
      "2")

    ; --- nested namespaces ---
    (ok "ns-nested"
      (get (run "namespace eval outer {\n  namespace eval inner {\n    proc greet {} { return nested }\n  }\n}\n::outer::inner::greet") :result)
      "nested")

    ; --- namespace eval accumulates procs ---
    (ok "ns-eval-accumulate"
      (get (run "namespace eval acc { proc f1 {} { return one } }\nnamespace eval acc { proc f2 {} { return two } }\nacc::f1") :result)
      "one")

    (ok "ns-eval-accumulate-2"
      (get (run "namespace eval acc { proc f1 {} { return one } }\nnamespace eval acc { proc f2 {} { return two } }\nacc::f2") :result)
      "two")

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