Posted to tcl by mr_calvin at Wed Dec 19 12:08:32 GMT 2018view raw

  1. set tracePrefix {apply {{args} {
  2. interp hide {} set
  3. proc set {args} {}; # NOOP
  4. trace add execution set leave {apply {{args} {
  5. rename set ""
  6. interp expose {} set
  7. }}}
  8. }}}
  9.  
  10. trace add execution set enter $tracePrefix
  11.  
  12. set x 1
  13.  
  14. puts [info vars x]
  15.  
  16. trace remove execution set enter $tracePrefix
  17.  
  18. set x 2
  19.  
  20. puts [info vars x]

Comments

Posted by sebres at Wed Dec 19 12:26:35 GMT 2018 [text] [code]

proc test {} { proc cmd {args} {puts " !! exec-cmd: $args"} set tracePrefix {apply {{args} { puts " ** trace -- $args **" if {[lindex $args 0 1] eq "--avoid-exec"} { interp hide {} cmd proc cmd {args} {}; # NOOP trace add execution cmd leave {apply {{args} { rename cmd "" interp expose {} cmd }}} } }}} trace add execution cmd enter $tracePrefix puts "1)"; cmd test1; puts ok1 puts "2)"; cmd --avoid-exec test2-no-exec; puts ok2 puts "3)"; cmd test3; puts ok3 puts "4)"; cmd --avoid-exec test4-no-exec; puts ok4 trace remove execution cmd enter $tracePrefix puts "5)"; cmd test5-no-trace; puts ok5 }; test