Return to uplevel.test CVS log

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

Annotation of researchv10no/cmd/worm/scsi/tcl/tests/uplevel.test, revision 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.