giles
82da16e4bb
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
103 lines
2.7 KiB
Plaintext
103 lines
2.7 KiB
Plaintext
; Tcl-on-SX eval tests
|
|
(define tcl-eval-pass 0)
|
|
(define tcl-eval-fail 0)
|
|
(define tcl-eval-failures (list))
|
|
|
|
(define
|
|
tcl-eval-assert
|
|
(fn
|
|
(label expected actual)
|
|
(if
|
|
(equal? expected actual)
|
|
(set! tcl-eval-pass (+ tcl-eval-pass 1))
|
|
(begin
|
|
(set! tcl-eval-fail (+ tcl-eval-fail 1))
|
|
(append!
|
|
tcl-eval-failures
|
|
(str label ": expected=" (str expected) " got=" (str actual)))))))
|
|
|
|
(define
|
|
tcl-run-eval-tests
|
|
(fn
|
|
()
|
|
(set! tcl-eval-pass 0)
|
|
(set! tcl-eval-fail 0)
|
|
(set! tcl-eval-failures (list))
|
|
(define interp (fn () (make-default-tcl-interp)))
|
|
(define run (fn (src) (tcl-eval-string (interp) src)))
|
|
(tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
|
|
(tcl-eval-assert
|
|
"set-stored"
|
|
"hello"
|
|
(tcl-var-get (run "set x hello") "x"))
|
|
(tcl-eval-assert
|
|
"var-sub"
|
|
"hello"
|
|
(tcl-var-get (run "set x hello\nset y $x") "y"))
|
|
(tcl-eval-assert
|
|
"puts"
|
|
"world\n"
|
|
(get (run "set x world\nputs $x") :output))
|
|
(tcl-eval-assert
|
|
"puts-nonewline"
|
|
"hi"
|
|
(get (run "puts -nonewline hi") :output))
|
|
(tcl-eval-assert "incr" "6" (tcl-var-get (run "set x 5\nincr x") "x"))
|
|
(tcl-eval-assert
|
|
"incr-delta"
|
|
"8"
|
|
(tcl-var-get (run "set x 5\nincr x 3") "x"))
|
|
(tcl-eval-assert
|
|
"incr-neg"
|
|
"7"
|
|
(tcl-var-get (run "set x 10\nincr x -3") "x"))
|
|
(tcl-eval-assert
|
|
"append"
|
|
"foobar"
|
|
(tcl-var-get (run "set x foo\nappend x bar") "x"))
|
|
(tcl-eval-assert
|
|
"append-new"
|
|
"hello"
|
|
(tcl-var-get (run "append x hello") "x"))
|
|
(tcl-eval-assert
|
|
"cmdsub-result"
|
|
"42"
|
|
(get (run "set y [set x 42]") :result))
|
|
(tcl-eval-assert
|
|
"cmdsub-y"
|
|
"42"
|
|
(tcl-var-get (run "set y [set x 42]") "y"))
|
|
(tcl-eval-assert
|
|
"cmdsub-x"
|
|
"42"
|
|
(tcl-var-get (run "set y [set x 42]") "x"))
|
|
(tcl-eval-assert
|
|
"multi-cmd"
|
|
"4"
|
|
(tcl-var-get (run "set x 1\nincr x\nincr x\nincr x") "x"))
|
|
(tcl-eval-assert "semi-x" "1" (tcl-var-get (run "set x 1; set y 2") "x"))
|
|
(tcl-eval-assert "semi-y" "2" (tcl-var-get (run "set x 1; set y 2") "y"))
|
|
(tcl-eval-assert
|
|
"braced-nosub"
|
|
"$x"
|
|
(tcl-var-get (run "set x 42\nset y {$x}") "y"))
|
|
(tcl-eval-assert
|
|
"concat-word"
|
|
"foobar"
|
|
(tcl-var-get (run "set x foo\nset y ${x}bar") "y"))
|
|
(tcl-eval-assert
|
|
"set-get"
|
|
"world"
|
|
(get (run "set x world\nset x") :result))
|
|
(tcl-eval-assert
|
|
"puts-channel"
|
|
"hello\n"
|
|
(get (run "puts stdout hello") :output))
|
|
(dict
|
|
"passed"
|
|
tcl-eval-pass
|
|
"failed"
|
|
tcl-eval-fail
|
|
"failures"
|
|
tcl-eval-failures)))
|