Tcl Source Code

The script below produces the following error:

variable "item" already exists
    while executing
"variable item tmpa/a/one"
    ("uplevel" body line 1)
    invoked from within
"uplevel [list variable $varname $val]"
    (procedure "for" line 34)
...

The script is a little verbose, but it's the most whittled-down excerpt which still produces the error:

#! /bin/env tclsh

if {[namespace which [namespace current]::for_global] eq {}} {
rename ::for for_global
if {[namespace current] ne "::"} {
interp alias {} ::for {} [namespace current]::for
}
}

proc for args {
if {[lindex $args 1] eq "in"} {
if {[llength $args] % 3 != 1} {
return -code error "wrong # of arguments"
}
set iters [dict create]
set vars [dict create]
while {[llength $args] > 1} {
set args [lassign $args[unset args] varnames /dev/null iter]
if {$iter ne {} && [uplevel [::list namespace which $iter]] eq {}} {
return -code error "no such iterator: $iter.  Maybe \[foreach] was intended?"
}
dict set iters $iter 1 
dict set vars $varnames $iter
}
set body [lindex $args[set args {}] 0]
while {[dict size $iters]} {
set newvals[set newvals {}] [dict create]
dict for {varnames iter} $vars {
foreach varname $varnames {
if {[namespace which $iter] eq {}} {
dict set newvals $varname {}
} else {
dict set newvals $varname [uplevel [list $iter]]
if {[namespace which $iter] eq {}} {
dict unset iters $iter
dict set newvals $varname {}
}
}
}
}
if {[dict size $iters]} {
dict for {varname val} $newvals {
uplevel [list variable $varname $val]
}
set code [catch {uplevel $body} result]
switch -exact -- $code {
0 {}
1 {
return  -errorcode $::errorCode -code error $result
}
3 {
# FRINK: nocheck
return
}
4 {}
default {
return -code $code $result
}
}
} else {
break
}
}
} else {
uplevel [list [namespace current]::for_global {*}$args]
}
}

proc iterdir {path} {
variable uniqueid
set subdirs [list $path]
coroutine [incr uniqueid] apply { path {
set yield [yield [info coroutine]]
foreach item [glob -nocomplain -directory $path *] {
if {[file isdirectory $item]} {
for item in [iterdir $item] {
yield $item
}
} else {
yield $item
}
}
}} $path
}

variable uniqueid 0

set tempdir [file mkdir zook1]
file mkdir [set tmpa [file join $tempdir tmpa]]

set res [list]
for item in [iterdir $tempdir] {
lappend res [string range $item [string length $tempdir] end]
}
puts $res

allow_comments - 1

as explained by ferrieux

Here's a much smaller case:

 % proc f {} {set item 1;g}
 % proc g {} {uplevel {variable item 2}}
 % f
 variable "item" already exists

It is collision between a local and an attempt to define a new namespace variable with the same name.
You can even trigger it without uplevelling:

 % proc h {} {set item 1;variable item 2}
 % h
 variable "item" already exists

I dunno whether Tcl should be blamed for that. As a programmer, I can't imagine a case where this wouldn't actually detect a PBKAC ;)

pasted code got indentation stripped, so attaching file as well

File Added - 456677: tmp1