Move some core procs into the (Tcl) stdlib extension

Also implement 'local' to declare/delete local procs
* Add tests/alias.test for testing alias, current, local
* proc now returns the name of the proc created
* Add helper 'function' to stdlib
Reimplement glob and case to use local procs
* This keeps these internal procs out of the global namespace

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 144 insertions, 1 deletions

diff --git a/tests/alias.test b/tests/alias.test
new file mode 100644
index 0000000..94aa4f1
--- /dev/null
+++ b/tests/alias.test
@@ -0,0 +1,123 @@
+source testing.tcl
+
+test alias-1.1 "One word alias" {
+	set x 2
+	alias newincr incr
+	newincr x 
+} {3}
+
+test alias-1.4 "Two word alias" {
+	alias infoexists info exists
+	infoexists x
+} {1}
+
+test alias-1.5 "Replace alias" {
+	alias newincr infoexists
+	newincr x
+} {1}
+
+test alias-1.6 "Delete alias" {
+	rename newincr ""
+	catch {newincr x}
+} {1}
+
+test alias-1.7 "Replace alias with proc" {
+	proc infoexists {n} {
+		return yes
+	}
+	infoexists any
+} {yes}
+
+test alias-1.8 "Replace proc with alias" {
+	alias infoexists info exists
+	infoexists any
+} {0}
+
+test curry-1.1 "One word curry" {
+	set x 2
+	set one [curry incr]
+	$one x 
+} {3}
+
+test curry-1.4 "Two word curry" {
+	set two [curry info exists]
+	list [$two x] [$two y]
+} {1 0}
+
+test curry-1.5 "Delete curry" {
+	unset one two
+	collect
+} {2}
+
+test local-1.1 "local lambda in eval" {
+	set x 1
+	eval {
+		local set a [lambda {b} { incr b }]
+		set x [$a $x]
+	}
+	list [info procs $a] $x
+} {{} 2}
+
+test local-1.2 "local curry in proc" {
+	proc a {} {
+		local set p [curry info exists]
+		set x 1
+		list $p [$p x] [$p y]
+	}
+	lassign [a] p exists_x exists_y
+	list [info procs $p] $exists_x $exists_y
+} {{} 1 0}
+
+test local-1.2 "set local curry in proc" {
+	proc a {} {
+		set p [local curry info exists]
+		set x 1
+		list $p [$p x] [$p y]
+	}
+	lassign [a] p exists_x exists_y
+	list [info procs $p] $exists_x $exists_y
+} {{} 1 0}
+
+test local-1.3 "local alias in proc" {
+	proc a {} {
+		local alias p info exists
+		set x 1
+		list [p x] [p y]
+	}
+	lassign [a] exists_x exists_y
+	list [info procs p] $exists_x $exists_y
+} {{} 1 0}
+
+test local-1.5 "local proc in proc" {
+	set ::x 1
+	proc a {} {
+		local proc b {} { incr ::x }
+		b
+		set ::x
+	}
+	a
+	list [info procs b] $::x
+} {{} 2}
+
+test local-1.6 "local lambda in lsort" {
+	lsort -command [local lambda {a b} {string compare $a $b}] {d a f g}
+} {a d f g}
+
+test local-1.7 "check no reference procs" {
+	info procs "<reference*"
+} {}
+
+test local-1.8 "local on non-proc" {
+	list [catch {local set x blah} msg] $msg
+} {1 {not a proc: "blah"}}
+
+test local-1.9 "local on existing proc" {
+	eval {
+		proc a {b} {incr b}
+		local function a
+		set c [lambda b {incr b -1}]
+		local function $c
+		lappend result [a 1] [$c 2]
+	}
+	list [info procs a] $result 
+} {{} {2 1}}
diff --git a/tests/case.test b/tests/case.test
index 4a594ad..a774004 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -1,5 +1,25 @@
 source testing.tcl
 
+test case-1.1 "Simple case" {
+	foreach c {abc xyz def sdfbc basdf a aba} {
+		case $c in {
+			b* {
+				lappend result 1
+			}
+			{ab a} {
+				lappend result 2
+			}
+			{def *bc} {
+				lappend result 3
+			}
+			default {
+				lappend result 4
+			}
+		}
+	}
+	set result 
+} {3 4 3 3 1 2 4}
+
 # case is a proc, but it should be able
 # to cause a return in do_case
 proc do_case {var} {
diff --git a/tests/proc.test b/tests/proc.test
index 56ed59a..985f68b 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -30,7 +30,7 @@ proc tproc x {
 test proc-old-1.2 {simple procedure call and return} {tproc 2} 3
 test proc-old-1.3 {simple procedure call and return} {
     proc tproc {} {return foo}
-} {}
+} {tproc}
 test proc-old-1.4 {simple procedure call and return} {
     proc tproc {} {return}
     tproc