diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-12-07 21:31:50 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-12-21 21:45:09 +1000 |
commit | 0475c46a5dcba6913213f63ffdddbbe49ee06146 (patch) | |
tree | 09dbe9c816322177df2ccb45b64f8e2cbd8c13fe | |
parent | d2b617a4f58a4a9bde588068e011f3fe54ebe061 (diff) | |
download | jimtcl-0475c46a5dcba6913213f63ffdddbbe49ee06146.zip jimtcl-0475c46a5dcba6913213f63ffdddbbe49ee06146.tar.gz jimtcl-0475c46a5dcba6913213f63ffdddbbe49ee06146.tar.bz2 |
More constraint improvements
-rw-r--r-- | tests/alias.test | 1 | ||||
-rw-r--r-- | tests/exists.test | 5 | ||||
-rw-r--r-- | tests/jim.test | 17 | ||||
-rw-r--r-- | tests/tree.test | 1 |
4 files changed, 14 insertions, 10 deletions
diff --git a/tests/alias.test b/tests/alias.test index eba34b0..7f0d721 100644 --- a/tests/alias.test +++ b/tests/alias.test @@ -2,6 +2,7 @@ source [file dirname [info script]]/testing.tcl needs constraint jim needs cmd array +needs cmd ref test alias-1.1 "One word alias" { set x 2 diff --git a/tests/exists.test b/tests/exists.test index ae35a87..11e8781 100644 --- a/tests/exists.test +++ b/tests/exists.test @@ -1,6 +1,7 @@ source [file dirname [info script]]/testing.tcl needs cmd exists +testConstraint lambda [expr {[info commands lambda] ne {}}] test exists-1.1 "Exists var" { set a 1 @@ -61,14 +62,14 @@ test exists-1.1 "Exists -command" { exists -command bogus } 0 -test exists-1.1 "Exists local lambda after exit" { +test exists-1.1 "Exists local lambda after exit" lambda { proc a {} { local lambda {} {dummy} } exists -proc [a] } 0 -test exists-1.1 "Exists local lambda" { +test exists-1.1 "Exists local lambda" lambda { proc a {} { exists -proc [local lambda {} {dummy}] } diff --git a/tests/jim.test b/tests/jim.test index 419e044..4e3d02c 100644 --- a/tests/jim.test +++ b/tests/jim.test @@ -12,6 +12,7 @@ source [file dirname [info script]]/testing.tcl needs constraint jim catch {package require regexp} testConstraint regexp [expr {[info commands regexp] ne {}}] +testConstraint lambda [expr {[info commands ref] ne {}}] ################################################################################ # SET @@ -2621,34 +2622,34 @@ test switch-9.10 {unpaired pattern} { test switch-10.1 {no callback given to -command} { catch {switch -command a { a {expr 1} b {expr 2} }} } 1 -test switch-10.2 {callback expect wrong # args for -command} { +test switch-10.2 {callback expect wrong # args for -command} lambda { catch {switch -command [lambda {p1} {expr 1}] a { a {expr 1} b {expr 2} }} } 1 -test switch-10.3 {callback to -command returns ever 0: no match} { +test switch-10.3 {callback to -command returns ever 0: no match} lambda { switch -command [lambda {p1 p2} {expr 0}] a a {expr 1} b {expr 2} } {} -test switch-10.4 {callback to -command returns 3 at first match} { +test switch-10.4 {callback to -command returns 3 at first match} lambda { switch -command [lambda {p1 p2} {expr 3}] a a {expr 1} b {expr 2} } 1 -test switch-10.5 {[error] in callback to -command} { +test switch-10.5 {[error] in callback to -command} lambda { list [catch { switch -command [lambda {p1 p2} {error "foo"}] a a {expr 1} b {expr 2} } msg] $msg } {1 foo} -test switch-10.6 {[continue] in callback to -command} { +test switch-10.6 {[continue] in callback to -command} lambda { list [catch { switch -command [lambda {p1 p2} {continue}] a a {expr 1} b {expr 2} } msg] $msg } {4 {}} -test switch-10.7 {callback matches first if pat < str} { +test switch-10.7 {callback matches first if pat < str} lambda { switch -command [lambda {pat str} {expr {$pat < $str}}] 3 \ 5 {expr 1} 3 {expr 2} } {} -test switch-10.8 {callback matches first if pat < str} { +test switch-10.8 {callback matches first if pat < str} lambda { switch -command [lambda {pat str} {expr {$pat < $str}}] 7 \ 5 {expr 1} 3 {expr 2} } 1 -test switch-10.9 {callback matches first if pat < str} { +test switch-10.9 {callback matches first if pat < str} lambda { switch -command [lambda {pat str} {expr {$pat < $str}}] 4 \ 5 {expr 1} 3 {expr 2} } 2 diff --git a/tests/tree.test b/tests/tree.test index 03c013f..30171bc 100644 --- a/tests/tree.test +++ b/tests/tree.test @@ -1,5 +1,6 @@ source [file dirname [info script]]/testing.tcl needs cmd tree +needs cmd ref proc dputs {msg} { #puts $msg |