Troubles with upvar and the trace mechanism from the tutorial. - Xotcl

19 Nov 2006


      I am passing an array name by reference across an instproc.
The vanilla version works just fine (see creation of x1 midway through the
code segment).
To add some debugging in, I essentially used the trace example from the
tutorial, and funnily,
the upvar stopped doing it's job (see error on creating x2 towards the end
of the code segment).
To get rudimentary debug control of the parray proc, I copied it into a proc
called barray.  None of the logic is changed -
just my crude attempt at adding breadcrumbs.
I have included the output at the end of the code segment.
Running Windows XP Pro + Active Tcl 8.4.13 + XoTcl 1.4.0.
thanks for all help.
-shishir
<CODE SEGMENT>
package require XOTcl
namespace import ::xotcl::*
proc barray {a {pattern "*"}} {
    puts "barray"
    upvar 1 $a arr
    if {![array exists arr]} {
        error ""$a" isn't an array"
    }
    set maxl 0
    foreach name [lsort [array names arr $pattern]] {
        if {[string length $name] > $maxl} {
            set maxl [string length $name]
        }
    }
    set maxl [expr {$maxl + [string length $a] + 2}]
    foreach name [lsort [array names arr $pattern]] {
        set nameString [format %s(%s) $a $name]
        puts stdout [format "%-*s = %s" $maxl $nameString $arr($name)]
    }
}
Class X
X instproc bar {ar args} {
  puts "bar"
  upvar $ar arr
  puts "upvard"
  barray arr
}
X instproc init {args} {
  array set arr {a 1 b 2}
  parray arr
  my bar arr
}
X x1
Object Trace
Trace set traceStream stdout
Trace proc openTraceFile name {
  my set traceStream [open $name w]
}
Trace proc closeTraceFile {} {
  close $Trace::traceStream
  my set traceStream stdout
}
Trace proc puts line {
  puts $Trace::traceStream $line
}
Trace proc add className {
  $className instfilter [concat [$className info filter] traceFilter]
}
Object instproc traceFilter args {
  # don't trace the Trace object
  if {[string equal [self] ::Trace]} {return [next]}
  set context "[self class]->[self callingproc]"
  set method [self calledproc]
  switch -- $method {
    proc -
    instproc {::set dargs [list [lindex $args 0] [lindex $args 1] ...] }
    default {::set dargs $args }
  }
  Trace::puts "CALL $context> [self]->$method $dargs"
  set result [next]
  Trace::puts "EXIT $context> [self]->$method ($result)"
  return $result
}
Trace add X
X x2
</CODE SEGMENT>
------------
<OUTPUT>
arr(a) = 1
arr(b) = 2
bar
upvard
barray
arr(a) = 1
arr(b) = 2
CALL ::xotcl::Object->> ::x2->cleanup
EXIT ::xotcl::Object->> ::x2->cleanup ()
CALL ::xotcl::Object->> ::x2->configure
EXIT ::xotcl::Object->> ::x2->configure (0)
CALL ::xotcl::Object->> ::x2->init
arr(a) = 1
arr(b) = 2
CALL ::xotcl::Object->init> ::x2->bar arr
bar
upvard
barray
"arr" isn't an array
</OUTPUT>
----
<ERRORINFO>
% set errorInfo
"arr" isn't an array
    while executing
"error ""$a" isn't an array""
    (procedure "barray" line 5)
    invoked from within
"barray arr"
    (procedure "bar" line 6)
    invoked from within
"next"
    (procedure "bar" line 13)
    ::x2 ::xotcl::Object->traceFilter
    invoked from within
"my bar arr"
    (procedure "init" line 5)
    invoked from within
"next"
    (procedure "init" line 13)
    ::x2 ::xotcl::Object->traceFilter
    ::X ::xotcl::Class->recreate
    ::X ::xotcl::Class->create
    ::X ::xotcl::Class->unknown
    invoked from within
"X x2"
    (file "c:/temp/trace_trouble.tcl" line 81)
    invoked from within
"source c:/temp/trace_trouble.tcl"
</ERRORINFO>