summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-05-13 12:59:04 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-05-13 12:59:04 (GMT)
commit81bf158695e5ecff209636d52392ca7f21675f23 (patch)
tree6e35a78f3d83e2cb85b57d1401aaf89989c6ff3d /tests
parent2aee97bf214b4578d446e48cc0a67321d06cf62b (diff)
downloadtcl-81bf158695e5ecff209636d52392ca7f21675f23.zip
tcl-81bf158695e5ecff209636d52392ca7f21675f23.tar.gz
tcl-81bf158695e5ecff209636d52392ca7f21675f23.tar.bz2
TIP#143 implementation; still needs docs and more tests...
Diffstat (limited to 'tests')
-rw-r--r--tests/interp.test299
1 files changed, 151 insertions, 148 deletions
diff --git a/tests/interp.test b/tests/interp.test
index e6b2024..bf49282 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.27 2004/03/30 16:22:22 msofer Exp $
+# RCS: @(#) $Id: interp.test,v 1.28 2004/05/13 12:59:23 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -31,7 +31,7 @@ test interp-1.1 {options for interp command} {
} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
test interp-1.2 {options for interp command} {
list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -49,13 +49,13 @@ test interp-1.6 {options for interp command} {
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-1.7 {options for interp command} {
list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "hello": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.8 {options for interp command} {
list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.10 {options for interp command} {
list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}
@@ -855,196 +855,153 @@ test interp-19.9 {alias deletion, renaming} {
} 1156
test interp-20.1 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a eval {proc foo {} {}}
- a hide foo
- catch {a eval foo something} msg
- interp delete a
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a eval {proc foo {} {}}
+ $a hide foo
+ catch {$a eval foo something} msg
+ interp delete $a
set msg
} {invalid command name "foo"}
test interp-20.2 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a hide list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a hide list
set l ""
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- a expose list
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {$a eval {list 1 2 3}} msg] $msg
+ $a expose list
+ lappend l [catch {$a eval {list 1 2 3}} msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {1 2 3}}
test interp-20.3 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a hide list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a hide list
set l ""
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {a invokehidden list 1 2 3} msg]
- lappend l $msg
- a expose list
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ lappend l [catch { $a invokehidden list 1 2 3 } msg] $msg
+ $a expose list
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
test interp-20.4 {interp hide, interp expose and interp invokehidden -- passing {}} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a hide list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a hide list
set l ""
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {a invokehidden list {"" 1 2 3}} msg]
- lappend l $msg
- a expose list
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ lappend l [catch { $a invokehidden list {"" 1 2 3} } msg] $msg
+ $a expose list
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
test interp-20.5 {interp hide, interp expose and interp invokehidden -- passing {}} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a hide list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a hide list
set l ""
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {a invokehidden list {{} 1 2 3}} msg]
- lappend l $msg
- a expose list
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ lappend l [catch { $a invokehidden list {{} 1 2 3} } msg] $msg
+ $a expose list
+ lappend l [catch { $a eval {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
test interp-20.6 {interp invokehidden -- eval args} {
- catch {interp delete a}
- interp create a
- a hide list
+ set a [interp create]
+ $a hide list
set l ""
set z 45
- lappend l [catch {a invokehidden list $z 1 2 3} msg]
- lappend l $msg
- a expose list
- lappend l [catch {a eval list $z 1 2 3} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch { $a invokehidden list $z 1 2 3 } msg] $msg
+ $a expose list
+ lappend l [catch { $a eval list $z 1 2 3 } msg] $msg
+ interp delete $a
set l
} {0 {45 1 2 3} 0 {45 1 2 3}}
test interp-20.7 {interp invokehidden vs variable eval} {
- catch {interp delete a}
- interp create a
- a hide list
+ set a [interp create]
+ $a hide list
set z 45
- set l ""
- lappend l [catch {a invokehidden list {$z a b c}} msg]
- lappend l $msg
- interp delete a
+ set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg]
+ interp delete $a
set l
} {0 {{$z a b c}}}
test interp-20.8 {interp invokehidden vs variable eval} {
- catch {interp delete a}
- interp create a
- a hide list
- a eval set z 89
+ set a [interp create]
+ $a hide list
+ $a eval set z 89
set z 45
- set l ""
- lappend l [catch {a invokehidden list {$z a b c}} msg]
- lappend l $msg
- interp delete a
+ set l [list [catch {$a invokehidden list {$z a b c}} msg] $msg]
+ interp delete $a
set l
} {0 {{$z a b c}}}
test interp-20.9 {interp invokehidden vs variable eval} {
- catch {interp delete a}
- interp create a
- a hide list
- a eval set z 89
+ set a [interp create]
+ $a hide list
+ $a eval set z 89
set z 45
set l ""
- lappend l [catch {a invokehidden list $z {$z a b c}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {$a invokehidden list $z {$z a b c}} msg] $msg
+ interp delete $a
set l
} {0 {45 {$z a b c}}}
test interp-20.10 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- a eval {proc foo {} {}}
- interp hide a foo
- catch {interp eval a foo something} msg
- interp delete a
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ $a eval {proc foo {} {}}
+ interp hide $a foo
+ catch {interp eval $a foo something} msg
+ interp delete $a
set msg
} {invalid command name "foo"}
test interp-20.11 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- interp hide a list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ interp hide $a list
set l ""
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- interp expose a list
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg
+ interp expose $a list
+ lappend l [catch {interp eval $a {list 1 2 3}} msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {1 2 3}}
test interp-20.12 {interp hide, interp expose and interp invokehidden} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- interp hide a list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ interp hide $a list
set l ""
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {interp invokehidden a list 1 2 3} msg]
- lappend l $msg
- interp expose a list
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg
+ lappend l [catch {interp invokehidden $a list 1 2 3} msg] $msg
+ interp expose $a list
+ lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {1 2 3} 0 {1 2 3}}
test interp-20.13 {interp hide, interp expose, interp invokehidden -- passing {}} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- interp hide a list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ interp hide $a list
set l ""
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {interp invokehidden a list {"" 1 2 3}} msg]
- lappend l $msg
- interp expose a list
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg
+ lappend l [catch {interp invokehidden $a list {"" 1 2 3}} msg] $msg
+ interp expose $a list
+ lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {{"" 1 2 3}} 0 {1 2 3}}
test interp-20.14 {interp hide, interp expose, interp invokehidden -- passing {}} {
- catch {interp delete a}
- interp create a
- a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
- interp hide a list
+ set a [interp create]
+ $a eval {proc unknown {x args} {error "invalid command name \"$x\""}}
+ interp hide $a list
set l ""
- lappend l [catch {interp eval a {list 1 2 3}} msg]
- lappend l $msg
- lappend l [catch {interp invokehidden a list {{} 1 2 3}} msg]
- lappend l $msg
- interp expose a list
- lappend l [catch {a eval {list 1 2 3}} msg]
- lappend l $msg
- interp delete a
+ lappend l [catch {interp eval $a {list 1 2 3} } msg] $msg
+ lappend l [catch {interp invokehidden $a list {{} 1 2 3}} msg] $msg
+ interp expose $a list
+ lappend l [catch {$a eval {list 1 2 3} } msg] $msg
+ interp delete $a
set l
} {1 {invalid command name "list"} 0 {{{} 1 2 3}} 0 {1 2 3}}
test interp-20.15 {interp invokehidden -- eval args} {
@@ -2907,16 +2864,62 @@ test interp-32.1 { parent's working directory should
test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
# This test will panic if Bug 730244 is not fixed.
- interp create i
- proc test args {return $args}
- trace add execution test enter {interp alias i alias {} ;#}
- interp alias i alias {} test this
- i eval alias
+ set i [interp create]
+ proc testHelper args {rename testHelper {}; return $args}
+ # Note: interp names are simple words by default
+ trace add execution testHelper enter "interp alias $i alias {} ;#"
+ interp alias $i alias {} testHelper this
+ $i eval alias
} this
+test interp-34.1 {basic test of limits - calling commands} {
+ set i [interp create]
+ $i eval {
+ proc foobar {} {
+ for {set x 0} {$x<1000000} {incr x} {
+ # Calls to this are not bytecoded away
+ pid
+ }
+ }
+ }
+ $i limit command -value 1000
+ set msg [list [catch {$i eval foobar} msg] $msg]
+ interp delete $i
+ set msg
+} {1 {command count limit exceeded}}
+test interp-34.2 {basic test of limits - bytecoded commands} knownBug {
+ set i [interp create]
+ $i eval {
+ proc foobar {} {
+ for {set x 0} {$x<1000000} {incr x} {
+ # Calls to this *are* bytecoded away
+ expr {1+2+3}
+ }
+ }
+ }
+ $i limit command -value 1000
+ set msg [list [catch {$i eval foobar} msg] $msg]
+ interp delete $i
+ set msg
+} {1 {command count limit exceeded}}
+test interp-34.3 {basic test of limits - pure bytecode loop} knownBug {
+ set i [interp create]
+ $i eval {
+ proc foobar {} {
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ }
+ $i limit command -value 1000
+ set msg [list [catch {$i eval foobar} msg] $msg]
+ interp delete $i
+ set msg
+} {1 {command count limit exceeded}}
+
# cleanup
foreach i [interp slaves] {
- interp delete $i
+ interp delete $i
}
::tcltest::cleanupTests
return