Commit 0f774f51 authored by Leigh Stoller's avatar Leigh Stoller

Fix contributed by Brian. The general idea is to allow global

variables to be renamed from within a subroutine:

	proc create_testnet {} {
		set s1 [$ns node]
 	}

Chris' redefined set did not allow this. This is further complicated
by the fact that its difficult to tell whats a global variable. You
can declare a variable global, but until its set for the first time,
the TCL info function will not tell you its a global. We do not want
to rename locals of course, since that would make no sense to do.
Anyway, Brian contributed the code to fix the new set function, and I
looked at it and did my best to understand it (I kinda do), but no way
I can be sure! I ran it through the test suite and spot checked the DB
state. Seems to work okay.
parent 8a29d3c4
......@@ -220,17 +220,34 @@ proc set {args} {
# There are a bunch of cases where we just pass through to real set.
if {[llength $args] == 1} {
return [uplevel real_set \{[lindex $args 0]\}]
} elseif {([info level] != 1) || ($last_class == {})} {
} elseif {($last_class == {})} {
return [uplevel real_set \{[lindex $args 0]\} \{[lindex $args 1]\}]
}
# At this point this is an assignment immediately after class creation.
real_set var [lindex $args 0]
real_set val [lindex $args 1]
# Run the set to make sure variables declared as global get registered
# as global (does not happen until first set).
real_set ret [uplevel real_set \{$var\} \{$val\}]
# Rename happens only when assigning to a global variable. Because of
# array syntax, must strip parens and indices to get the base variable
# name (has no effect if not an array access).
real_set l [split $var \(]
real_set base_var [lindex $l 0]
# Now check to see if its a global. No renaming if not a global.
if {[uplevel info globals $base_var] == {}} {
return $ret
}
# At this point this is an assignment immediately after class creation.
if {$val == $last_class} {
# Here we change ARRAY(INDEX) to ARRAY-INDEX
regsub -all {[\(]} $var {-} out
regsub -all {[\)]} $out {} val
# Sanity check
if {! [catch "uplevel info args $val"]} {
error "Already have an object named $val."
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment