aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2011-05-23 23:10:23 +1000
committerSteve Bennett <steveb@workware.net.au>2011-05-24 12:08:03 +1000
commit041a334f525021c6e7015d537a56d44352d95b10 (patch)
tree5a60366036a3c029b756441059ca3059eccd3cbc /tests
parent2dd84967ea821e7bf650b8efcb8297122b83ad9b (diff)
downloadjimtcl-041a334f525021c6e7015d537a56d44352d95b10.zip
jimtcl-041a334f525021c6e7015d537a56d44352d95b10.tar.gz
jimtcl-041a334f525021c6e7015d537a56d44352d95b10.tar.bz2
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>
Diffstat (limited to 'tests')
-rw-r--r--tests/alias.test30
-rw-r--r--tests/array.test12
-rw-r--r--tests/lsort.test4
-rw-r--r--tests/misc.test76
-rw-r--r--tests/parse.test12
-rw-r--r--tests/proc-new.test11
-rw-r--r--tests/subst.test9
-rw-r--r--tests/uplevel.test12
8 files changed, 162 insertions, 4 deletions
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