Tcl Source Code

Artifact 5a105a3c2406703afa6800b35e5dd9e553b40157:

proc stack {} {
    set l [info level]
    incr l -1
    set s $l:
    while {$l} {
	append s \n\t[info level $l]
	incr l -1
    }
    return $s
}

set obj [oo::object new]
oo::objdefine $obj {
    method 4a {} {
	puts [stack]
	uplevel 1 [list [self] 4b]
    }
    method 4b {} {
	puts [stack]
	my 5a
    }
    method 5a {} {
	puts [stack]
	uplevel 1 my 5b
    }
    method 5b {} {
	puts [stack]
	uplevel #0 {
	    oo::objdefine [oo::object new] {
		puts [stack]
		error !
	    }
	}
    }
    export 4a 4b
}

proc 3c {} {
    uplevel 1 {puts [stack]}
    puts [stack]
    $::obj 4a
}
interp hide {} 3c

proc 1a {} {
    puts [stack]
    2a
}
proc 2a {} {
    puts [stack]
    apply {{} {
	    puts [stack]
	    uplevel 1 3b
    }}
}
proc 3b {} {
    puts [stack]
    uplevel 2 {
	namespace eval 2b {
		puts [::stack]
		uplevel #0 1b
	}
    }
}
proc 1b {} {
    puts [stack]
    interp invokehidden {} -namespace :: 3c
}
catch 1a m o
puts EI:[dict get $o -errorinfo]\n
puts -nonewline ES:
foreach {token value} [dict get $o -errorstack] {
    puts [list $token $value]
}