shell

#!./pickle
# vim: syntax=tcl
#
# This file contains unit tests for the Pickle Interpreter. The things tested
# in this file are mainly the commands and sub-commands that perform simple
# functions, and not basic language constructions (and commands like 'if',
# or 'while') as we would have to use those constructs as part of the test
# framework itself. Instead, those things should be considered tested if
# the test framework itself runs.
#
# The file also contains a simple performance test and a fairly usable
# shell.
#

# Defining the function 'tracer' installs this function for tracing,
# which can be turned on or off with 'trace', a quirk of this interpreter
# implementation.
proc tracer {args} {
	set args [string tr r "\t\x1b\r\n" " " ${args}]
	set args [string tr s " " ${args}]
	puts "+[info cmdcount]/[info level]: ${args}"
}

# Execute and monitor a command
proc monitor {args} {
	set r [catch "uplevel 1 {trace on; $args; trace off}" v]
	trace off
	return $v $r
}

# A getopt inspired from <https://wiki.tcl-lang.org/page/getopt>
#
# Usage:
#
# getopt argv -x
# getopt argv -x opt
# getopt argv -x opt default
#
# Returns: 1 on argument found in ${argv}, 0 on argument not found in ${argv}
#
proc getopt {ax opt args} {
	upvar 1 ${ax} alist
 	set var [lindex $args 0]
 	set def [lindex $args 1]
 	set pos [lsearch $alist ${opt}*]
	if {>= ${pos} 0} {
 		set to ${pos}
		if {ne ${var} ""} {
			upvar 1 ${var} v
			set v [lindex $alist [incr to]]
		}
 		set alist [lreplace $alist $pos $to]
		return 1
	}
	if {ne ${var} ""} {
		upvar 1 ${var} v
		set v $def
	}
	return 0
}

set testing off
set shell on
if {getopt argv -T} { trace on }
while {getopt argv -e line} { set shell off; eval $line }; unset line;
if {getopt argv -t} { set shell off; set testing on; };
if {getopt argv -s} { set shell on }
getopt argv -S seed [clock seconds]
getopt argv -F fail 0
heap fail-after $fail
unset fail

if {getopt argv -h} {
	puts "Usage: [lindex $argv 1] -\[tsphT\] \[-S seed\] \[-e string\]"
	puts ""
	puts "\t-t\tRun the system tests"
	puts "\t-s\tRun a shell (default)"
	puts "\t-p\tRun a crude performance test"
	puts "\t-h\tPrint this help message and quit"
	puts "\t-e str\tEvaluate a string"
	puts "\t-T\tTurn tracing on"
	puts "\t-S #\tSet the seed for the PRNG"
	puts "\t-F #\tIntroduce memory fault after # allocations"
	puts ""
	break
}

if {getopt argv -p} {
	proc decr {x} { upvar 1 $x i; set i [- $i 1] }

	proc waste1 {x} {
		set loop $x;
		while {!= 0 $loop} {
			decr loop
		}
	}

	proc waste2 {x} {
		set loop $x;
		while {!= 0 $loop} {
			incr loop -1
		}
	}

	proc performance {func} {
		puts "testing: $func"
		set c [clock clicks]
		set t [info cmdcount]
		# Takes about a second on my machine;
		$func 200000;
		puts "cmds:    [- [info cmdcount] $t]"
		puts "time:    [- [clock clicks] $c]"
		puts
	}

	performance waste1
	performance waste2

	rename decr ""
	rename waste1 ""
	rename waste2 ""
	rename performance ""
	break
}

if {getopt argv -} {
	puts "Error command line option"
	puts "Use '-h' to see a list of valid options"
	return "" -1
}

# This Non Cryptographically Secure Pseudo Random Number Generator
# is based of off XORSHIFT 32 (see <https://en.wikipedia.org/wiki/Xorshift>).
# It SHOULD NOT be used for cryptographic purposes. A seed of zero is checked
# for, and changed to a one, as a seed of zero produces only zeros. One
# difference between XORSHIFT 32 and this version is that arithmetic is not
# done modulo 2 to the power of 32.
#
# The "seed" variable is seed to the clock in seconds, which is better than
# nothing but a very poor entropy source. The seed is set during argument
# processing.
proc random {args} {
	upvar #0 seed x;
	set alen [llength $args]
	if {> $alen 1 } { return "Error args" -1 }
	set ns [lindex $args 0]
	if {> $alen 0 } { set x $ns }
	if {== $x 0} { incr x; }
	set x [xor $x [lshift $x 13]];
	set x [xor $x [rshift $x 17]];
	set x [xor $x [lshift $x  5]];
}
# Call 'random' a few times, using a small seed usually means the first
# few numbers are quite small as well.
for {set i 0} {< $i 10} {incr i} { random }
unset i

# TCL supports two version of 'foreach', this only does one of those
# versions: for each element in the list 'l' set the variable named by
# 'v' to that element then execute 'b'.
proc foreach {v l b} {
	set ll [llength $l];
	set t ""
	upvar 1 $v m
	for {set i 0} {< $i $ll} {incr i} {
		set x [lindex $l $i]
		uplevel 1 "set $v {[set x]};";
		set r [uplevel 1 catch "{$b}" $v]
		set t $m
		set m $x
		if {or [== $r 1] [== $r 2]} { return $t 0 }
		if {!= $r 0} { return $t $r }
	}
	return $t 0
}

proc match {x y} { string match $x $y }

proc switch {args} {
	set f eq
	set nc 0
	if {getopt args -glob} { set f match }
	if {getopt args -nocase} { set nc 1 }
	set w [llength $args]
	set on [lindex $args 0]
	set c [lindex $args [- $w 1]]
	set w [llength $c]
	set d ""
	if {set nc} { set on [string tolower $on] }
	for {set i 0} {< $i $w} {incr i} {
		set m [lindex $c $i]
		if {set nc} { set m [string tolower $m] }
		set e [lindex $c [incr i]]
		if {$f $on $m} { return [uplevel 1 eval $e] }
		if {eq $m default} { set d $e }
	}
	if {ne $d ""} {
		return [uplevel 1 eval $e]
	}
	return ""
}

# This is a limited version of the 'format' command, this could have been made
# to be a built in C function for the sake of efficiency, and if you find
# yourself using the command a lot then it might be worth doing that.
proc format {fmt args} {
	set l [split $fmt ""]
	set w [llength $l]
	set r ""
	for {set i 0; set j 0} {< $i $w} {incr i} {
		set o [lindex $l $i]
		if {eq $o "%"} {
			set s [lindex $l [incr i]]
			set v [lindex $args $j]
			incr j
			if {eq $s %} { set r $r%
			} elseif {eq $s s} { set r $r$v
			} elseif {eq $s x} { set r $r[string dec2hex $v]
			} elseif {eq $s X} { set r $r[string toupper [string dec2hex $v]]
			} elseif {eq $s o} { set r $r[string dec2base $v 8]
			} elseif {eq $s c} { set r $r[string char $v]
			} else { return "Error format $s" -1 }
		} else {
			set r $r$o
		}
	}
	return $r
}

# ### Shell Handler ### #

proc color {c} {
	if {ne [getenv COLOR] on} { return "" }
	if {eq $c "reset"} { return "\x1b\[0m" }
	set i [lsearch {black red green yellow blue magenta cyan white} $c]
	return "\x1b\[3$i;1m"
}

# Making these variables would be more efficient, however they would have
# to be accessed via upvar, functions do not.
proc normal {} "return {[color reset]}"
proc red    {} "return {[color red]}"
proc green  {} "return {[color green]}"
proc blue   {} "return {[color blue]}"
rename color ""

# Unfortunately this does not write to stderr.
proc error {msg args} {
	set r -1
	set alen [llength $args]
	if {> $alen 1} { return "Error args" -1 }
	if {> $alen 0} {
		set d [lindex $args 0]
		if {== 0 [string is integer $d]} { return "Error invalid number: $d" -1 }
		set r $d
	}
	puts $msg;
	return "" $r
}

proc lremove {lst args} {
	set l [llength $args]
	for {set i 0} {< $i $l} {incr i} {
		set v [lindex $args $i]
		set lst [lreplace $lst $v $v]
	}
	return $lst
}

proc lprepend {varName args} {
   upvar 1 $varName var
   lappend var
   set var [eval [list linsert $var 0] $args]
}

proc lassign {dats args} {
	set ld [llength $dats]
	set la [llength $args]
	for {set i 0} {< $i $la} {incr i} {
		set var [lindex $args $i]
		set val ""
		if {< $i $la} { set val [lindex $dats $i] }
		upvar 1 $var $var
		set $var $val
	}
	return [lrange $dats $i $ld]
}

# Decompiler, of sorts. The name 'see' comes from Forth, like the function
# 'words' which is also from Forth.

proc words {} { lsort [info commands] }

proc see {w} {
	if {eq "" [info commands $w]} {
		return "'$w' is not defined" -1
	}
	set type proc
	set args [info args $w]
	if {eq "" [info procs $w]} {
		set type "built-in"
		set args [info private $w]
	}
	set body [info body $w]
	return "$type [list $w] {$args} {$body}"
}

proc global {args} { 
	set l [llength $args]
	for {set i 0} {< $i $l} {incr i} {
		set x [lindex $args $i]
		uplevel 1 upvar #0 $x $x 
	}
}

proc time {x args} {
	set c 1;
	if {ne $args ""} { set c $args }
	set t [clock clicks]
	for {set i 0} {< $i $c} {incr i} { uplevel 1 $x }
	return [- [clock clicks] $t] 0
}

proc bye {} { exit }
proc quit {args} { exit }

proc {stack dump} {} {
	set l [+ [info level] 0]
	for {set i 1} {<= $i $l} {incr i} {
		set q [uplevel $i {info locals}]
		set m [llength $q]
		set r ""
		for {set j 0} {< $j $m} {incr j} {
			set var [uplevel $i "lindex {$q} $j"]
			set val [uplevel $i set $var]
			lappend r [list $var $val]
		}
		puts "[- $i 1]: $r"
	}
}


proc io {} {
	set e [catch {gets} l]
	if {or [eq $e 2] [eq $e -1]} {
		if {eq $l "EOF"} { return "EOF" 2 }
		return "ERROR" 2
	}
	return $l
}

set HOME "HOME"
set OS Unix
if {eq [getenv OS] "Windows_NT" } {
	set OS Windows
	set HOME "HOMEPATH"
}

if {set shell} {
	unset shell testing
	catch {source "[getenv [uplevel #0 set HOME]]/.picklerc"}
	proc prompt {} { return "pickle> " }
	set count 0
	while { } {
		incr count
		puts -nonewline [prompt]
		set line [string trim [io]]
		set retcode [catch {eval $line} result]
		set fail [red]
		if {== $retcode 0} { set fail [green] }
		puts "\[$fail$retcode[normal]\] $result"
		unset fail retcode line result
	}
	puts
	break
}

if {eq off $testing} {
	break
}

# ### Clean up   ### #

#rename tracer ""
rename monitor ""
rename see   ""
rename words ""
rename io    ""
unset shell testing

# ### Unit Tests ### #

set passed 0
set total  0

# BUG: If the unit test sets the value of 'x' then it can mess
# up printing the error.
proc test {result x} {
	set retcode [catch $x r]
	upvar #0 total t
	incr t

	set f "[red]FAIL[normal]:  (expected \"$result\") "
	if {and [eq $r $result] [eq 0 $retcode]} {
		uplevel #0 { set passed [+ $passed 1] }
		set f "[green]ok[normal]:    "
	}
	puts "$f{$x} = \"$r\""
}

# Test failure cases
proc fails {x} {
	set retcode [catch $x r]
	upvar #0 total t
	incr t
	set f "[red]FAIL[normal]:  "
	if {== $retcode -1} {
		uplevel #0 { set passed [+ $passed 1] }
		set f "[green]ok[normal]:    "
	}
	puts [string tr r "\n\r" " " "$f{$x} returns \"$r\""]
}

proc state {x} {
	puts "[blue]state[normal]: $x"
	eval $x
}

puts "SYSTEM OPTIONS"
puts "Version:      [join [info version] .]"
puts "Pointer Size: [info system pointer]"
puts "Number  Size: [info system number]"
puts "Limits: "
puts "\trecursion:  [info system recursion]"
puts "\tstring:     [info system length]"
puts "\tminimum:    [info system min]"
puts "\tmaximum:    [info system max]"
puts "Features:"
puts "\tstring:     [info system string]"
puts "\tmaths:      [info system maths]"
puts "\tdebugging:  [info system debugging]"
puts "\tstrict:     [info system strict]"
puts "Heap Usage:"
puts "\tallocs:     [heap allocations]"
puts "\tfrees:      [heap frees]"
puts "\trealloc:    [heap reallocations]"
puts "\ttotal:      [heap total] ([/ [heap total] 1024]KiB)"

puts "\n\[Pickle Tests\]\n"
puts "Date: [clock format [clock seconds] {%Y/%m/%d %H:%M:%S}]\n"

test hello {if {bool 1} { concat "hello" }}
test 1 {bool 4}
test 0 {bool 0}
fails {bool}
fails {$a}

if {== 0 [info system strict]} {
	test 0 {bool 0b1}
	test 1 {bool 9b1}
	test 1 {== 0 abc}
	test 1 {!= 0 1abc}
	test 1 {not x}
}

fails {if}
fails {if { }}
# NB. Different from TCL, which is an error
test 1 {if { } { return 1 0 } else { return 2 0 }}
test 2 {if {== 0 1} { return 1 0 } else { return 2 0 }}
test 3 {if {== 0 1} { return 1 0 } elseif {== 1 1} { return 3 0 } else { return 2 0 }}
test 3 {if {== 0 1} { return 1 0 } elseif {== 1 1} { return 3 0 }}
# Quirk - the result of the last condition is returned
test "0" {if {== 0 1} { return 1 0 } elseif {== 1 2} { return 3 0 }}
fails {if {== 0 0} { puts a } not-else { puts b } else { puts c }}
fails {if {== 0 0} { puts a } else}
fails {if {== 0 0} { puts a } not-else { puts b }}
fails {if {== 0 0} { puts a } not-elseif { } { puts b }}
fails {set}
fails {while}
fails {while {== 0 x} { puts "not run" }}
state {proc recurse {} { recurse }}
fails {recurse}
state {rename recurse ""}
fails {[}
fails {]}
test 1 {== 2 2}
test 1 {!= 0 2}
test 1 {== -0 0}
test 0 {== -1 1}
test 4 {+ 2 2}
test -4 {+ 2 -6}
fails {+ 2 a}
fails {+ 2}
test -4 {- 2 6}
test 16 {* -2 -8}
test 720 {* 1 2 3 4 5 6}
test 1 "< 3 4"
test 0 {< 5 -5}
test -25 {* 5 -5}
test 60 {* 3 4 5}
test -60 {* -3 4 5}
test 60 {* -3 4 -5}
test 1 {< 6 9}
test 1 {< 6 9 10 7}
test 0 {< 6 9 10 6}
test 0 {> 6 9}
test 0 {> -6 9}
test 1 {>= -6 -6}
test 1 {>= 6 -6}
test 0 {>= -6 6}
test 4 {lshift 1 2}
test 5 {rshift 10 1}
test 8 {lshift 1 1 1 1}
test 16 {lshift 2 1 1 1}
test 9 {min 90 9}
test -9 {min 90 -9}
test -4 {max -5 -4}
test 4 {min 90 8 4 6 7 89}
test 4 {abs 4}
test 4 {abs -4}
test -1 {+ [invert 1] 1}
test 170 {and 255 [invert 85]}
test 170 {and 255 [~ 85]}
test 3 {or 1 2}
test 2 {or 2 2}
test 2 {or 2 2 2}
test 255 {or 85 170}
test 3 {| 1 2}
test 2 {| 2 2}
test 2 {| 2 2 2}
test 255 {| 85 170}
test 3 {xor 1 2}
test 0 {xor 2 2}
test 2 {xor 2 2 2}
test 255 {xor 85 170}
test 3 {^ 1 2}
test 0 {^ 2 2}
test 2 {^ 2 2 2}
test 1 {^ 1 1 1}
test 255 {^ 85 170}
test 0 {and 85 170}
test 1 {and 1 1 1}
test 0 {and 1 0 1 1}
test 0 {and 0 0 0}
test 0 {& 85 170}
test 1 {& 1 1 1}
test 0 {& 1 0 1 1}
test 0 {& 0 0 0}
test 0 {&& 0 0}
test 1 {&& 1 1}
test 1 {&& 1 2}
test 1 {&& 1 2 3}
test 0 {&& 1 2 0 3}
test 0 {|| 0 0}
test 0 {|| 0 0 0}
test 1 {|| 0 9 0}
test 1 {|| 1 9}
test 0 {not 3}
test 1 {not 0}
test 0 {! 3}
test 1 {! 0}
test 3 {/ 12 4}
test 2 {/ 20 5 2}
test 10 {+ 4 1 3 2}
test -2 {- 2 3 1}
fails {/ 1 0}
fails {/ 4 4 0}
fails {/ 0 0}
test 4 {mod 4 12}
fails {mod 4 0}
test 11 {mod 11 12}
test 0 {mod 12 12}
test 1 {mod 13 12}
test -3 {negate 3}
test 3 {negate -3}
test 8 {pow 2 3}
test 9   {pow 3 2}
test 81  {pow 3 2 2}
test 1   {pow 9 0}
test -8  {pow -2 3}
test 4   {pow -2 2}
test -2  {pow -2 1}
test 1   {pow -2 0}
test 16  {pow 2 2 2}
test 3 {log 8 2}
# Integer logarithm!
test 3 {log 9 2}
test 4 {log 16 2}
test 2 {log 100 10}
test 2 {log 16 2 2}
test 2 {log 81 3 2}
fails {log}
fails {log 10}
fails {log 10 0}
fails {log 0 10}
test "ABC" {set z A; set z ${z}BC }
test "ABC" {set z B; set z A${z}C }
test "ABB" {set z B; set z A${z}${z} }
test 120 {set cnt 5; set acc 1; while {> $cnt 1} { set acc [* $acc $cnt]; incr cnt -1 }; set acc; };
test 1 {eq a a}
fails {eq}
fails {eq a}
test 0 {eq a b}
test 1 {ne abc ""}
test 1 {eq "" ""}
test {a b} {concat a b}
test {a b c d e f {g h}} {concat a b "c d e  " "  f {g h}"}
test a,b,c {join {a b c} ,}
test "a,b c,d" {join {a {b c} d} ,}
test a {join a ,}
test "" {join "" ,}
fails {join}
fails {join {}}
test a##b##c##d {join {a b c d} ##}  
test abcxd      {join {a b cx d} ""} 
test "e;f;g;h"  {join {e f g h} ";"} 
state {proc square {x} { * $x $x }}
test 16 {square 4}
fails {square a}
state {rename square sq}
state {proc fib {x} { if {<= $x 1} { return 1; } else { + [fib [- $x 1]] [fib [- $x 2]]; } }}
test 89 {fib 10}
test fib {info commands fib}
state {rename fib ""}
test "" {info commands fib}
test 16 {sq 4}
state {rename sq ""}
test 1 {info complete ""}
test 0 {info complete "\""}
test 1 {info complete "\"\""}
test 1 {info complete "{}"}
fails {info}
fails {set e {eval $e}; eval $e}
fails {set l [string repeat * [* 2 [info system recursion]]]; string match $l $l }
fails {string}
test 3 {string length 123}
test 4 {string length 1234}
test 4 {string length abcd}
test 0 {string length ""}
test 0 {string length {}}
fails {string length}
test 1 {string match "" ""}
test 1 {string match "*" ""}
test 1 {string match "*" "a"}
test 1 {string match "*" "aaa"}
test 0 {string match {\*} ""}
test 0 {string match {\*} "a"}
test 0 {string match {\*} "aaa"}
test 1 {string match "?" "?"}
test 1 {string match "?" "a"}
test 1 {string match {\*} *}
test 1 {string match {\?} ?}
test 1 {string match "???" "abc"}
test 1 {string match "???" "abc"}
test 0 {string match "???" "abcd"}
test 0 {string match "abc" "abcd"}
test 1 {string match "abc" "abc"}
test 1 {string match "abc*" "abc"}
test 0 {string match "abc*d" "abc"}
test 1 {string match "abc*d" "abcd"}
test 0 {string match "abc*d" "aBcd"}
test 1 {string match "abc*d" "abcXXXXd"}
test 1 {string match "*" "ahoy!"}
test 1 {string match "*abc*c?d" "xxxxxabcxxxxc3d"}
test 1 {string match "*abc*c?d" "xxxxxabcxxxxc?d"}
fails {string match}
fails {string match ""}
test ""     {string reverse ""}
test "a"    {string reverse "a"}
test "ba"   {string reverse "ab"}
test "cba"  {string reverse "abc"}
test "dcba" {string reverse "abcd"}
test "ba0"  {string reverse "\x30ab"}
fails {string reverse}
test ""        {string trimleft ""}
test ""        {string trimleft "   "}
test "x "      {string trimleft "  x "}
test "x b"     {string trimleft "  x b"}
test "123ABC." {string toupper "123aBc."}
test "123abc." {string tolower "123aBc."}
fails {string tolower}
test 0 {string equal a b}
test 1 {string equal a a}
test 1 {< 0 [string compare a A]}
test 1 {> 0 [string compare bA ba]}
test 0 {string compare-no-case a a}
test 0 {string compare-no-case a A}
test 0 {string compare-no-case B b}
test 0 {string compare-no-case abc ABC}
test 1 {> 0 [string compare-no-case a B]}
test 1 {> 0 [string compare-no-case A b]}
test h {string index hello 0}
test e {string index hello 1}
test l {string index hello 3}
test o {string index hello 4}
test o {string index hello 9}
test o {string index hello -1}
test l {string index hello -2}
test h {string index hello -9}
fails {string index hello x}
fails {string index hello}
fails {string index}
test "" {string repeat abc 0}
test "abc" {string repeat abc 1}
test "abcabc" {string repeat abc 2}
test "aaa" {string repeat a 3}
fails {string repeat}
fails {string repeat a}
fails {string repeat a -1}
fails {string repeat a a}
fails {string is}
test 1 {string is digit ""}
test 1 {string is digit 1234567890}
test 0 {string is digit 123a}
test 1 {string is alnum ""}
test 1 {string is alnum 123a}
test 0 {string is alnum 123.}
test 0 {string is alpha 123.}
test 0 {string is alpha 123a.}
test 1 {string is alpha abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test 1 {string is ascii ""}
test 0 {string is ascii "a\x80a"}
test 0 {string is ascii "\x82"}
test 1 {string is ascii "\x01"}
test 1 {string is ascii "\x1 "}
test 1 {string is ascii "\x1"}
test 1 {string is ascii "aa"}
test 1 {string is ascii "\x7f"}
test 1 {string is xdigit ""}
test 1 {string is xdigit "1234567890ABCDEFabcdef"}
test 0 {string is xdigit "1234567890ABCDEFabcdefQ"}
test 0 {string is lower "aB"}
test 1 {string is lower "abcdefghijklmnopqrstuvwxyz"}
test 0 {string is lower "abcdefghijklmnopqrstuvwxyz "}
test 0 {string is lower "aa123"}
test 1 {string is lower ""}
test 0 {string is upper "aB"}
test 1 {string is upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ"}
test 0 {string is upper "ABCDEFGHIJKLMNOPQRSTUVWXYZ "}
test 0 {string is upper "AA123"}
test 1 {string is upper ""}
test 1 {string is wordchar ""}
test 1 {string is wordchar "ABCDEFGHIJKLMNOPQRSTUVWXYZ012345789abcdefghijklmnopqrstuvwxyz_"}
test 0 {string is wordchar " ABCDEFGHIJKLMNOPQRSTUVWXYZ012345789abcdefghijklmnopqrstuvwxyz_"}
test 0 {string is wordchar " "}
test 0 {string is wordchar ":"}
test 0 {string is integer ""}
test 0 {string is integer " 0"}
test 0 {string is integer "123a"}
test 0 {string is integer " 123"}
test 0 {string is integer "0x123"}
test 0 {string is integer "++0"}
test 0 {string is integer "-"}
test 0 {string is integer "+"}
test 1 {string is integer "0"}
test 1 {string is integer "12345"}
test 1 {string is integer "67890"}
test 1 {string is integer "-123"}
test 1 {string is integer "+123"}
test 1 {string is integer "0123"}
test 1 {string is integer "+0"}
test 1 {string is integer "-0"}
test 1 {string is boolean false}
test 1 {string is boolean no}
test 1 {string is boolean 0}
test 1 {string is boolean OFF}
test 1 {string is boolean true}
test 1 {string is boolean yes}
test 1 {string is boolean 1}
test 1 {string is boolean on}
test 0 {string is boolean XXX}
test 0 {string is boolean ""}
test 1 {string is true true}
test 1 {string is true yEs}
test 1 {string is true 1}
test 1 {string is true oN}
test 0 {string is true off}
test 0 {string is false oN}
test 3 {string first a bbbaca}
test 3 {string first a bbbaca 3}
test 5 {string first a bbbaca 4}
test -1 {string first d bbbaca}
test 0 {string ordinal ""}
test 0 {string ordinal "\x00"}
test 1 {string ordinal "\x01"}
test 2 {string ordinal "\x2"}
test 48 {string ordinal "0"}
test 49 {string ordinal "1"}
test 49 {string ordinal "1a"}
test 49 {string ordinal "1abc"}
fails {string ordinal }
test ff {string dec2hex 255}
test 1000 {string dec2hex 4096}
test 4096 {string hex2dec 1000}
if {== [info system number] 16} { test -1 {string hex2dec FffF} } else { test 65535 {string hex2dec FffF} }
test 101 {string dec2base 5 2}
fails {string dec2base A 2}
test 5 {string base2dec 101 2}
fails {string base2dec 0 0}
fails {string base2dec 0 1}
fails {string base2dec 0 37}
fails {string base2dec 2 2}
fails {string base2dec 2}
test 0 {string char 48}
test 1 {string char 49}
test a {string char 97}
test {} {string tr d abc ""}
test {ddeeff} {string tr d abc aabbccddeeff}
test {aabbcc} {string tr dc abc aabbccddeeff}
test {ddeeffddeeff} {string tr r abc def aabbccddeeff}
test {defdefgg} {string tr s abc def aabbccddeeffgg}
test {abcddeeffgg} {string tr s abc aabbccddeeffgg}
fails {string tr}
fails {string tr d}
test {ad} {string replace "abcd" 1 2 ""}
test {acd} {string replace "abcd" 1 1 ""}
test {abcd} {string replace "abcd" 2 1 ""}
test {a123d} {string replace "abcd" 1 2 "123"}
test {a1d} {string replace "abcd" 1 2 "1"}
test {123} {string replace "" 0 0 "123"}
test {$tv1 world} {set tv1 hello; return {$tv1 world} 0}
test {hello world} {set tv1 hello; subst {$tv1 world}}
test  b     {lindex {a b c} 1}     
test  a     {lindex {a b c d e} 0} 
test  a     {lindex "         a                " 0} 
test  a     {lindex "  \t   \n    a      \t \n   b    " 0} 
test  b     {lindex "  \t   \n    a      \t \n   b    " 1} 
test  {}     {lindex "  \t   \n    a      \t \n   b    " 2} 
test  {hello world}     {lindex "  \t   \n    {hello world} \t  \n   " 0} 
test  {}     {lindex "  \t   \n    {hello world} \t  \n   " 1} 
test  b     {lindex {{a} {b} {c}} 1} 
test  b    {lindex {a b c} 1} 
test  {a b c}    {lindex {a b c}} 
test  {}    {lindex {}} 
test  {}    {lindex {a b "c"} 3} 
test  {b"c"}    {lindex {a b"c"} 1} 
test  {}    {lindex {a b"c"} 2} 
test  a    {lindex {a "b"c} 0} 
test  b    {lindex {a "b"c} 1} 
test  c    {lindex {a "b"c} 2} 
test  {a"b"c}    {lindex {a"b"c} 0} 
#test  5    {lindex {0 1 2 3 4 5} end} 
#test  0    {lindex 0 end} 
#test  {}    {lindex {} end} 
test  {}    {lindex {} -42} 
test  {}    {lindex {a b c} -1} 
test  {}    {lindex {a b c} -2} 
test  {}    {lindex {a b c} -3} 
test  {a c b}    {linsert {a b} 1 c}    
test  {a c d b}    {linsert {a b} 1 c d}  
#test  {a b c}    {linsert {a b} end c}  
#test  {a b c d e}    {linsert {a b} end c d e}  
test  {a b c d e}    {linsert {a b} 3 c d e}  
test  {c d e a b}    {linsert {a b} 0 c d e}  
test  {}       list 
test  {a {b c} d}       {list a "b c" d}       
test  {{} a}       {list "" a} 
test  {a {} b}       {list a {} b} 
test  {a {}}       {list a {}} 
test  "a {\t}"       {list a \t} 
test  "a {\n}"       {list a \n} 
test  {a {\n}}       {list a {\n}} 
test  {a {\r}}       {list a {\r}} 
test  {a {\t}}       {list a {\t}} 
test  {{$a}}      {list {$a}} 
test  {{[hi]}}      {list {[hi]}} 
test  {{[hi]}}      {list {[hi]}} 
test 0 {llength ""}
test 0 {llength " "}
test 1 {llength "a"}
test 2 {llength "a b"}
test 2 {llength "a b "}
test 2 {llength "a { b }"}
test 3 {llength "a { b } c"}
test 3 {llength "a { { b } } c"}
test 3 {llength {a { { \" b \" } } c}}
test 3 {llength {a " b " c}}
fails {llength}
test  0  {llength {}} 
test  0  {llength { }} 
test  0  {llength {   }} 
test  1  {llength {   1}} 
test  1  {llength {   1 }} 
test  2  {llength {   1 2}} 
test  3  {llength {   1 2  3      }} 
test  5  {llength {a b c d e}} 
test  0  {llength "   \t  \n                          "} 
test  1  {llength "   \t  \n         a                "} 
test a {lindex "a b c" 0}
test b {lindex "a b c" 1}
test c {lindex "a b c" 2}
test c {lindex "a b c" 2}
# Note this is different to TCL, where it is an error
test 3 {llength "a { b }c"}
test { b } {lindex "a { b } c" 1}
test a {lindex "a { b } c" 0}
test c {lindex "a { b } c" 2}
test "" {lindex "a { b } c" 3}
test {$x} {subst -novariables {$x}}
test {$x 3} {subst -novariables {$x [+ 2 1]}}
fails {subst}
test {a 3} {subst {a [+ 2 1]}}
test {a [+ 2 1]} {subst -nocommands {a [+ 2 1]}}
test {a hello c} {set z "a b c"; lset z 1 hello}
test {a hello} {set z "a b"; lset z 1 hello}
test {a c} {set z "a b c";   lset z 1 ""}
test {a} {set z "a b";   lset z 1 ""}
test {} {set z "a";   lset z 0 ""}
test {b} {set z "a b";   lset z 0 ""}
test {a b c} {split a.b.c .}
test {a { } b { } c} {split "a b c" ""}
test {a b} {split "a.b" "."}
test {{a b} c} {split "a b.c" "."}
test {abc d} {split "abc.d" "."}
test {a {}} {split "a." "."}
test {} {split "" ""}
test {{} {}} {split "." "."}
test {{} {} {}} {split ".." "."}
fails {split}
test {a b {c d e  } {  f {g h}}} {list a b "c d e  " "  f {g h}"}
test {a b c xyz} {linsert {a b c} 99 xyz}
test {a b c {x y z}} {linsert {a b c} 99 {x y z}}
test {{x y z}} {linsert "" 3 {x y z}}
test {a b c xyz} {linsert {a b c} 3 xyz}
test {xyz a b c} {linsert {a b c} 0 xyz}
test {a {x yz} b c} {linsert {a b c} 1 {x yz}}
test {} {lrepeat 0 a}
test {a} {lrepeat 1 a}
test {a a} {lrepeat 2 a}
test {a a a} {lrepeat 3 a}
test {ab ab ab} {lrepeat 3 ab}
test {{a b} {a b} {a b}} {lrepeat 3 {a b}}
test {a,b,c} {join {a b c} ,}
test {abc} {join [split "abc" ""] ""}
test {a,b,c} {conjoin , a b c}
test {a} {conjoin , a}
test {a,b} {conjoin , a b}
test {} {conjoin , ""}
fails {conjoin}
test {} {lreverse {}}
test {a} {lreverse {a}}
test {b a} {lreverse {a b}}
test {c b a} {lreverse {a  b c}}
test {{ c} a} {lreverse {a { c}}}
test {{y y} {x x}} {lreverse {{x x} {y y}}}
fails {lreverse}
fails {proc}
fails {proc x}
fails {proc x n}
state {proc def {x} {}}
test {} {proc def {x} {}}
state {rename def ""}
state {proc v1 {args} { return $args 0 }}
test {a b {c d}} {v1 a b {c d}}
test {a} {v1 a}
test {} {v1}
state {proc v2 {x y args} { set r "$x $y $args"; return $r 0 }}
test  {a b {c d} {e f}} {v2 a b {c d} {e f}}
test  {a b {c d}} {v2 a b {c d}}
fails {v2 a}
test  {a b } {v2 a b}
fails {v2}
state {rename v1 ""}
state {rename v2 ""}
fails {rename}
fails {rename XXX}
fails {rename XXX YYY}
test {} {lsort {}}
test {a} {lsort {a}}
test {a b} {lsort {a b}}
test {a b} {lsort {b a}}
test {a b c} {lsort {b a c}}
test {c b a} {lsort -decreasing {b a c}}
test {a b c} {lsort {a b c}}
test {1 2 3} {lsort -integer {1 2 3}}
test {3 2 1} {lsort -integer -decreasing {1 2 3}}
test {a {b c} d} {lsort {d a {b c}}}
fails {lsort}
fails {lsort -integer {1 2 a}}
# Test upvar links
state {proc n2 {} { upvar 1 h u; set u [+ $u 1]; }}
state {proc n1 {} { upvar 1 u h; set h [+ $h 1]; n2 }}
test {done} {set u 5; puts "u = $u"; puts "[n1]"; test 1 "== $u 7"; unset u; return "done" 0; }
state {rename n1 ""}
state {rename n2 ""}
fails {lreplace}
fails {lreplace ""}
fails {lreplace "" 1}
test {a foo c d e} {lreplace {a b c d e} 1 1 foo}
test {a {x x} c d e} {lreplace {a b c d e} 1 1 {x x}}
test {a {} c d e} {lreplace {a b c d e} 1 1 ""}
test {a c d e} {lreplace {a b c d e} 1 1}
test {a b c d e f} {lreplace {a b c d e} 9 1  f}
test {a b c d e {f g h}} {lreplace {a b c d e} 9 1  {f g h}}
test {a b c d e {f g h} i} {lreplace {a b c d e} 9 1  {f g h} i}
test {a three more elements d e} {lreplace {a b c d e} 1 2 three more elements}
test {x y z a b c} {lreplace {a b c} -1 -2 x y z}
test {a b x y z c} {lreplace {a b c} 2 1 x y z}
test {a b {x y} z c} {lreplace {a b c} 2 1 {x y} z}
test {a b} {lrange {a b c d e} 0 1}
test {a b c d e} {lrange {a b c d e} 0 4}
test {a} {lrange {a b c d e} 0 0}
test {c d} {lrange {a b c d e} 2 3}
test {a b c d} {lrange {a b c d e} -2 3}
test {} {lrange {a b c d e} 8 3}
test {} {lrange {} 1 1}
test {} {lrange {a b c d e} 4 0}
test 1 {lsearch {x abc def} abc}
test -1 {lsearch {x abc def} ABC}
test 1 {lsearch -nocase {x abc def} ABC}
test -1 {lsearch {x abc def} xyz}
test 0 {lsearch {x abc def} *x*}
test 2 {lsearch -exact {x abc *x*} *x*}
test 4 {lsearch -exact -start 2 {a a b c a} a}
test 2 {lsearch {4 5 6} 6}
test -1 {lsearch {} x}
test 4 {lsearch -not {a a a a b a a} a}
test bbbb {lsearch -not -inline {a aaa  aa bbbb aaa aa} a*}
test AAA {lsearch -not -inline {a AAA  aa bbbb aaa aa} a*}
test bbbb {lsearch -not -inline -nocase {a AAA  aa bbbb aaa aa} a*}
fails {lsearch}
fails {lsearch {1 2 3}}
fails {lsearch -integer {1 2 3} x}
test  {1 2 3 a b {c d}} {set l1 {1 2 3}; lappend l1 a b {c d}}
test  {1 2 3 a b {c d}} {set l1 {1 2 3}; lappend l1 a b {c d}; set l1}
test  {a b {c d}} {lappend l1 a b {c d}; set l1}
test  {} {lappend l2}
test  {a b c} {lappend l3 a b c}
fails {lappend}
test {w x} {set a w; lappend a x} 
test {} {lappend a} 
test {x y z} {lappend a x y z; set a}    
test {x {y z}} {lappend a x {y z}; set a}  
test "hello" {apply {{} { return hello 0; }}}
test 4 {apply {{x} {* $x $x}} 2}
test 8 {apply {{x y} {* $x $y}} 2 4}
test {2 3 4} {apply {{args} { return $args }} 2 3 4}
test {2 3 4 5} {apply {{args} { return $args }} 2 3 4 5}
test {} {apply {{args} { return $args }}}
fails {apply}
fails {apply {}}
fails {apply x}
fails {apply {x}}
fails {reg}
fails {reg a}
fails {reg \\ ""}
test  {1 4} {reg {ba+} "xbaaaz"}
test  {3 7} {reg {\s+} "@@@    \t@@"}
test  {-1 -1} {reg x a}
test  {0 0} {reg . a}
# Might want to return something different for this, like {-1 0}
test  {0 0} {reg "" "abc"}
test  {3 3} {reg -nocase x abcXd}
test  {-1 -1} {reg -start 3 x xxxabc}
test  {6 6} {reg -start 3 x xxxabcx}
# NB. Subtle difference between failure conditions
test  {-1 -1} {reg "a^" ""}
test  {-1 -1} {reg {\{} ""}
test  {2 4} {reg {\{+} "??\{\{\{p"}
fails {reg "a^" "a^"}
fails {reg {$a} {$a}}
test  {0 0} {reg ^ a^}
test  {0 2} {reg ^ab* abb}
test  {-1 -1} {reg ^ab aabb}
test  {0 0} {reg ^ab* aabb}
test  {-1 -1} {reg ^abb* aabb}
test  {1 3} {reg abb* aabb}
test  {0 0} {reg -lazy {ab*} {abbbbbb}}
test  {0 6} {reg {ab*} {abbbbbb}}
# Hmm, probably need to differentiate between these two
# test  {0 0} {reg {a?} {a}}
# test  {0 0} {reg -lazy {a?} {a}}
test  {0 1} {reg {ba?} {ba}}
test  {0 2} {reg {ba?c?} {bac}}
test  {0 0} {reg -lazy {ba?} {ba}}
test  {0 0} {reg -lazy {ba?c?} {ba}}
test  {0 3} {reg -lazy {ba?c?d} {bacd}}
test  {0 4} {reg -possessive {a*c} {aaaac}}
test  {-1 -1} {reg -possessive {.*c} {aaaac}}
test  {0 4} {reg -greedy {.*c} {aaaac}}
test  {9 9} {reg {\S$} "@@@    \t@@"}

# These test cases were taken from:
# <https://chiselapp.com/user/dbohdan/repository/picol/index>
# Also available at: <https://github.com/dbohdan/picol>
# At the time of writing this the tests appeared also to be
# licensed under the original BSD license.

test 0 {catch {* 2 2}}
test -1 {catch {/ 1 0}}
test ""  concat
test abc {concat abc}
test {alpha bravo charlie} {concat alpha bravo charlie}
test {alpha bravo charlie} {concat alpha {bravo charlie}}
test {1 2 3 4 5} {concat {1 2} {3 4 5}}
test "" {concat {} {}}
test {a b c} {concat a {} b {} {} c}
test {foo bar} {concat foo {} bar}

test b {lindex {a b c} 1}
test a {lindex {a b c d e} 0}
test a {lindex "         a                " 0}
test a {lindex "  \t   \n    a      \t \n   b    " 0}
test b {lindex "  \t   \n    a      \t \n   b    " 1}
test {} {lindex "  \t   \n    a      \t \n   b    " 2}
test {hello world} {lindex "  \t   \n    {hello world} \t  \n   " 0}
test {} {lindex "  \t   \n    {hello world} \t  \n   " 1}
test b {lindex {{a} {b} {c}} 1}
test b {lindex {a b c} 1}
test {a b c} {lindex {a b c}}
test {} {lindex {}}
test {} {lindex {a b "c"} 3}
test {b"c"} {lindex {a b"c"} 1}
test {} {lindex {a b"c"} 2}
test {a"b"c} {lindex {a"b"c} 0}
test {} {lindex {} -42}
test {} {lindex {a b c} -1}
test {} {lindex {a b c} -2}
test {} {lindex {a b c} -3}
test {a c b} {linsert {a b} 1 c}
test {a c d b} {linsert {a b} 1 c d}
test {a b c d e} {linsert {a b} 3 c d e}
test {c d e a b} {linsert {a b} 0 c d e}
test {} list
test {a {b c} d} {list a "b c" d}
test {{} a} {list "" a}
test {a {} b} {list a {} b}
test {a {}} {list a {}}
test "a {\t}" {list a \t}
test "a {\n}" {list a \n}
test {a {\n}} {list a {\n}}
test {a {\r}} {list a {\r}}
test {a {\t}} {list a {\t}}
test {{$a}} {list {$a}}
test {{[hi]}} {list {[hi]}}
test {{[hi]}} {list {[hi]}}
test 0 {llength {}}
test 0 {llength { }}
test 0 {llength {   }}
test 1 {llength {   1}}
test 1 {llength {   1 }}
test 2 {llength {   1 2}}
test 3 {llength {   1 2  3      }}
test 5 {llength {a b c d e}}
test 0 {llength "   \t  \n                          "}
test 1 {llength "   \t  \n         a                "}
test {b c d} {lrange {a b c d e f g} 1 3}
#test {d e f g} {lrange {a b c d e f g} 3 end}
test {d e f g} {lrange {a b c d e f g} 3 99}
test {do re mi} {lrange {do re mi fa so la si} 0 2}
test {} {lrange {do re mi fa so la si} -5 -7}
test {} {lrange {do re mi fa so la si} -7 -5}
test {do re mi} {lrange {do re mi fa so la si} -5 2}
test {} {lrange {do re mi fa so la si} 0 -7}
test {} {lrange {do re mi fa so la si} 99 99}
test {a b c} {lrepeat 1 a b c}
test {a b c a b c a b c} {lrepeat 3 a b c}
test {a b x d} {lreplace {a b c d} 2 2 x}
test {a b x y d} {lreplace {a b c d} 2 2 x y}
test {b c d} {lreplace {a b c d} 0 0}
test {} {lreplace {a b c d} 0 99}
test {-e {puts hello} -e {puts world}} {lreplace {./shell -e {puts hello} -e {puts world}} 0 0}
#test {} {lreplace {a b c d} 0 end}
test {a B C d} {lreplace {a b c d} 1 2 B C}
#test {a B C D} {lreplace {a b c d} 1 end B C D}
test b {lreplace " \t \n a \n " 0 0 b}
test a {lreplace {} 0 0 a}
test {a b d e} {lreplace {a b c} 2 3 d e}
test a {lreplace {} -5 -1 a}
test {a b} {lreplace {c b} -5 0 a}
#test {c d} {lreplace {f x} -5 end c d}
test {a b c} {lreplace {b c} -5 -1 a}
test {} {lreverse {}}
test a {lreverse a}
test {b a} {lreverse {a b}}
test {b {longer string} a} {lreverse {a {longer string} b}}
test {5 4 3 2 1} {lreverse {    1       2  3  4  5 }}
test 2 {lsearch {a b c d e} c}
test -1 {lsearch {a b c d e} x}
test 2 {lsearch {a b {c d} e} {c d}}
test 1 {lsearch {foo bar grill} b*}
test {1 x 3 4} {set a {1 2 3 4}; lset a 1 x}
fails {set a {1 2 3 4}; lset a 99 x}
fails {set a {1 2 3 4}; lset a -1 x}
fails {lset foobar 4 2}
test {{a b} {c d} foo} {set x {{a b} {c d} {e f}}; lset x 2 foo}
test {} {lsort {}}
test {a b cc ddd} {lsort {cc a ddd b}}
test {1 2 3 4} {lsort {3 1 4 2}}
test {{a b} {c d}} {lsort {{c d} {a b}}}
test {d c b a} {lsort -decreasing {c a d b}}
test {10 2 3 5} {lsort  {10 3 5 2}}
test {2 3 5 10} {lsort -integer {10 3 2 5}}
#test {a b cc dd} {lsort -unique {cc a dd cc b}}
#test -unique {lsort -unique}
#test 0 {max 0}
test 1 {max 0 1}
test 99 {max -5 2 99 -100 47 52}
#test 0 {min 0}
test 0 {min 0 1}
test -100 {min -5 2 99 -100 47 52}
test 42 {set x 42}
test 24 {set x 24; set x}
#test 37 {set x_y 37; return $x_y}
test 37 {set x_y 37; return $x_y 0}
test 35 {set x_y 35; set x_y}
test {aa bb cd efg} {split aa:bb:cd:efg :}
test {{} aa bb cd efg} {split :aa:bb:cd:efg :}
test {aa bb cd efg {}} {split aa:bb:cd:efg: :}
test {a {} b} {split {a  b}}
test {h e l l o} {split hello ""}
test {a b c d} {split a+b-c+d +-}
test {a b cc d} {split "a;b;cc;d" ";"}
test {abcdef ghi j} {split abcdef\nghi\nj \n}
test {abcdef ghi j} {split abcdefXghiXj X}
test 0 {string first a abcdefg}
test -1 {string first x abcdefg}
test 4 {string first e abcdefg}
test 5 {string first f abcdefg 2}
test -1 {string first a abcdefg 2}
test e {string index hello 1}
#test o {string index hello end}
test {} {string index {} 2}
#test {} {string index {} end}
test {} {string index {} -562}
test 1 {string is integer 42}
test 1 {string is integer -1}
test 0 {string is integer foo}
test 5 {string last + a+b+c+d}
test -1 {string last - a+b+c+d}
test 5 {string length hello}
test foo {string tolower FOO}
test 1 {string match f* foo}
test 0 {string match f* bar}
test 1 {string match *ll* hello}
test 0 {string match *ll* world}
test 1 {string match *lo hello}
test 0 {string match *lo world}
test 1 {string match foo foo}
test 0 {string match foo bar}
test 0 {string match foo FOO}
#test 1 {string match -nocase foo FOO}
test 1 {string match f?o foo}
test 0 {string match ?foo foo}
test 1 {string match f?o* foolish}
test 0 {string match f foo}
test 1 {string match "" ""}
test 1 {string match {\*\*\?\*} **?*}
test 0 {string match {\*\*\?\*} **a*}
test 0 {string match {\*\*\?\*} x*?*}
test 0 {string match {\*\*\?\*} **?x}
test 1 {string match {\\\\} {\\}}
test 0 {string match {\\} {\\}}
test 1 {string match * {}}
test 1 {string match ** dasdasdsadfdsafs}
test 1 {string match ** {}}
test 1 {string match ** dasdasdsadfdsafs}
test 1 {string match foobar* foobarbaz}
test 1 {string match foobar* foobar}
test 0 {string match foobar* foo}
test 1 {string match *barbaz foobarbaz}
test 1 {string match *barbaz barbaz}
test 0 {string match *barbaz baz}
test 1 {string match *bar* foobarbaz}
test 1 {string match *bar* bar}
test 0 {string match *bar* a}
test 0 {string match *baaar* aa}
test 0 {string match *bar* ba}
test 0 {string match *bar* ar}
test 0 {string match *a* {}}
test 1 {string match *a* a}
test 1 {string match *a* aa}
test 1 {string match *a* aaa}
test 0 {string match *aa* a}
test 1 {string match *aa* aa}
test 1 {string match *aa* aaa}
test 1 {string match \n \n}
test 0 {string match {\n} \n}
test 1 {string match {\\a} \\a}
test 1 {string match {*\\\\} {\\}}
test 1 {string match {\\\\*} {\\}}
test 1 {string match {*\\\\*} {\\}}
test 0 {string match *a* AAA}
test 1 {string match -nocase *a* AaA}
fails {string match -invalid *a* AaA}
test bcd {string range abcde 1 3}
test "" {string range abcde 1 0}
#test "abcdefg" {string range abcdefg 0 end}
test {} {string range abcdefg -5 -7}
test {} {string range abcdefg -7 -5}
test ab {string range abcdefg -2 1}
test abc {string range abcdefg -99 2}
test {} {string range abcdefg  0 -1}
test abcdefg {string range abcdefg  0 99}
test abcdefg {string range abcdefg  0 6}
test abcdef {string range abcdefg  0 5}
test {} {string range abcdefg  99 99}
test foofoofoo {string repeat foo 3}
test "" {string repeat foo 0}
test abc {string trim "  abc\t\t"}
test def {string trim ::def::: :}
test ghi {string trim ghi xkl}
test bcdaa {string trimleft  aaabcdaa a}
test aaabcd {string trimright aaabcdaa a}
test "" {string trim      fffff f}
test "" {string trimleft  fffff f}
test "" {string trimright fffff f}
test FOO {string toupper foo}
test {foo 3} {set a foo; subst {$a [string length $a]}}
test hello {subst {h\x65llo}}
test 0 {set foo 1;unset foo;info exists foo}
test 1 {set foo 1;info exists foo}
#test "" {set i 10; while {$i} {incr i -1}}
test 0 {set i 10; while {!= $i 0} {incr i -1}; set i}
test 5 {set i 10; while {> $i 5} {incr i -1}; set i}
test 55 {proc f x {uplevel 1 set gg $x}; f 55; set gg}
state {rename f ""}

fails {format}
fails {format "%Y"}
test "" {format %s {}}
test "Alpha-Omega" {format %s-%s Alpha Omega}
test "ABC" {format ABC}
test "ABC" {format ABC D E F}
test "AxC" {format A%sC x}
test "AxxC" {format A%sC xx}
test "Hello, World!" {format "%s, %s!" Hello World}
test "" {format ""}
test "AA" {format A%c 65}
test "3e8" {format %x 1000}
test "3E8" {format %X 1000}
test "%s" {format %%s}
test "A"  {switch 0 { 0 { return "A" 0 } 1 { return "B" 0 } default { return "C" 0 } } }
test "B"  {switch 1 { 0 { return "A" 0 } 1 { return "B" 0 } default { return "C" 0 } } }
test "C"  {switch 2 { 0 { return "A" 0 } 1 { return "B" 0 } default { return "C" 0 } } }
test "A"  {switch -nocase XxX { xxx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test "B"  {switch -nocase YYY { xxx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test "C"  {switch -nocase ZZZ { xxx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test "A"  {switch -glob x?x { xbx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test "A"  {switch -glob x?x { xbx { return "A" 0 } xbx { return "B" 0 } default { return "C" 0 } } }
test "C"  {switch -glob X?X { xbx { return "A" 0 } xbx { return "B" 0 } default { return "C" 0 } } }
test "A"  {switch -glob X?X -nocase { xbx { return "A" 0 } xbx { return "B" 0 } default { return "C" 0 } } }
test "B"  {switch -glob y*  { xxx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test "C"  {switch -glob ZZZ { xxx { return "A" 0 } yyy { return "B" 0 } default { return "C" 0 } } }
test ""   {switch -glob ZZZ { xxx { return "A" 0 } yyy { return "B" 0 } } }
test "a b d e" {lremove {a b c d e} 2}
test "b d e" {lremove {a b c d e} 2 0}
test {{} {} {}}               {lassign {} a b c; list $a $b $c} 
test {foo {} {}}              {lassign {foo} a b c; list $a $b $c} 
test {foo bar baz}            {lassign {foo bar baz} a b c; list $a $b $c} 
test {foo bar baz {qux quux}} {set rem [lassign {foo bar baz qux quux} a b c]; list $a $b $c $rem} 

# Version should not be '0':
test 1 {ne "0" {eval "or [info version]"}}

proc assert {x} { if {== $x "0"} { puts "assert failed"; exit 1 } }
assert [<= $passed $total]
assert [>= $passed 0]

set failed [!= $passed $total]
set emphasize [green]

if {!= $failed 0} {
	set emphasize [red]
}

puts
puts "Heap Usage:"
puts "\tallocs:\t[heap allocations]"
puts "\tfrees:\t[heap frees]"
puts "\tgrow:\t[heap reallocations]"
puts "\ttotal:\t[heap total] ([/ [heap total] 1024]KiB)"
puts "\tavg:\t[/ [heap total] [heap allocations]]"
puts "Commands:\n\tcount:\t[info cmdcount]\n"
puts "$emphasize   pass[normal]/[blue]total $emphasize$passed[normal]/[blue]$total[normal]\n"
puts "\[[blue]DONE[normal]\]"
if {!= 0 $failed} {
	return "Test Failure" -1
}
break