# Commands covered: upvar # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright 1991 Regents of the University of California # Permission to use, copy, modify, and distribute this # software and its documentation for any purpose and without # fee is hereby granted, provided that this copyright notice # appears in all copies. The University of California makes no # representations about the suitability of this software for any # purpose. It is provided "as is" without express or implied # warranty. # # $Header: /sprite/src/lib/tcl/tests/RCS/upvar.test,v 1.1 91/10/03 16:47:56 ouster Exp $ (Berkeley) if {[string compare test [info procs test]] == 1} then {source defs} test upvar-1.1 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a} p1 foo bar } {foo bar 22 33 abc} test upvar-1.2 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {p3} proc p3 {} {upvar 2 a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a} p1 foo bar } {foo bar 22 33 abc} test upvar-1.3 {reading variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {p3} proc p3 {} { upvar #1 a x1 b x2 c x3 d x4 set a abc list $x1 $x2 $x3 $x4 $a } p1 foo bar } {foo bar 22 33 abc} test upvar-1.4 {reading variables with upvar} { set x1 44 set x2 55 proc p1 {} {p2} proc p2 {} { upvar 2 x1 x1 x2 a upvar #0 x1 b set c $b incr b 3 list $x1 $a $b } p1 } {47 55 47} test upvar-2.1 {writing variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d} proc p2 {} { upvar a x1 b x2 c x3 d x4 set x1 14 set x4 88 } p1 foo bar } {14 bar 22 88} test upvar-2.2 {writing variables with upvar} { set x1 44 set x2 55 proc p1 {x1 x2} { upvar #0 x1 a upvar x2 b set a $x1 set b $x2 } p1 newbits morebits list $x1 $x2 } {newbits morebits} test upvar-2.3 {writing variables with upvar} { catch {unset x1} catch {unset x2} proc p1 {x1 x2} { upvar #0 x1 a upvar x2 b set a $x1 set b $x2 } p1 newbits morebits list [catch {set x1} msg] $msg [catch {set x2} msg] $msg } {0 newbits 0 morebits} test upvar-3.1 {unsetting variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]} proc p2 {} { upvar 1 a x1 d x2 unset x1 x2 } p1 foo bar } {b c} test upvar-3.2 {unsetting variables with upvar} { proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]} proc p2 {} { upvar 1 a x1 d x2 unset x1 x2 set x2 28 } p1 foo bar } {b c d} test upvar-3.3 {unsetting variables with upvar} { set x1 44 set x2 55 proc p1 {} {p2} proc p2 {} { upvar 2 x1 a upvar #0 x2 b unset a b } p1 list [info exists x1] [info exists x2] } {0 0} test upvar-3.4 {unsetting variables with upvar} { set x1 44 set x2 55 proc p1 {} { upvar x1 a x2 b unset a b set b 118 } p1 list [info exists x1] [catch {set x2} msg] $msg } {0 0 118} test upvar-4.1 {nested upvars} { set x1 88 proc p1 {a b} {set c 22; set d 33; p2} proc p2 {} {global x1; upvar c x2; p3} proc p3 {} { upvar x1 a x2 b list $a $b } p1 14 15 } {88 22} test upvar-4.2 {nested upvars} { set x1 88 proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d} proc p2 {} {global x1; upvar c x2; p3} proc p3 {} { upvar x1 a x2 b set a foo set b bar } list [p1 14 15] $x1 } {{14 15 bar 33} foo} proc tproc {args} {global x; set x [list $args [uplevel info vars]]} test upvar-5.1 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2} proc p2 {} {upvar c x1; set x1 22} set x --- p1 foo bar set x } {{x1 {} w} x1} test upvar-5.2 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2} proc p2 {} {upvar c x1; set x1} set x --- p1 foo bar set x } {{x1 {} r} x1} test upvar-5.3 {traces involving upvars} { proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2} proc p2 {} {upvar c x1; unset x1} set x --- p1 foo bar set x } {{x1 {} u} x1} test upvar-6.1 {errors in upvar command} { list [catch upvar msg] $msg } {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}} test upvar-6.2 {errors in upvar command} { list [catch {upvar 1} msg] $msg } {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}} test upvar-6.3 {errors in upvar command} { list [catch {upvar a b} msg] $msg } {1 {already at top level}} test upvar-6.4 {errors in upvar command} { list [catch {upvar 1 a b} msg] $msg } {1 {already at top level}} test upvar-6.5 {errors in upvar command} { list [catch {upvar #0 a b} msg] $msg } {1 {already at top level}} test upvar-6.6 {errors in upvar command} { proc p1 {} {upvar a b c} list [catch p1 msg] $msg } {1 {wrong # args: should be "a ?level? otherVar localVar ?otherVar localVar ...?"}} test upvar-6.7 {errors in upvar command} { proc p1 {} {set a 33; upvar b a} list [catch p1 msg] $msg } {1 {variable "a" already exists}}