# tcl_switch_traceline_repro.tcl
# 2026-07-14 Agent-Generated (supporting material for upstream Tcl ticket
# https://core.tcl-lang.org/tcl/tktview/5d5b1052280c976ea3d4 - execution trace on
# nested switch: inconsistent line depending on options)
#
# Pure-Tcl minimal repro - no punkshell code. Run under any tclsh:
#   tclsh tcl_switch_traceline_repro.tcl
# Verified byte-identical output pattern on Tcl 8.6.17, 8.7a6 and 9.0.3.
#
# Setup: proc bodies are passed via a variable so they have no source-file line
# correlation (as for interactively defined procs) - enterstep 'info frame' line
# values are then script-relative. Each switch arm body is "{\n <marker>\n }", so
# a correctly attributed arm-body command always reports line 2 (arm-relative).
#
# Observed (WRONG marked *): the number of mis-attributed leading arms varies
# with the words of the inner switch command:
#   switch $c <block>                 (3 words): arms 1-5,def -> 2 2 2 2 2 2
#   switch -- $c <block>              (4 words): arms        -> 3* 3* 2 2 2 2
#   switch -exact -- $c <block>       (5 words): arms        -> 3* 2 2 2 2 2
#   switch -exact -nocase -- $c <block> (6 words): arms      -> 3* 3* 3* 2 2 2
#
# Empirical law (fits all shapes above plus deeper nestings): an arm body at
# index j of the split pattern/body list is mis-attributed exactly when j lands
# on a LITERAL word of the switch command itself (an option word, --, or the
# block word) - i.e. j < (command word count) and that word is not dynamic.
# The wrong value = arm-relative line + (line of the switch command within its
# containing script - 1): the arm body is treated as if it began at the switch
# command's own line. Dynamic words ($c) and out-of-range j fall back to correct
# arm-relative attribution. Deeper nesting increases the shift accordingly (a
# switch at line 5 of its containing arm script mis-attributes by +4).
#
# The mis-attribution is stable and position-based - NOT call-order based
# (calling arm 3 first still reports arm 3 correctly and arm 1 wrongly later).
#
# Suspected machinery (from reading core-9-1-b1 sources): Tcl_SwitchObjCmd
# (tclCmdMZ.c) passes the split-list index j as the 'word' argument to
# TclNREvalObjEx for the matched body; TclInitCompileEnv (tclCompile.c) then
# gates on (ctxPtr->nline <= word) || (ctxPtr->line[word] < 0) and otherwise
# adopts ctxPtr->line[word] as the compile base line - consistent with j being
# tested against a per-word line array describing the switch COMMAND's words
# rather than the split list elements (the TIP280 munging in Tcl_SwitchObjCmd's
# splitObjs block appears intended to prevent exactly this, so either it is not
# reached on this path or the un-munged frame leaks through another route).

foreach m {m1 m2 m3 m4 m5 m6} {
    proc $m {} [list return $m]
}
set armblock {
            1 {
                m1
            }
            2 {
                m2
            }
            3 {
                m3
            }
            4 {
                m4
            }
            5 {
                m5
            }
            default {
                m6
            }
        }
foreach {pname header} {
    t_w3 {switch $c }
    t_w4 {switch -- $c }
    t_w5 {switch -exact -- $c }
    t_w6 {switch -exact -nocase -- $c }
} {
    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"
    proc ::$pname {s} $body
}

proc stepper {target args} {
    set f [info frame -2]
    if {[dict exists $f proc] && [dict get $f proc] eq $target} {
        set line NA
        catch {set line [dict get $f line]}
        lappend ::steps [list [dict get $f type] $line]
    }
}
foreach pname {t_w3 t_w4 t_w5 t_w6} {
    trace add execution ::$pname enterstep [list stepper ::$pname]
    set report {}
    foreach input {a1 a2 a3 a4 a5 a9} {
        set ::steps {}
        ::$pname $input
        #last step is the marker command inside the matched innermost arm body
        lappend report "arm[string index $input 1]=[lindex $::steps end 1]"
    }
    trace remove execution ::$pname enterstep [list stepper ::$pname]
    puts "$pname (expected arm-relative line 2 for every arm): $report"
}
puts "tcl: [info patchlevel]"