From 041a334f525021c6e7015d537a56d44352d95b10 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Mon, 23 May 2011 23:10:23 +1000
Subject: Small code cleanups

Remove Jim_SetWide() since it is only used by incr
More tests for better test coverage

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 tests/alias.test    | 30 +++++++++++++++++++++
 tests/array.test    | 12 +++++++++
 tests/lsort.test    |  4 +++
 tests/misc.test     | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++---
 tests/parse.test    | 12 +++++++++
 tests/proc-new.test | 11 ++++++++
 tests/subst.test    |  9 +++++++
 tests/uplevel.test  | 12 +++++++++
 8 files changed, 162 insertions(+), 4 deletions(-)

(limited to 'tests')

diff --git a/tests/alias.test b/tests/alias.test
index 7f0d721..4fd392d 100644
--- a/tests/alias.test
+++ b/tests/alias.test
@@ -126,4 +126,34 @@ test local-1.9 "local on existing proc" {
 	list [info procs a] $result 
 } {{} {2 1}}
 
+test statics-1.1 "missing static variable init" {
+	unset -nocomplain c
+	catch {
+		proc a {b} {c} {
+			# No initialiser for c
+		}
+	}
+} 1
+
+test statics-1.2 "static variable with invalid name" {
+	catch {
+		proc a {b} "{c\0d 4}" {
+		}
+	}
+} 1
+
+test statics-1.3 "duplicate static variable" {
+	catch {
+		proc a {b} {{c 1} {c 2}} {
+		}
+	}
+} 1
+
+test statics-1.4 "bad static variable init" {
+	catch {
+		proc a {b} {{c 1 2}} {
+		}
+	}
+} 1
+
 testreport
diff --git a/tests/array.test b/tests/array.test
index 408c4e3..999e41f 100644
--- a/tests/array.test
+++ b/tests/array.test
@@ -2,6 +2,7 @@ source [file dirname [info script]]/testing.tcl
 
 needs cmd array
 
+unset -nocomplain a
 array set a {
 	1 one
 	2 two
@@ -73,4 +74,15 @@ test array-1.12 "array set to invalid variable" {
 	catch {array set a(1) {b c}}
 } {1}
 
+test array-1.13 "unset missing array element" {
+	unset -nocomplain a
+	set a(1) one
+	catch {unset a(2)}
+} 1
+
+test array-1.14 "access array via unset var" {
+	unset -nocomplain b
+	catch {expr {$a($b) + 4}}
+} 1
+
 testreport
diff --git a/tests/lsort.test b/tests/lsort.test
index 1a61fdb..b4eba95 100644
--- a/tests/lsort.test
+++ b/tests/lsort.test
@@ -190,4 +190,8 @@ test lsort-4.26 {DefaultCompare procedure, signed characters} utf8 {
     set viewlist
 } [list "abc" "abc\\200"]
 
+test lsort-5.1 "Sort case insensitive" {
+    lsort -nocase {ba aB aa ce}
+} {aa aB ba ce}
+
 testreport
diff --git a/tests/misc.test b/tests/misc.test
index 706ee5e..4557773 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -442,12 +442,35 @@ test jimexpr-1.17 "- command" {
     - 6 3 1.5
 } 1.5
 
-test jimexpr-1.18 "errors in math commands" {
-    list [catch /] [catch {/ x}] [catch -] [catch {+ x y}] [catch {* x}]
-} {1 1 1 1 1}
+test jimexpr-1.17 "- command" {
+    - 6.5 3
+} 3.5
+
+test jimexpr-2.1 "errors in math commands" {
+    list [catch /] [catch {/ x}] [catch -] [catch {- blah blah}] [catch {- 2.0 blah}] [catch {+ x y}] [catch {* x}]
+} {1 1 1 1 1 1 1}
+
+test jimexpr-2.2 "not var optimisation" {
+	set x [expr 1]
+	set y [expr 0]
+	set z [expr 2.0]
+	list [expr {!$x}] [expr {!$y}] [expr {!$z}]
+} {0 1 0}
+
+test jimexpr-2.3 "expr access unset var" {
+	unset -nocomplain a
+	catch {expr {3 * $a}}
+} 1
+
+test jimexpr-2.4 "expr double as bool" {
+	set x 2
+	if {1.0} {
+		set x 3
+	}
+} 3
 
 # May be supported if support compiled in
-test jimexpr-2.1 "double ** operator" {
+test jimexpr-2.5 "double ** operator" {
     catch {expr {2.0 ** 3}} result
     expr {$result in {unsupported 8.0}}
 } 1
@@ -468,9 +491,54 @@ test jimobj-1.1 "duplicate obj with no dupIntRepProc" {
 	set x "y $a"
 } "y x x"
 
+test jimobj-1.2 "cooerced double to int" {
+	set x 3
+	# cooerce to a double
+	expr {4.5 + $x}
+	# Now get the int rep
+	incr x
+} 4
+
+test jimobj-1.3 "cooerced double to double" {
+	set x 3
+	# cooerce to a double
+	expr {4.5 + $x}
+	# Now use as a double
+	expr {1.5 + $x}
+} 4.5
+
+test jimobj-1.4 "incr dict sugar" {
+	unset -nocomplain a
+	set a(3) 3
+	incr a(3)
+	list $a(3) $a
+} {4 {3 4}}
+
 test jim-badvar-1.1 "invalid variable name" {
 	set x b\0c
 	catch {set $x 5}
 } 1
 
+test jim-badvar-1.2 "incr invalid variable name" {
+	set x b\0c
+	catch {incr $x}
+} 1
+
+test lset-1.1 "lset with bad var" {
+	catch {lset badvar 1 x}
+} 1
+
+test dict-1.1 "dict to string" {
+	set a [dict create abc \\ def \"]
+	set x x$a
+} "xabc \\\\ def {\"}"
+
+test channels-1.1 {info channels} {
+	lsort [info channels]
+} {stderr stdin stdout}
+
+test lmap-1.1 {lmap} {
+	lmap p {1 2 3} {incr p}
+} {2 3 4}
+
 testreport
diff --git a/tests/parse.test b/tests/parse.test
index a897ab8..8422c51 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -219,4 +219,16 @@ test parse-1.43 "list containing trailing backslash" {
 	lindex $x 1
 } def\\
 
+test parse-1.44 "list creation" {
+	list "a{ }d"
+} {{a{ }d}}
+
+test parse-1.45 "spaces before expr function args" {
+	expr {round  (3.2)}
+} 3
+
+test parse-1.45 "expr function missing paren" {
+	catch {expr {round 3.2}}
+} 1
+
 testreport
diff --git a/tests/proc-new.test b/tests/proc-new.test
index 1178e0c..9f18f64 100644
--- a/tests/proc-new.test
+++ b/tests/proc-new.test
@@ -98,4 +98,15 @@ test proc-3.2 "Rename optional args" {
 	a B C D
 } {C D}
 
+test proc-3.3 "dict sugar arg" {
+	proc a {b(c)} { return $b}
+	a 4
+} {c 4}
+
+test proc-3.4 "invalid upref in rightargs" {
+	proc a {{x 2} &b} { return $b}
+	unset -nocomplain B
+	catch {a B}
+} 1
+
 testreport
diff --git a/tests/subst.test b/tests/subst.test
index 28a2af7..4a084d9 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -159,5 +159,14 @@ test subst-11.3 {continue in a subst} {
     subst {foo [if 1 { continue; bogus code}] bar}
 } {foo  bar}
 
+test subst-12.1 {lone $} {
+    subst {$}
+} {$}
+
+test subst-12.2 {lone $} {
+    set a 1
+    subst -novar {${a}}
+} {${a}}
+
 # cleanup
 testreport
diff --git a/tests/uplevel.test b/tests/uplevel.test
index e91a5ea..004e387 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -23,6 +23,9 @@ proc newset {name value} {
     uplevel set $name $value
     uplevel 1 {uplevel 1 {set xyz 22}}
 }
+proc b {x y} {
+    uplevel #0 set $x $y
+}
 
 test uplevel-1.1 {simple operation} {
     set xyz 0
@@ -109,4 +112,13 @@ a2
 test uplevel-5.1 {info level} {set x} 1
 test uplevel-5.2 {info level} {set y} a3
 
+test uplevel-6.1 {uplevel #0} {
+    b g1 g1val
+    set ::g1
+} g1val
+
+test uplevel-6.2 {uplevel #bad} {
+    catch {uplevel #bad set x 1}
+} 1
+
 testreport
-- 
cgit v1.1