Posted to tcl by mr_calvin at Fri Oct 21 13:16:52 GMT 2016view raw

  1. # How-to run: `tclsh mem.tcl`
  2. #
  3. # Explanation: On shell exit, ::tcl namespace is not cleaned up, which
  4. # leaves Tcl_Objs referenced from within ::tcl with unbalanced
  5. # refcounts on exit. Their freeIntRepProcs are not executed. This
  6. # happens in interactive shells with the history (::history) feature
  7. # on, because it maintains the array ::tcl::history which, upon the
  8. # event Tcl_Objs shimmering from string to bytecode intreps, maintains
  9. # references beyond the point of shell exit (can be "fixed" by
  10. # deactivating the history by redefining the proc history to a NOOP,
  11. # or by calling ::history clear before exit).
  12. #
  13. # Example: The below example reproduces a variant of the issue in a
  14. # non-interactive shell (it is not a bytecode Tcl_Obj becoming
  15. # referenced from the ::tcl::HISTORY array, but a list). The refcount
  16. # bump in <<4b>> is not balanced (3->2) ... so, the freeIntRepProc of
  17. # 'new' Tcl_Obj is *never* (MethodFreeInternalRep) executed.
  18.  
  19.  
  20. set name "new"
  21. puts <<1>>[tcl::unsupported::representation $name]; # string(2)
  22. package req nx;
  23. puts <<2>>[tcl::unsupported::representation $name]; # string(2)
  24. set script [list ::nx::Object $name]
  25. puts <<3a>>[tcl::unsupported::representation $name]; # string(3) (+1 via list)
  26. puts <<3b>>[tcl::unsupported::representation $script]; # list(2)
  27. set ::tcl::HISTORY(1) $script
  28. ## FIX-1: the below would keep refcounts balanced on exit, because the global ns is cleared:
  29. # set ::tcl_HISTORY(1) $script
  30. puts <<4a>>[tcl::unsupported::representation $name]; # string(3)
  31. puts <<4b>>[tcl::unsupported::representation $script]; # list(3) (+1 via array)
  32. try $script; # $script is compiled (intrep -> bytecode), 'new' becomes nsfInstanceMethod intrep with NsfMethodContext
  33. puts <<5a>>[tcl::unsupported::representation $name]; # nsfInstanceMethod(3)
  34. puts <<5b>>[tcl::unsupported::representation $script]; # list(3)
  35.  
  36. ## FIX-2: explicit deletes
  37. # unset ::tcl::HISTORY
  38.