Return to uplevel.test CVS log

Up to [Research Unix] / researchv10dc / cmd / worm / scsi / tcl / tests

Annotation of researchv10dc/cmd/worm/scsi/tcl/tests/uplevel.test, revision 1.1.1.1

1.1       root        1: # This file contains contains a collection of tests for the "uplevel"
                      2: # command in Tcl.  If everything is OK then it finishes silently.
                      3: # If a problem is detected then it generates a Tcl error with a cryptic
                      4: # message.  To trace the error you'll have to read through the commands
                      5: # in this file.
                      6: #
                      7: # $Header: /sprite/src/lib/tcl/tests/RCS/uplevel.test,v 1.3 90/03/21 10:29:44 ouster Exp $ (Berkeley)
                      8: 
                      9: proc check {a b num} {
                     10:     if {[string compare $a $b] != 0} {
                     11:        error [format {Uplevel error %s: wanted "%s", got "%s"} $num $b $a]}
                     12: }
                     13: 
                     14: proc a {x y} {
                     15:     newset z [expr $x+$y]
                     16:     return $z
                     17: }
                     18: proc newset {name value} {
                     19:     uplevel set $name $value
                     20:     uplevel 1 {uplevel 1 {set xyz 22}}
                     21: }
                     22: set xyz 0
                     23: set x [a 22 33]
                     24: check $x 55 1
                     25: check $xyz 22 2
                     26: 
                     27: proc a1 {} {
                     28:     b1
                     29:     global a a1
                     30:     set a $x
                     31:     set a1 $y
                     32: }
                     33: proc b1 {} {
                     34:     c1
                     35:     global b b1
                     36:     set b $x
                     37:     set b1 $y
                     38: }
                     39: proc c1 {} {
                     40:     uplevel 1 set x 111
                     41:     uplevel #2 set y 222
                     42:     uplevel 2 set x 333
                     43:     uplevel #1 set y 444
                     44:     uplevel 3 set x 555
                     45:     uplevel #0 set y 666
                     46: }
                     47: a1
                     48: check $a 333 3
                     49: check $a1 444 4
                     50: check $b 111 5
                     51: check $b1 222 6
                     52: check $x 555 7
                     53: check $y 666 8
                     54: 
                     55: check [catch c1 foo] 1 9
                     56: check $foo {bad level "#2"} 10
                     57: check [catch {uplevel gorp}] 1 11
                     58: check [catch {uplevel 1 gorp} foo] 1 12
                     59: check $foo {bad level "1"} 13
                     60: 
                     61: proc a2 {} {
                     62:     uplevel a3
                     63: }
                     64: proc a3 {} {
                     65:     global x y
                     66:     set x [info level]
                     67:     set y [info level 1]
                     68: }
                     69: a2
                     70: check $x 1 14
                     71: check $y a3 15
                     72: 
                     73: check [catch uplevel foo] 1 16
                     74: check $foo {too few args:  should be "uplevel [level] command ..."} 17

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.