diff --git a/lib/tcl/runtime.sx b/lib/tcl/runtime.sx index eec711bd..651bd02d 100644 --- a/lib/tcl/runtime.sx +++ b/lib/tcl/runtime.sx @@ -20,7 +20,7 @@ (frame name val) (assoc frame :locals (assoc (get frame :locals) name val)))) -(define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {}})) +(define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::"})) (define tcl-register @@ -263,13 +263,16 @@ (let ((bound-frame (tcl-bind-params new-frame params call-args))) (let + ((proc-ns (let ((ns (get proc-def :ns))) (if (nil? ns) (get interp :current-ns) ns)))) + (let ((proc-interp (assoc interp :frame bound-frame :frame-stack (append (get interp :frame-stack) (list (get interp :frame))) :output "" :result "" - :code 0)) + :code 0 + :current-ns proc-ns)) (caller-output (get interp :output))) (let ((result-interp (tcl-eval-string proc-interp body))) @@ -293,7 +296,7 @@ :frame-stack updated-below :result result-val :output (str caller-output proc-output) - :code (if (= code 2) 0 code))))))))))))) + :code (if (= code 2) 0 code)))))))))))))) (define tcl-eval-cmd @@ -313,11 +316,11 @@ (if (nil? cmd-fn) (let - ((proc-def (get (get cur-interp :procs) cmd-name))) + ((proc-entry (tcl-proc-lookup cur-interp cmd-name))) (if - (nil? proc-def) + (nil? proc-entry) (error (str "unknown command: \"" cmd-name "\"")) - (tcl-call-proc cur-interp cmd-name proc-def cmd-args))) + (tcl-call-proc cur-interp (get proc-entry :name) (get proc-entry :def) cmd-args))) (cmd-fn cur-interp cmd-args))))))))) (define @@ -2256,6 +2259,114 @@ (assoc (tcl-var-set interp varname new-dict) :result new-dict))))))) (else (error (str "dict: unknown subcommand \"" sub "\"")))))))) +; --- namespace helpers --- + +; Normalize a namespace name to fully-qualified form: ::ns +; Accepts: "ns", "::ns", "ns::", "::ns::", "" → "::" +(define + tcl-ns-normalize + (fn + (ns) + (if + (or (equal? ns "") (equal? ns "::")) + "::" + (let + ; strip trailing :: + ((stripped + (if + (equal? (substring ns (- (string-length ns) 2) (string-length ns)) "::") + (substring ns 0 (- (string-length ns) 2)) + ns))) + ; ensure leading :: + (if + (equal? (substring stripped 0 2) "::") + stripped + (str "::" stripped)))))) + +; Test whether string s starts with prefix p +(define + tcl-starts-with? + (fn + (s p) + (let + ((pl (string-length p)) (sl (string-length s))) + (if (> pl sl) false (equal? (substring s 0 pl) p))))) + +; Qualify a proc name relative to current-ns. +; If name already starts with :: return as-is. +; Otherwise prepend current-ns:: (or :: if current-ns is ::). +(define + tcl-qualify-name + (fn + (name current-ns) + (if + (tcl-starts-with? name "::") + name + (if + (equal? current-ns "::") + (str "::" name) + (str current-ns "::" name))))) + +; Look up a command by name with namespace resolution. +; Try: exact name → ::current-ns::name → ::name +(define + tcl-proc-lookup + (fn + (interp name) + (let + ((procs (get interp :procs)) + (current-ns (get interp :current-ns))) + (let + ((exact (get procs name))) + (if (not (nil? exact)) + {:name name :def exact} + (let + ((qualified (tcl-qualify-name name current-ns))) + (let + ((qual-def (get procs qualified))) + (if (not (nil? qual-def)) + {:name qualified :def qual-def} + (let + ((global-name (str "::" name))) + (let + ((global-def (get procs global-name))) + (if (not (nil? global-def)) + {:name global-name :def global-def} + nil))))))))))) + +; Get all proc names in a namespace (returns list of fully-qualified names) +(define + tcl-ns-procs + (fn + (procs ns) + (let + ((prefix (if (equal? ns "::") "::" (str ns "::")))) + (filter + (fn (k) + (if (equal? ns "::") + ; global ns: keys that start with :: but have no further :: + (and + (tcl-starts-with? k "::") + (not (tcl-starts-with? (substring k 2 (string-length k)) "::"))) + (tcl-starts-with? k prefix))) + (keys procs))))) + +; Check if a namespace exists (has any procs) +(define + tcl-ns-exists? + (fn + (procs ns) + (> (len (tcl-ns-procs procs ns)) 0))) + +; Extract last component from qualified name ::ns::foo → foo +(define + tcl-ns-tail + (fn + (name) + (let + ((parts (filter (fn (p) (not (equal? p ""))) (split name ":")))) + (if (= 0 (len parts)) name (nth parts (- (len parts) 1)))))) + ; --- proc command --- (define @@ -2263,12 +2374,24 @@ (fn (interp args) (let - ((name (first args)) + ((raw-name (first args)) (arg-spec (nth args 1)) (body (nth args 2))) - (assoc interp - :procs (assoc (get interp :procs) name {:args arg-spec :body body}) - :result "")))) + (let + ; qualify name based on current namespace + ((name (tcl-qualify-name raw-name (get interp :current-ns)))) + (let + ; extract the namespace of the proc for runtime context + ((proc-ns + (let + ((parts (filter (fn (p) (not (equal? p ""))) (split name ":")))) + ; proc-ns is all but last component, re-joined as ::ns or :: + (if (<= (len parts) 1) + "::" + (str "::" (join "::" (take-n parts (- (len parts) 1)))))))) + (assoc interp + :procs (assoc (get interp :procs) name {:args arg-spec :body body :ns proc-ns}) + :result "")))))) ; --- parse uplevel/upvar level argument --- ; Returns absolute level number. @@ -2412,6 +2535,178 @@ (go linked rest-rem)))))))) (go interp args)))) +; --- namespace command --- + +; namespace ensemble dispatch fn for a given ns and map +(define + tcl-make-ensemble + (fn + (procs ns map-dict) + (fn + (interp args) + (if + (= 0 (len args)) + (error (str "wrong # args: ensemble \"" ns "\" requires subcommand")) + (let + ((subcmd (first args)) (rest-args (rest args))) + (let + ((target-name (tcl-dict-get map-dict subcmd))) + (if (not (nil? target-name)) + ; dispatch via mapped name + (let + ((proc-entry (tcl-proc-lookup interp target-name))) + (if (nil? proc-entry) + (error (str "ensemble: command \"" target-name "\" not found")) + (tcl-call-proc interp (get proc-entry :name) (get proc-entry :def) rest-args))) + (error (str "unknown or ambiguous subcommand \"" subcmd "\": must be one of " (join ", " (map first (tcl-dict-to-pairs map-dict)))))))))))) + +(define + tcl-cmd-namespace + (fn + (interp args) + (if + (= 0 (len args)) + (error "namespace: wrong # args") + (let + ((sub (first args)) (rest-args (rest args))) + (cond + ; namespace eval ns body + ((equal? sub "eval") + (let + ((ns-raw (if (> (len rest-args) 0) (first rest-args) "")) + (body (if (> (len rest-args) 1) (nth rest-args 1) ""))) + (let + ; if ns-raw is relative (no leading ::), resolve relative to current-ns + ((ns + (let + ((normalized (tcl-ns-normalize ns-raw)) + (current-ns (get interp :current-ns))) + ; tcl-ns-normalize always adds :: prefix, so ::name is absolute + ; check if the original had leading :: + (if + (tcl-starts-with? ns-raw "::") + normalized + ; relative: if current is ::, just use ::name; else ::current::name + (if + (equal? current-ns "::") + normalized + (str current-ns "::" (tcl-ns-tail normalized)))))) + (saved-ns (get interp :current-ns))) + (let + ((ns-interp (assoc interp :current-ns ns))) + (let + ((result-interp (tcl-eval-string ns-interp body))) + ; restore current-ns after eval + (assoc result-interp :current-ns saved-ns)))))) + ; namespace current + ((equal? sub "current") + (assoc interp :result (get interp :current-ns))) + ; namespace which -command name + ((equal? sub "which") + (let + ((name (if (and (> (len rest-args) 0) (equal? (first rest-args) "-command")) + (if (> (len rest-args) 1) (nth rest-args 1) "") + (if (> (len rest-args) 0) (first rest-args) "")))) + (let + ((entry (tcl-proc-lookup interp name))) + (if (nil? entry) + (assoc interp :result "") + (assoc interp :result (get entry :name)))))) + ; namespace exists ns + ((equal? sub "exists") + (let + ((ns (tcl-ns-normalize (if (> (len rest-args) 0) (first rest-args) "")))) + (assoc interp :result (if (tcl-ns-exists? (get interp :procs) ns) "1" "0")))) + ; namespace delete ns + ((equal? sub "delete") + (let + ((ns (tcl-ns-normalize (if (> (len rest-args) 0) (first rest-args) "")))) + (let + ((prefix (if (equal? ns "::") "::" (str ns "::")))) + (let + ((remaining-procs + (reduce + (fn (acc k) (if (tcl-starts-with? k prefix) acc (assoc acc k (get (get interp :procs) k)))) + {} + (keys (get interp :procs))))) + (assoc interp :procs remaining-procs :result ""))))) + ; namespace export pattern — stub + ((equal? sub "export") + (assoc interp :result "")) + ; namespace import ns::name + ((equal? sub "import") + (let + ((target-name (if (> (len rest-args) 0) (first rest-args) ""))) + (let + ((tail (tcl-ns-tail target-name)) + (entry (tcl-proc-lookup interp target-name))) + (if (nil? entry) + (error (str "namespace import: \"" target-name "\" not found")) + (let + ((local-name (tcl-qualify-name tail (get interp :current-ns)))) + (assoc interp + :procs (assoc (get interp :procs) local-name (get entry :def)) + :result "")))))) + ; namespace forget name — remove import alias + ((equal? sub "forget") + (let + ((name (if (> (len rest-args) 0) (first rest-args) ""))) + (let + ((qualified (tcl-qualify-name name (get interp :current-ns)))) + (let + ((new-procs (reduce + (fn (acc k) (if (equal? k qualified) acc (assoc acc k (get (get interp :procs) k)))) + {} + (keys (get interp :procs))))) + (assoc interp :procs new-procs :result ""))))) + ; namespace path ?nslist? — stub + ((equal? sub "path") + (assoc interp :result "")) + ; namespace ensemble create ?-map dict? + ((equal? sub "ensemble") + (if (and (> (len rest-args) 0) (equal? (first rest-args) "create")) + (let + ((ens-args (rest rest-args)) + (current-ns (get interp :current-ns))) + (let + ; parse optional -map {subcmd cmd ...} + ((map-str + (let + ((go + (fn + (remaining) + (if + (< (len remaining) 2) + nil + (if (equal? (first remaining) "-map") + (nth remaining 1) + (go (rest remaining))))))) + (go ens-args)))) + (let + ; build dispatch map + ((dispatch-map + (if (nil? map-str) + ; auto-map: all procs in this namespace → tail name + (let + ((ns-proc-names (tcl-ns-procs (get interp :procs) current-ns))) + (reduce + (fn (acc qname) + (let + ((tail (tcl-ns-tail qname))) + (tcl-dict-set-pair acc tail qname))) + "" + ns-proc-names)) + map-str))) + ; ensemble command name = tail of current-ns + (let + ((ens-name (tcl-ns-tail current-ns)) + (ens-fn (tcl-make-ensemble (get interp :procs) current-ns dispatch-map))) + (assoc interp + :commands (assoc (get interp :commands) ens-name ens-fn) + :result ""))))) + (error "namespace ensemble: unknown subcommand"))) + (else (error (str "namespace: unknown subcommand \"" sub "\"")))))))) + ; --- info command --- (define @@ -2454,29 +2749,33 @@ ; info commands ((equal? sub "commands") (assoc interp :result (tcl-list-build (keys (get interp :commands))))) - ; info procs + ; info procs — return unqualified names of procs in current namespace ((equal? sub "procs") - (assoc interp :result (tcl-list-build (keys (get interp :procs))))) + (let + ((current-ns (get interp :current-ns))) + (let + ((ns-proc-names (tcl-ns-procs (get interp :procs) current-ns))) + (assoc interp :result (tcl-list-build (map tcl-ns-tail ns-proc-names)))))) ; info args procname ((equal? sub "args") (let ((pname (first rest-args))) (let - ((proc-def (get (get interp :procs) pname))) + ((entry (tcl-proc-lookup interp pname))) (if - (nil? proc-def) + (nil? entry) (error (str "info args: \"" pname "\" isn't a procedure")) - (assoc interp :result (get proc-def :args)))))) + (assoc interp :result (get (get entry :def) :args)))))) ; info body procname ((equal? sub "body") (let ((pname (first rest-args))) (let - ((proc-def (get (get interp :procs) pname))) + ((entry (tcl-proc-lookup interp pname))) (if - (nil? proc-def) + (nil? entry) (error (str "info body: \"" pname "\" isn't a procedure")) - (assoc interp :result (get proc-def :body)))))) + (assoc interp :result (get (get entry :def) :body)))))) (else (error (str "info: unknown subcommand \"" sub "\"")))))))) (define @@ -2571,4 +2870,6 @@ ((i (tcl-register i "catch" tcl-cmd-catch))) (let ((i (tcl-register i "throw" tcl-cmd-throw))) - (tcl-register i "try" tcl-cmd-try))))))))))))))))))))))))))))))))))))))))))))))) + (let + ((i (tcl-register i "try" tcl-cmd-try))) + (tcl-register i "namespace" tcl-cmd-namespace)))))))))))))))))))))))))))))))))))))))))))))))) diff --git a/lib/tcl/test.sh b/lib/tcl/test.sh index 9ae03efe..76ddc517 100755 --- a/lib/tcl/test.sh +++ b/lib/tcl/test.sh @@ -19,10 +19,12 @@ cat > "$HELPER" << 'HELPER_EOF' (define __pr (tcl-run-parse-tests)) (define __er (tcl-run-eval-tests)) (define __xr (tcl-run-error-tests)) +(define __nr (tcl-run-namespace-tests)) (define tcl-test-summary (str "PARSE:" (get __pr "passed") ":" (get __pr "failed") " EVAL:" (get __er "passed") ":" (get __er "failed") - " ERROR:" (get __xr "passed") ":" (get __xr "failed"))) + " ERROR:" (get __xr "passed") ":" (get __xr "failed") + " NAMESPACE:" (get __nr "passed") ":" (get __nr "failed"))) HELPER_EOF cat > "$TMPFILE" << EPOCHS @@ -39,16 +41,18 @@ cat > "$TMPFILE" << EPOCHS (epoch 6) (load "lib/tcl/tests/error.sx") (epoch 7) -(load "$HELPER") +(load "lib/tcl/tests/namespace.sx") (epoch 8) +(load "$HELPER") +(epoch 9) (eval "tcl-test-summary") EPOCHS OUTPUT=$(timeout 90 "$SX_SERVER" < "$TMPFILE" 2>&1) [ "$VERBOSE" = "-v" ] && echo "$OUTPUT" -# Extract summary line from epoch 8 output -SUMMARY=$(echo "$OUTPUT" | grep -A1 "^(ok-len 8 " | tail -1 | tr -d '"') +# Extract summary line from epoch 9 output +SUMMARY=$(echo "$OUTPUT" | grep -A1 "^(ok-len 9 " | tail -1 | tr -d '"') if [ -z "$SUMMARY" ]; then echo "ERROR: no summary from test run" @@ -56,31 +60,35 @@ if [ -z "$SUMMARY" ]; then exit 1 fi -# Parse PARSE:N:M EVAL:N:M ERROR:N:M -PARSE_PART=$(echo "$SUMMARY" | grep -o 'PARSE:[0-9]*:[0-9]*') -EVAL_PART=$(echo "$SUMMARY" | grep -o 'EVAL:[0-9]*:[0-9]*') -ERROR_PART=$(echo "$SUMMARY" | grep -o 'ERROR:[0-9]*:[0-9]*') +# Parse PARSE:N:M EVAL:N:M ERROR:N:M NAMESPACE:N:M +PARSE_PART=$(echo "$SUMMARY" | grep -o 'PARSE:[0-9]*:[0-9]*') +EVAL_PART=$(echo "$SUMMARY" | grep -o 'EVAL:[0-9]*:[0-9]*') +ERROR_PART=$(echo "$SUMMARY" | grep -o 'ERROR:[0-9]*:[0-9]*') +NAMESPACE_PART=$(echo "$SUMMARY" | grep -o 'NAMESPACE:[0-9]*:[0-9]*') -PARSE_PASSED=$(echo "$PARSE_PART" | cut -d: -f2) -PARSE_FAILED=$(echo "$PARSE_PART" | cut -d: -f3) -EVAL_PASSED=$(echo "$EVAL_PART" | cut -d: -f2) -EVAL_FAILED=$(echo "$EVAL_PART" | cut -d: -f3) -ERROR_PASSED=$(echo "$ERROR_PART" | cut -d: -f2) -ERROR_FAILED=$(echo "$ERROR_PART" | cut -d: -f3) +PARSE_PASSED=$(echo "$PARSE_PART" | cut -d: -f2) +PARSE_FAILED=$(echo "$PARSE_PART" | cut -d: -f3) +EVAL_PASSED=$(echo "$EVAL_PART" | cut -d: -f2) +EVAL_FAILED=$(echo "$EVAL_PART" | cut -d: -f3) +ERROR_PASSED=$(echo "$ERROR_PART" | cut -d: -f2) +ERROR_FAILED=$(echo "$ERROR_PART" | cut -d: -f3) +NAMESPACE_PASSED=$(echo "$NAMESPACE_PART" | cut -d: -f2) +NAMESPACE_FAILED=$(echo "$NAMESPACE_PART" | cut -d: -f3) -PARSE_PASSED=${PARSE_PASSED:-0}; PARSE_FAILED=${PARSE_FAILED:-1} -EVAL_PASSED=${EVAL_PASSED:-0}; EVAL_FAILED=${EVAL_FAILED:-1} -ERROR_PASSED=${ERROR_PASSED:-0}; ERROR_FAILED=${ERROR_FAILED:-1} +PARSE_PASSED=${PARSE_PASSED:-0}; PARSE_FAILED=${PARSE_FAILED:-1} +EVAL_PASSED=${EVAL_PASSED:-0}; EVAL_FAILED=${EVAL_FAILED:-1} +ERROR_PASSED=${ERROR_PASSED:-0}; ERROR_FAILED=${ERROR_FAILED:-1} +NAMESPACE_PASSED=${NAMESPACE_PASSED:-0}; NAMESPACE_FAILED=${NAMESPACE_FAILED:-1} -TOTAL_PASSED=$((PARSE_PASSED + EVAL_PASSED + ERROR_PASSED)) -TOTAL_FAILED=$((PARSE_FAILED + EVAL_FAILED + ERROR_FAILED)) +TOTAL_PASSED=$((PARSE_PASSED + EVAL_PASSED + ERROR_PASSED + NAMESPACE_PASSED)) +TOTAL_FAILED=$((PARSE_FAILED + EVAL_FAILED + ERROR_FAILED + NAMESPACE_FAILED)) TOTAL=$((TOTAL_PASSED + TOTAL_FAILED)) if [ "$TOTAL_FAILED" = "0" ]; then - echo "ok $TOTAL_PASSED/$TOTAL tcl tests passed (parse: $PARSE_PASSED, eval: $EVAL_PASSED, error: $ERROR_PASSED)" + echo "ok $TOTAL_PASSED/$TOTAL tcl tests passed (parse: $PARSE_PASSED, eval: $EVAL_PASSED, error: $ERROR_PASSED, namespace: $NAMESPACE_PASSED)" exit 0 else - echo "FAIL $TOTAL_PASSED/$TOTAL passed, $TOTAL_FAILED failed (parse: $PARSE_PASSED/$((PARSE_PASSED+PARSE_FAILED)), eval: $EVAL_PASSED/$((EVAL_PASSED+EVAL_FAILED)), error: $ERROR_PASSED/$((ERROR_PASSED+ERROR_FAILED)))" + echo "FAIL $TOTAL_PASSED/$TOTAL passed, $TOTAL_FAILED failed (parse: $PARSE_PASSED/$((PARSE_PASSED+PARSE_FAILED)), eval: $EVAL_PASSED/$((EVAL_PASSED+EVAL_FAILED)), error: $ERROR_PASSED/$((ERROR_PASSED+ERROR_FAILED)), namespace: $NAMESPACE_PASSED/$((NAMESPACE_PASSED+NAMESPACE_FAILED)))" if [ -z "$VERBOSE" ]; then echo "--- output ---" echo "$OUTPUT" | tail -30 diff --git a/lib/tcl/tests/namespace.sx b/lib/tcl/tests/namespace.sx new file mode 100644 index 00000000..77f5ffd9 --- /dev/null +++ b/lib/tcl/tests/namespace.sx @@ -0,0 +1,147 @@ +; 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)))