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

; Tcl-on-SX idiom corpus (Phase 6)
; Classic Tcl idioms covering lists, dicts, procs, patterns
(define tcl-idiom-pass 0)
(define tcl-idiom-fail 0)
(define tcl-idiom-failures (list))

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

(define
  tcl-run-idiom-tests
  (fn
    ()
    (set! tcl-idiom-pass 0)
    (set! tcl-idiom-fail 0)
    (set! tcl-idiom-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-idiom-assert label expected actual)))
    (ok
      "idiom-lmap"
      (get
        (run
          "set result {}\nforeach x {1 2 3} { lappend result [expr {$x * $x}] }\nset result")
        :result)
      "1 4 9")
    (ok
      "idiom-flatten"
      (get
        (run
          "proc flatten {lst} { set out {}\n  foreach item $lst {\n    if {[llength $item] > 1} {\n      foreach sub [flatten $item] { lappend out $sub }\n    } else {\n      lappend out $item\n    }\n  }\n  return $out\n}\nflatten {1 {2 3} {4 {5 6}}}")
        :result)
      "1 2 3 4 5 6")
    (ok
      "idiom-string-builder"
      (get
        (run
          "set buf \"\"\nforeach w {Hello World Tcl} { append buf $w \" \" }\nstring trimright $buf")
        :result)
      "Hello World Tcl")
    (ok
      "idiom-default-param"
      (get (run "if {![info exists x]} { set x 42 }\nset x") :result)
      "42")
    (ok
      "idiom-alist-lookup"
      (get
        (run
          "set keys {a b c}\nset vals {10 20 30}\nset idx [lsearch $keys b]\nlindex $vals $idx")
        :result)
      "20")
    (ok
      "idiom-optional-args"
      (get
        (run
          "proc greet {name args} {\n  set greeting \"Hello\"\n  if {[llength $args] > 0} { set greeting [lindex $args 0] }\n  return \"$greeting $name\"\n}\ngreet World Hi")
        :result)
      "Hi World")
    (ok
      "idiom-dict-builder"
      (get
        (run
          "proc build-dict {args} { dict create {*}$args }\ndict get [build-dict name Alice age 30] name")
        :result)
      "Alice")
    (ok
      "idiom-loop-with-index"
      (get
        (run "set i 0\nforeach x {a b c} { set arr($i) $x; incr i }\nset arr(1)")
        :result)
      "b")
    (ok
      "idiom-string-reverse"
      (get
        (run
          "set s hello\nset chars [split $s \"\"]\nset rev [lreverse $chars]\njoin $rev \"\"")
        :result)
      "olleh")
    (ok "idiom-number-format" (get (run "format \"%05d\" 42") :result) "00042")
    (ok
      "idiom-dict-comprehension"
      (get
        (run
          "set squares {}\nforeach n {1 2 3 4} { dict set squares $n [expr {$n * $n}] }\ndict get $squares 3")
        :result)
      "9")
    (ok
      "idiom-stack"
      (get
        (run
          "proc stack-push {stackvar val} { upvar $stackvar s; lappend s $val }\nproc stack-pop {stackvar} { upvar $stackvar s; set val [lindex $s end]; set s [lrange $s 0 end-1]; return $val }\nset stk {}\nstack-push stk 10\nstack-push stk 20\nstack-push stk 30\nstack-pop stk")
        :result)
      "30")
    (ok
      "idiom-queue"
      (get
        (run
          "proc q-enq {qvar val} { upvar $qvar q; lappend q $val }\nproc q-deq {qvar} { upvar $qvar q; set val [lindex $q 0]; set q [lrange $q 1 end]; return $val }\nset q {}\nq-enq q alpha\nq-enq q beta\nq-enq q gamma\nq-deq q")
        :result)
      "alpha")
    (ok
      "idiom-pipeline"
      (get
        (run
          "proc double {x} { expr {$x * 2} }\nproc add1 {x} { expr {$x + 1} }\nproc pipeline {val procs} { foreach p $procs { set val [$p $val] }; return $val }\npipeline 5 {double add1 double}")
        :result)
      "22")
    (ok
      "idiom-memoize"
      (get
        (run
          "set cache {}\nproc cached-square {n} { global cache\n  if {[dict exists $cache $n]} { return [dict get $cache $n] }\n  set r [expr {$n * $n}]\n  dict set cache $n $r\n  return $r\n}\nset a [cached-square 7]\nset b [cached-square 7]\nset c [cached-square 8]\nexpr {$a == $b && $c == 64}")
        :result)
      "1")
    (ok
      "idiom-recursive-eval"
      (get
        (run
          "proc calc {expr} { return [::tcl::mathop::+ 0 [expr $expr]] }\nexpr {3 + 4 * 2}")
        :result)
      "11")
    (ok
      "idiom-dict-for"
      (get
        (run
          "set d [dict create a 1 b 2 c 3]\nset total 0\ndict for {k v} $d { incr total $v }\nset total")
        :result)
      "6")
    (ok
      "idiom-find-max"
      (get
        (run
          "proc list-max {lst} {\n  set m [lindex $lst 0]\n  foreach x $lst { if {$x > $m} { set m $x } }\n  return $m\n}\nlist-max {3 1 4 1 5 9 2 6}")
        :result)
      "9")
    (ok
      "idiom-filter-list"
      (get
        (run
          "proc list-filter {lst pred} {\n  set out {}\n  foreach x $lst { if {[$pred $x]} { lappend out $x } }\n  return $out\n}\nproc is-even {n} { expr {$n % 2 == 0} }\nlist-filter {1 2 3 4 5 6} is-even")
        :result)
      "2 4 6")
    (ok
      "idiom-zip"
      (get
        (run
          "proc zip {a b} {\n  set out {}\n  set n [llength $a]\n  for {set i 0} {$i < $n} {incr i} {\n    lappend out [lindex $a $i]\n    lappend out [lindex $b $i]\n  }\n  return $out\n}\nzip {1 2 3} {a b c}")
        :result)
      "1 a 2 b 3 c")
    (ok
      "env-lookup-basic"
      (env-lookup (let ((x 42)) (current-env)) "x")
      42)
    (ok
      "env-lookup-missing"
      (env-lookup (let ((x 42)) (current-env)) "z")
      nil)
    (ok
      "env-extend-lookup"
      (let
        ((e (let ((x 5)) (current-env))))
        (env-lookup (env-extend e "y" 10) "y"))
      10)
    (ok
      "eval-in-env-parent"
      (let
        ((x 5))
        (eval-in-env (env-extend (current-env) "y" 10) (quote (+ x y))))
      15)
    (ok
      "eval-in-env-multi"
      (let
        ((base (current-env)))
        (eval-in-env
          (env-extend (env-extend base "a" 3) "b" 7)
          (quote (* a b))))
      21)

    ; 26-32. Phase 5 channels: write/read/seek/tell/eof/append/non-blocking
    (ok "channel-write-read"
      (get
        (run
          "set f /tmp/tcl-phase5-1.txt\nset c [open $f w]\nputs $c \"line one\"\nputs $c \"line two\"\nclose $c\nset c [open $f r]\nset out [read $c]\nclose $c\nfile delete $f\nreturn $out")
        :result)
      "line one\nline two\n")

    (ok "channel-gets-loop"
      (get
        (run
          "set f /tmp/tcl-phase5-2.txt\nset c [open $f w]\nputs $c apple\nputs $c banana\nputs $c cherry\nclose $c\nset c [open $f r]\nset out {}\nwhile {[gets $c line] >= 0} {lappend out $line}\nclose $c\nfile delete $f\nreturn $out")
        :result)
      "apple banana cherry")

    (ok "channel-seek-tell"
      (get
        (run
          "set f /tmp/tcl-phase5-3.txt\nset c [open $f w]\nputs -nonewline $c \"hello world\"\nclose $c\nset c [open $f r]\nseek $c 6\nset pos [tell $c]\nset rest [read $c]\nclose $c\nfile delete $f\nreturn \"$pos:$rest\"")
        :result)
      "6:world")

    (ok "channel-eof-after-read"
      (get
        (run
          "set f /tmp/tcl-phase5-4.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset c [open $f r]\nread $c\nset e [eof $c]\nclose $c\nfile delete $f\nreturn $e")
        :result)
      "1")

    (ok "channel-append-mode"
      (get
        (run
          "set f /tmp/tcl-phase5-5.txt\nset c [open $f w]\nputs -nonewline $c \"first\"\nclose $c\nset c [open $f a]\nputs -nonewline $c \"-second\"\nclose $c\nset c [open $f r]\nset out [read $c]\nclose $c\nfile delete $f\nreturn $out")
        :result)
      "first-second")

    (ok "channel-seek-end"
      (get
        (run
          "set f /tmp/tcl-phase5-6.txt\nset c [open $f w]\nputs -nonewline $c \"abcdefghij\"\nclose $c\nset c [open $f r]\nseek $c 0 end\nset pos [tell $c]\nclose $c\nfile delete $f\nreturn $pos")
        :result)
      "10")

    (ok "channel-fconfigure-blocking"
      (get
        (run
          "set f /tmp/tcl-phase5-7.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset c [open $f r]\nfconfigure $c -blocking 0\nset b [fconfigure $c -blocking]\nclose $c\nfile delete $f\nreturn $b")
        :result)
      "0")

    ; 33-37. Phase 5b event loop: after / vwait / fileevent / update
    (ok "after-vwait-timer"
      (get
        (run
          "after 30 {set ::done fired}\nvwait ::done\nset ::done")
        :result)
      "fired")

    (ok "after-multiple-timers-update"
      (get
        (run
          "set ::n 0\nafter 0 {incr ::n}\nafter 0 {incr ::n}\nafter 0 {incr ::n}\nupdate\nset ::n")
        :result)
      "3")

    (ok "fileevent-readable-fires"
      (get
        (run
          "set f /tmp/tcl-phase5b-1.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset c [open $f r]\nfileevent $c readable {set ::ready 1; fileevent $::ch readable {}}\nset ::ch $c\nvwait ::ready\nclose $c\nfile delete $f\nset ::ready")
        :result)
      "1")

    (ok "fileevent-query-script"
      (get
        (run
          "set f /tmp/tcl-phase5b-2.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset c [open $f r]\nfileevent $c readable {puts hello}\nset s [fileevent $c readable]\nclose $c\nfile delete $f\nreturn $s")
        :result)
      "puts hello")

    (ok "after-cancel-via-vwait-timing"
      (get
        (run
          "set ::counter 0\nafter 10 {incr ::counter}\nafter 50 {set ::done 1}\nvwait ::done\nset ::counter")
        :result)
      "1")

    ; 38-41. Phase 5c sockets: TCP client + server
    (ok "socket-server-fires-callback"
      (get
        (run
          "proc h {sock host port} { global got; set got hit; close $sock }\nset srv [socket -server h 18901]\nset cli [socket localhost 18901]\nvwait got\nclose $srv\nclose $cli\nset got")
        :result)
      "hit")

    (ok "socket-client-server-roundtrip"
      (get
        (run
          "proc h {sock host port} { global received; gets $sock line; set received $line; close $sock }\nset srv [socket -server h 18902]\nset cli [socket localhost 18902]\nputs $cli ping\nflush $cli\nvwait received\nclose $srv\nclose $cli\nset received")
        :result)
      "ping")

    (ok "socket-server-peer-host"
      (get
        (run
          "proc h {sock host port} { global peer; set peer $host; close $sock }\nset srv [socket -server h 18903]\nset cli [socket 127.0.0.1 18903]\nvwait peer\nclose $srv\nclose $cli\nset peer")
        :result)
      "127.0.0.1")

    (ok "socket-multiple-connections"
      (get
        (run
          "proc h {sock host port} { global count; incr count; close $sock }\nset count 0\nset srv [socket -server h 18904]\nset c1 [socket localhost 18904]\nset c2 [socket localhost 18904]\nset c3 [socket localhost 18904]\nwhile {$count < 3} { update; after 5 }\nclose $srv\nclose $c1\nclose $c2\nclose $c3\nset count")
        :result)
      "3")

    ; 42-49. Phase 5d file metadata + ops
    (ok "file-isfile-true"
      (get
        (run
          "set f /tmp/tcl-phase5d-1.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset r [file isfile $f]\nfile delete $f\nreturn $r")
        :result)
      "1")

    (ok "file-isfile-false-on-dir"
      (get (run "file isfile /tmp") :result)
      "0")

    (ok "file-isdir-true"
      (get (run "file isdir /tmp") :result)
      "1")

    (ok "file-size"
      (get
        (run
          "set f /tmp/tcl-phase5d-2.txt\nset c [open $f w]\nputs -nonewline $c hello\nclose $c\nset s [file size $f]\nfile delete $f\nreturn $s")
        :result)
      "5")

    (ok "file-readable-true"
      (get (run "file readable /tmp") :result)
      "1")

    (ok "file-readable-missing"
      (get (run "file readable /no/such/path/here") :result)
      "0")

    (ok "file-mkdir-then-isdir"
      (get
        (run
          "set d /tmp/tcl-phase5d-mkdir/sub\nfile mkdir $d\nset r [file isdir $d]\nfile delete $d\nfile delete /tmp/tcl-phase5d-mkdir\nreturn $r")
        :result)
      "1")

    (ok "file-copy-roundtrip"
      (get
        (run
          "set s /tmp/tcl-phase5d-src.txt\nset d /tmp/tcl-phase5d-dst.txt\nset c [open $s w]\nputs -nonewline $c copydata\nclose $c\nfile copy $s $d\nset c [open $d r]\nset out [read $c]\nclose $c\nfile delete $s\nfile delete $d\nreturn $out")
        :result)
      "copydata")

    (ok "file-rename-then-exists"
      (get
        (run
          "set s /tmp/tcl-phase5d-r1.txt\nset d /tmp/tcl-phase5d-r2.txt\nset c [open $s w]\nputs -nonewline $c x\nclose $c\nfile rename $s $d\nset r [list [file exists $s] [file exists $d]]\nfile delete $d\nreturn $r")
        :result)
      "0 1")

    (ok "file-mtime-positive"
      (get
        (run
          "set f /tmp/tcl-phase5d-mt.txt\nset c [open $f w]\nputs -nonewline $c x\nclose $c\nset m [file mtime $f]\nfile delete $f\nexpr {$m > 0}")
        :result)
      "1")

    ; 52-56. Phase 5e clock format options + clock scan
    (ok "clock-format-utc"
      (get
        (run "clock format 0 -format {%Y-%m-%d %H:%M:%S} -gmt 1")
        :result)
      "1970-01-01 00:00:00")

    (ok "clock-format-fmt-default"
      (get
        (run "clock format 1710513000 -format {%Y-%m-%d} -gmt 1")
        :result)
      "2024-03-15")

    (ok "clock-scan-roundtrip"
      (get
        (run "set t [clock scan {2024-06-15 12:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1]\nclock format $t -format {%Y-%m-%d %H:%M:%S} -gmt 1")
        :result)
      "2024-06-15 12:00:00")

    (ok "clock-scan-returns-int"
      (get
        (run "expr {[clock scan {1970-01-01 00:00:00} -format {%Y-%m-%d %H:%M:%S} -gmt 1] == 0}")
        :result)
      "1")

    (ok "clock-format-percent-pct"
      (get
        (run "clock format 0 -format {%Y%%%m} -gmt 1")
        :result)
      "1970%01")

    ; 57-59. Phase 5f socket -async (non-blocking connect)
    (ok "socket-async-completes-writable"
      (get
        (run
          "proc h {sock host port} { close $sock }\nset srv [socket -server h 18930]\nset c [socket -async localhost 18930]\nset ready 0\nfileevent $c writable {global ready; set ready 1}\nvwait ready\nclose $c\nclose $srv\nset ready")
        :result)
      "1")

    (ok "socket-async-then-write"
      (get
        (run
          "proc accept {sock host port} { global accepted_sock; set accepted_sock $sock; fileevent $sock readable [list reader $sock] }\nproc reader {sock} { global received; gets $sock line; set received $line; close $sock }\nset srv [socket -server accept 18931]\nset c [socket -async localhost 18931]\nfileevent $c writable {global wready; set wready 1; fileevent $::ch writable {}}\nset ::ch $c\nvwait wready\nputs $c async-data\nflush $c\nvwait received\nclose $c\nclose $srv\nset received")
        :result)
      "async-data")

    (ok "socket-async-no-error"
      (get
        (run
          "proc h {sock host port} { close $sock }\nset srv [socket -server h 18932]\nset c [socket -async localhost 18932]\nset r 0\nfileevent $c writable {global r; set r 1}\nvwait r\nset err [fconfigure $c -error]\nclose $c\nclose $srv\nreturn $err")
        :result)
      "")

    ; 60-63. Phase 6a namespace :: prefix
    (ok "ns-set-from-proc-reaches-global"
      (get
        (run
          "proc f {x} { set ::g $x }\nf hello\nset ::g")
        :result)
      "hello")

    (ok "ns-read-from-proc"
      (get
        (run
          "set ::v 42\nproc f {} { return $::v }\nf")
        :result)
      "42")

    (ok "ns-incr-via-prefix"
      (get
        (run
          "set ::n 5\nproc bump {} { incr ::n }\nbump\nbump\nset ::n")
        :result)
      "7")

    (ok "ns-different-from-local"
      (get
        (run
          "set x outer\nproc f {} { set x inner; set ::x global; return $x }\nf")
        :result)
      "inner")

    ; 64-69. Phase 6b list ops (lassign, lrepeat, lset, lmap)
    (ok "lassign-three"
      (get (run "lassign {a b c d e} x y z\nlist $x $y $z") :result)
      "a b c")

    (ok "lassign-leftover"
      (get (run "lassign {1 2 3 4 5} a b") :result)
      "3 4 5")

    (ok "lrepeat-basic"
      (get (run "lrepeat 3 a") :result)
      "a a a")

    (ok "lrepeat-multi"
      (get (run "lrepeat 2 x y") :result)
      "x y x y")

    (ok "lset-replaces"
      (get (run "set L {a b c d}\nlset L 2 ZZ\nset L") :result)
      "a b ZZ d")

    (ok "lmap-square"
      (get (run "lmap n {1 2 3 4} {expr {$n * $n}}") :result)
      "1 4 9 16")

    ; 70-72. Phase 6c dict additions (lappend, remove, filter)
    (ok "dict-lappend-extends"
      (get (run "set d {tags {a b}}\ndict lappend d tags c d\nset d") :result)
      "tags {a b c d}")

    (ok "dict-remove"
      (get (run "dict remove {a 1 b 2 c 3} b") :result)
      "a 1 c 3")

    (ok "dict-filter-key"
      (get (run "dict filter {alpha 1 beta 2 gamma 3} key a*") :result)
      "alpha 1")

    ; 73-79. Phase 6d format and scan
    (ok "format-int-padded"
      (get (run "format {%05d} 42") :result)
      "00042")

    (ok "format-float-precision"
      (get (run "format {%.2f} 3.14159") :result)
      "3.14")

    (ok "format-hex"
      (get (run "format {%x} 255") :result)
      "ff")

    (ok "format-char"
      (get (run "format {%c} 65") :result)
      "A")

    (ok "format-string-left"
      (get (run "format {%-5s|} hi") :result)
      "hi   |")

    (ok "scan-two-ints"
      (get (run "scan {12 34} {%d %d} a b\nlist $a $b") :result)
      "12 34")

    (ok "scan-count"
      (get (run "scan {hello 42} {%s %d}") :result)
      "hello 42")

    ; 80-82. Phase 6e exec
    (ok "exec-echo"
      (get (run "exec echo hello world") :result)
      "hello world")

    (ok "exec-printf-no-newline"
      (get (run "exec /bin/printf x") :result)
      "x")

    (ok "exec-with-args"
      (get (run "exec /bin/echo -n test") :result)
      "test")

    ; 83-87. Phase 7a try/trap with varlist
    (ok "try-trap-prefix-match"
      (get
        (run
          "try {throw {ARITH DIVZERO} divide-by-zero} trap {ARITH} {res} {set caught $res}")
        :result)
      "divide-by-zero")

    (ok "try-trap-full-pattern"
      (get
        (run
          "try {throw {FOO BAR} bad} trap {FOO BAR} {res} {return matched-foo-bar}")
        :result)
      "matched-foo-bar")

    (ok "try-on-error-opts"
      (get
        (run
          "try {error oops} on error {res opts} {dict get $opts -code}")
        :result)
      "1")

    (ok "try-trap-no-match-falls-through"
      (get
        (run
          "set caught notrun\ncatch {try {throw {NOPE} bad} trap {OTHER} {r} {set caught matched}}\nset caught")
        :result)
      "notrun")

    (ok "try-trap-then-on-error"
      (get
        (run
          "try {error generic} trap {SPECIFIC} {r} {return trap-fired} on error {r} {return on-error-fired}")
        :result)
      "on-error-fired")

    ; 88-92. Phase 7b exec pipelines + redirection
    (ok "exec-pipeline-tr"
      (get (run "exec echo hello world | tr a-z A-Z") :result)
      "HELLO WORLD")

    (ok "exec-pipeline-wc"
      (get (run "exec /bin/echo abc | wc -c") :result)
      "4")

    (ok "exec-redirect-stdout"
      (get
        (run
          "set f /tmp/tcl-7b-out.txt\nexec echo hello > $f\nset r [exec cat $f]\nfile delete $f\nreturn $r")
        :result)
      "hello")

    (ok "exec-redirect-stdin"
      (get
        (run
          "set f /tmp/tcl-7b-in.txt\nset c [open $f w]\nputs -nonewline $c hi\nclose $c\nset r [exec cat < $f]\nfile delete $f\nreturn $r")
        :result)
      "hi")

    (ok "exec-pipeline-three-stages"
      (get (run "exec echo {alpha beta gamma} | tr { } \\n | wc -l") :result)
      "3")

    ; 93-99. Phase 7c string command audit
    (ok "string-equal"
      (get (run "string equal hello hello") :result)
      "1")

    (ok "string-equal-nocase"
      (get (run "string equal -nocase HELLO hello") :result)
      "1")

    (ok "string-totitle"
      (get (run "string totitle hello") :result)
      "Hello")

    (ok "string-reverse"
      (get (run "string reverse hello") :result)
      "olleh")

    (ok "string-replace"
      (get (run "string replace hello 1 3 ZZZ") :result)
      "hZZZo")

    (ok "string-is-xdigit-yes"
      (get (run "string is xdigit ff00aa") :result)
      "1")

    (ok "string-is-true-yes"
      (get (run "string is true yes") :result)
      "1")

    ; 100-105. Phase 7e regexp anchoring/boundary audit
    (ok "regexp-anchor-start"
      (get (run "regexp {^hello} hello-world") :result)
      "1")

    (ok "regexp-anchor-end"
      (get (run "regexp {world$} hello-world") :result)
      "1")

    (ok "regexp-word-boundary"
      (get (run "regexp {\\bword\\b} \"the word here\"") :result)
      "1")

    (ok "regexp-nocase"
      (get (run "regexp -nocase {HELLO} hello") :result)
      "1")

    (ok "regexp-capture-var"
      (get (run "regexp {[0-9]+} abc123def captured\nset captured") :result)
      "123")

    (ok "regsub-all"
      (get (run "regsub -all {[0-9]+} a1b22c333 X") :result)
      "aXbXcX")

    ; 106-110. Phase 7d TclOO basics
    (ok "oo-class-method"
      (get
        (run
          "oo::class create C {\nmethod get {} { return 42 }\n}\nset c [C new]\n$c get")
        :result)
      "42")

    (ok "oo-constructor"
      (get
        (run
          "oo::class create G {\nconstructor {n} { set ::gname $n }\nmethod hello {} { return [string cat \"hi \" $::gname] }\n}\nset g [G new World]\n$g hello")
        :result)
      "hi World")

    (ok "oo-inheritance-overridden"
      (get
        (run
          "oo::class create Animal {\nmethod sound {} { return generic }\n}\noo::class create Dog {\nsuperclass Animal\nmethod sound {} { return woof }\n}\nset d [Dog new]\n$d sound")
        :result)
      "woof")

    (ok "oo-inheritance-inherited"
      (get
        (run
          "oo::class create Animal {\nmethod sound {} { return generic }\n}\noo::class create Cat {\nsuperclass Animal\n}\nset c [Cat new]\n$c sound")
        :result)
      "generic")

    (ok "oo-multiple-instances"
      (get
        (run
          "oo::class create N {\nconstructor {x} { set ::nval $x }\nmethod get {} { return $::nval }\n}\nset a [N new 1]\nset b [N new 99]\n$b get")
        :result)
      "99")

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