Posted to tcl by juliannoble2 at Tue Jul 14 05:57:50 GMT 2026view raw

  1. # tcl_switch_traceline_repro.tcl
  2. # 2026-07-14 Agent-Generated (supporting material for upstream Tcl ticket
  3. # https://core.tcl-lang.org/tcl/tktview/5d5b1052280c976ea3d4 - execution trace on
  4. # nested switch: inconsistent line depending on options)
  5. #
  6. # Pure-Tcl minimal repro - no punkshell code. Run under any tclsh:
  7. # tclsh tcl_switch_traceline_repro.tcl
  8. # Verified byte-identical output pattern on Tcl 8.6.17, 8.7a6 and 9.0.3.
  9. #
  10. # Setup: proc bodies are passed via a variable so they have no source-file line
  11. # correlation (as for interactively defined procs) - enterstep 'info frame' line
  12. # values are then script-relative. Each switch arm body is "{\n <marker>\n }", so
  13. # a correctly attributed arm-body command always reports line 2 (arm-relative).
  14. #
  15. # Observed (WRONG marked *): the number of mis-attributed leading arms varies
  16. # with the words of the inner switch command:
  17. # switch $c <block> (3 words): arms 1-5,def -> 2 2 2 2 2 2
  18. # switch -- $c <block> (4 words): arms -> 3* 3* 2 2 2 2
  19. # switch -exact -- $c <block> (5 words): arms -> 3* 2 2 2 2 2
  20. # switch -exact -nocase -- $c <block> (6 words): arms -> 3* 3* 3* 2 2 2
  21. #
  22. # Empirical law (fits all shapes above plus deeper nestings): an arm body at
  23. # index j of the split pattern/body list is mis-attributed exactly when j lands
  24. # on a LITERAL word of the switch command itself (an option word, --, or the
  25. # block word) - i.e. j < (command word count) and that word is not dynamic.
  26. # The wrong value = arm-relative line + (line of the switch command within its
  27. # containing script - 1): the arm body is treated as if it began at the switch
  28. # command's own line. Dynamic words ($c) and out-of-range j fall back to correct
  29. # arm-relative attribution. Deeper nesting increases the shift accordingly (a
  30. # switch at line 5 of its containing arm script mis-attributes by +4).
  31. #
  32. # The mis-attribution is stable and position-based - NOT call-order based
  33. # (calling arm 3 first still reports arm 3 correctly and arm 1 wrongly later).
  34. #
  35. # Suspected machinery (from reading core-9-1-b1 sources): Tcl_SwitchObjCmd
  36. # (tclCmdMZ.c) passes the split-list index j as the 'word' argument to
  37. # TclNREvalObjEx for the matched body; TclInitCompileEnv (tclCompile.c) then
  38. # gates on (ctxPtr->nline <= word) || (ctxPtr->line[word] < 0) and otherwise
  39. # adopts ctxPtr->line[word] as the compile base line - consistent with j being
  40. # tested against a per-word line array describing the switch COMMAND's words
  41. # rather than the split list elements (the TIP280 munging in Tcl_SwitchObjCmd's
  42. # splitObjs block appears intended to prevent exactly this, so either it is not
  43. # reached on this path or the un-munged frame leaks through another route).
  44.  
  45. foreach m {m1 m2 m3 m4 m5 m6} {
  46. proc $m {} [list return $m]
  47. }
  48. set armblock {
  49. 1 {
  50. m1
  51. }
  52. 2 {
  53. m2
  54. }
  55. 3 {
  56. m3
  57. }
  58. 4 {
  59. m4
  60. }
  61. 5 {
  62. m5
  63. }
  64. default {
  65. m6
  66. }
  67. }
  68. foreach {pname header} {
  69. t_w3 {switch $c }
  70. t_w4 {switch -- $c }
  71. t_w5 {switch -exact -- $c }
  72. t_w6 {switch -exact -nocase -- $c }
  73. } {
  74. set body "\n set c \[string index \$s 1\]\n switch -- \[string index \$s 0\] {\n a {\n $header {$armblock}\n }\n default {\n m6\n }\n }\n"
  75. proc ::$pname {s} $body
  76. }
  77.  
  78. proc stepper {target args} {
  79. set f [info frame -2]
  80. if {[dict exists $f proc] && [dict get $f proc] eq $target} {
  81. set line NA
  82. catch {set line [dict get $f line]}
  83. lappend ::steps [list [dict get $f type] $line]
  84. }
  85. }
  86. foreach pname {t_w3 t_w4 t_w5 t_w6} {
  87. trace add execution ::$pname enterstep [list stepper ::$pname]
  88. set report {}
  89. foreach input {a1 a2 a3 a4 a5 a9} {
  90. set ::steps {}
  91. ::$pname $input
  92. #last step is the marker command inside the matched innermost arm body
  93. lappend report "arm[string index $input 1]=[lindex $::steps end 1]"
  94. }
  95. trace remove execution ::$pname enterstep [list stepper ::$pname]
  96. puts "$pname (expected arm-relative line 2 for every arm): $report"
  97. }
  98. puts "tcl: [info patchlevel]"

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week