@ -123,16 +123,25 @@ namespace eval argparsingtest {
# title - table section heading used by compare # title - table section heading used by compare
# argvec - default timing argument vector for the style # argvec - default timing argument vector for the style
# roster - parser proc name -> marker, where marker is one of: # roster - parser proc name -> marker, where marker is one of:
# always - proc unconditionally defined in argparsingtest::<style> # always - proc unconditionally defined in argparsingtest::<style>
# argp - proc defined unconditionally but callable only when the # {optional P} - proc defined unconditionally but callable only when the
# optional argp package loaded at module require time # optional package P loaded at module require time
# unsupported - the backing library cannot express this calling style # (see the optional-package requires below); reported as
# (no proc exists); reported as unsupported and shown as # loaded when P is present, not_loaded otherwise
# an N/A row by compare rather than being omitted # unsupported - the backing library cannot express this calling style
# (no proc exists); reported as unsupported and shown as
# an N/A row by compare rather than being omitted
# Styles: # Styles:
# opts - keyed options only # opts - keyed options only
# tkstyle - 2 mandatory positionals THEN options ('tk style', as in: .c create rect 1 2 3 4 -fill red) # tkstyle - 2 mandatory positionals THEN options ('tk style', as in: .c create rect 1 2 3 4 -fill red)
# tclstyle - options THEN 2 mandatory positionals ('tcl style', as in: lsearch -exact $list $val) # tclstyle - options THEN 2 mandatory positionals ('tcl style', as in: lsearch -exact $list $val)
# sandwich - 2 mandatory positionals, THEN options, THEN 3 more mandatory positionals.
# The asymmetric 2/3 split is deliberate: it catches a parser that
# merely splits the positional block evenly or matches it by count
# from one end. This is the STRICT sandwich - a parser is only
# credited with the style if it binds the leaders and the trailing
# values in that arrangement; see the sandwich namespace comment
# for what that does and does not say about permissive parsers.
# The manual_* roster membership differs deliberately: all manual option-loop # The manual_* roster membership differs deliberately: all manual option-loop
# variants are compared in the opts style; the positional styles carry a single # variants are compared in the opts style; the positional styles carry a single
# manual_switch baseline since the option-loop technique comparison is orthogonal # manual_switch baseline since the option-loop technique comparison is orthogonal
@ -157,7 +166,9 @@ namespace eval argparsingtest {
opt always opt always
cmdline_untyped always cmdline_untyped always
cmdline_typed always cmdline_typed always
argp argp argp {optional argp}
parse_args {optional parse_args}
argparse {optional argparse}
tepam always tepam always
} }
} }
@ -171,9 +182,11 @@ namespace eval argparsingtest {
punkargs_parsecache always punkargs_parsecache always
opt always opt always
tepam always tepam always
argparse {optional argparse}
cmdline_untyped unsupported cmdline_untyped unsupported
cmdline_typed unsupported cmdline_typed unsupported
argp unsupported argp unsupported
parse_args unsupported
} }
} }
tclstyle { tclstyle {
@ -188,18 +201,51 @@ namespace eval argparsingtest {
cmdline_untyped always cmdline_untyped always
cmdline_typed always cmdline_typed always
tepam always tepam always
parse_args {optional parse_args}
argparse {optional argparse}
argp unsupported argp unsupported
} }
} }
sandwich {
title "sandwich style (2 leaders, options, 3 trailing)"
argvec {alpha beta -return object -join -x hello -y world -1 1 -2 2 -3 3 gamma delta epsilon}
roster {
manual_switch always
punkargs always
punkargs_by_id always
punkargs_parsecache always
opt always
argparse {optional argparse}
cmdline_untyped unsupported
cmdline_typed unsupported
tepam unsupported
argp unsupported
parse_args unsupported
}
}
}] }]
# Optional external parser packages that DO have timing wrappers (see the
# {optional P} roster markers above). Required once here, guarded by catch,
# so discover_parsers can probe them with side-effect-free 'package present'
# - matching how the opts::argp registration site requires argp.
# Both are binary extensions and neither ships with a stock tclsh; which of
# them is present varies per runtime. Surveyed 2026-07-26:
# both bin/runtime/win32-ix86/tclsh8.6.10-luck-test2.exe
# (argparse 0.61, parse_args 0.5.1)
# argparse only the native Tcl 9.0.3 install (argparse0.61 in its lib dir)
# parse_args only punk902z and punk91 kits (lib_tcl9/parse_args0.5.1)
# neither punk905
# On runtimes without them the wrapper procs stay defined but discover_parsers
# reports not_loaded, so the harness never calls them.
catch {package require parse_args}
catch {package require argparse}
# Optional external parser packages probed by discover_parsers (parser name -> package name). # Optional external parser packages probed by discover_parsers (parser name -> package name).
# No timing wrappers are shipped for these: present -> not_wrappable, absent -> not_loaded. # No timing wrappers are shipped for these: present -> not_wrappable, absent -> not_loaded.
variable optional_externals variable optional_externals
set optional_externals { set optional_externals {
getopt getopt getopt getopt
parse_args parse_args
argparse argparse
cmdr cmdr cmdr cmdr
} }
@ -208,7 +254,7 @@ namespace eval argparsingtest {
@cmd -name argparsingtest::discover_parsers\ @cmd -name argparsingtest::discover_parsers\
-summary "Discover available argument parsers per parsing style"\ -summary "Discover available argument parsers per parsing style"\
-help\ -help\
"Returns a dict keyed by style (opts tkstyle tclstyle), each value "Returns a dict keyed by style (opts tkstyle tclstyle sandwich ), each value
a dict of parser proc names to their status for that style. a dict of parser proc names to their status for that style.
Statuses: Statuses:
@ -218,7 +264,7 @@ namespace eval argparsingtest {
unsupported - backing library cannot express this parsing style unsupported - backing library cannot express this parsing style
(shown as an N/A row in compare tables)" (shown as an N/A row in compare tables)"
@opts -anyopts 0 @opts -anyopts 0
-style -default all -type string -choices {all opts tkstyle tclstyle} -help\ -style -default all -type string -choices {all opts tkstyle tclstyle sandwich } -help\
"Style set(s) to report. Default all reports every style. "Style set(s) to report. Default all reports every style.
The result is keyed by style in all cases." The result is keyed by style in all cases."
} }
@ -237,15 +283,16 @@ namespace eval argparsingtest {
foreach s $stylelist { foreach s $stylelist {
set sresult {} set sresult {}
foreach {pname marker} [dict get $style_info $s roster] { foreach {pname marker} [dict get $style_info $s roster] {
switch -- $marker { switch -- [lindex $marker 0] {
always { always {
dict set sresult $pname loaded dict set sresult $pname loaded
} }
argp { optional {
# argp: proc defined unconditionally but registration guarded by catch at # {optional P}: proc defined unconditionally but its backing package
# module load; use package present to check whether the load-time require # require (argp's registration, or the module-level requires for
# succeeded (no side effects) # parse_args/argparse) is guarded by catch at module load; use package
if {[catch {package present argp}]} { # present to check whether that require succeeded (no side effects)
if {[catch {package present [lindex $marker 1]}]} {
dict set sresult $pname not_loaded dict set sresult $pname not_loaded
} else { } else {
dict set sresult $pname loaded dict set sresult $pname loaded
@ -284,7 +331,7 @@ namespace eval argparsingtest {
warmup - warmup count used warmup - warmup count used
Parsers that error during timing return {error <message>} instead." Parsers that error during timing return {error <message>} instead."
@opts -anyopts 0 @opts -anyopts 0
-style -default all -type string -choices {all opts tkstyle tclstyle} -help\ -style -default all -type string -choices {all opts tkstyle tclstyle sandwich } -help\
"Style set(s) to time. The result is keyed by style in all cases." "Style set(s) to time. The result is keyed by style in all cases."
-iterations -default 1000 -type integer -help\ -iterations -default 1000 -type integer -help\
"Number of timed invocations per parser." "Number of timed invocations per parser."
@ -314,7 +361,7 @@ namespace eval argparsingtest {
set stylelist [list $style] set stylelist [list $style]
} }
if {[llength $argvec] && [llength $stylelist] > 1} { if {[llength $argvec] && [llength $stylelist] > 1} {
error "timeit: -args requires a single -style (opts, tkstyle or tclstyle)" error "timeit: -args requires a single -style (one of: o pts tkstyle tclstyle sandwich )"
} }
set result {} set result {}
@ -490,6 +537,33 @@ namespace eval argparsingtest {
argparsingtest::libwarmup_argp -w 1 argparsingtest::libwarmup_argp -w 1
} }
# parse_args and argparse warm-ups exercise option, flag and positional
# handling through a sacrificial proc, so the library internals are compiled
# before the timed call. Both are single warm-ups covering every style: the
# library_warmups dict is keyed by parser name only, and the parse_args /
# argparse wrappers share their name across the styles they support.
dict set library_warmups parse_args {
proc ::argparsingtest::libwarmup_parse_args {args} {
::parse_args::parse_args $args {
-w {-default 0}
-wflag {-boolean}
wpos {-required}
} res
return $res
}
::argparsingtest::libwarmup_parse_args -w 1 -wflag pval
}
dict set library_warmups argparse {
proc ::argparsingtest::libwarmup_argparse {args} {
return [::argparse -inline -mixed {
{-w -argument -default 0}
{-wflag}
{wpos}
} $args]
}
::argparsingtest::libwarmup_argparse -w 1 -wflag pval
}
punk::args::define { punk::args::define {
@id -id ::argparsingtest::first_call @id -id ::argparsingtest::first_call
@cmd -name argparsingtest::first_call\ @cmd -name argparsingtest::first_call\
@ -522,7 +596,7 @@ namespace eval argparsingtest {
first-call microseconds (float), or {error <message>} if the run first-call microseconds (float), or {error <message>} if the run
fails in the child interp." fails in the child interp."
@opts -anyopts 0 @opts -anyopts 0
-style -default all -type string -choices {all opts tkstyle tclstyle} -help\ -style -default all -type string -choices {all opts tkstyle tclstyle sandwich } -help\
"Style set(s) to time. The result is keyed by style in all cases." "Style set(s) to time. The result is keyed by style in all cases."
-parsers -default {} -type list -help\ -parsers -default {} -type list -help\
"List of parser proc names to time. Empty (default) times "List of parser proc names to time. Empty (default) times
@ -642,14 +716,18 @@ namespace eval argparsingtest {
backing library cannot express a style are still listed for that backing library cannot express a style are still listed for that
style, as N/A rows below the timed rows. style, as N/A rows below the timed rows.
- table: per-style human-readable matrix - table: per-style human-readable matrix
(first_cold/first_warm columns are first_call timings) (first_cold/first_warm columns are first_call timings).
Parsers whose backing package is absent are listed on a
'not loaded:' line; optional packages that are present but
have no timing wrapper get a separate 'no timing wrapper:' line
- dict: {results {style {...}} first_call {style {...}} - dict: {results {style {...}} first_call {style {...}}
not_loaded {style {...}} unsupported {style {...}}} not_loaded {style {...}} not_wrappable {style {...}}
unsupported {style {...}}}
first_call values are {cold <us> warm <us>} sub-dicts (see first_call) first_call values are {cold <us> warm <us>} sub-dicts (see first_call)
- json: JSON object with results, first_call, not_loaded and - json: JSON object with results, first_call, not_loaded,
unsupported keys, each keyed by style" not_wrappable and unsupported keys, each keyed by style"
@opts -anyopts 0 @opts -anyopts 0
-style -default all -type string -choices {all opts tkstyle tclstyle} -help\ -style -default all -type string -choices {all opts tkstyle tclstyle sandwich } -help\
"Style set(s) to compare: all (default) or a single style." "Style set(s) to compare: all (default) or a single style."
-format -default table -type string -choices {table dict json} -help\ -format -default table -type string -choices {table dict json} -help\
"Output format: table (default), dict, or json." "Output format: table (default), dict, or json."
@ -682,24 +760,28 @@ namespace eval argparsingtest {
set stylelist [list $style] set stylelist [list $style]
} }
if {[llength $argvec] && [llength $stylelist] > 1} { if {[llength $argvec] && [llength $stylelist] > 1} {
error "compare: -args requires a single -style (opts, tkstyle or tclstyle)" error "compare: -args requires a single -style (one of: o pts tkstyle tclstyle sandwich )"
} }
set discovered [discover_parsers] set discovered [discover_parsers]
# Per style: partition the roster (restricted to -parsers when given) into # Per style: partition the roster (restricted to -parsers when given) into
# timing candidates (loaded), N/A rows (unsupported) and the not-loaded # timing candidates (loaded), N/A rows (unsupported) and the two footer
# footer list. Requested names unknown to the roster are passed through to # lists - packages absent from this runtime (not_loaded) and packages
# timeit so they surface as error entries rather than vanishing silently. # present but shipped without a timing wrapper (not_wrappable). Requested
set timeit_dict {} ;# {style {pname timing}} # names unknown to the roster are passed through to timeit so they surface
set first_call_dict {} ;# {style {pname {cold <us> warm <us>}}} # as error entries rather than vanishing silently.
set na_dict {} ;# {style {pname ...}} - unsupported for the style set timeit_dict {} ;# {style {pname timing}}
set not_loaded_dict {} ;# {style {pname ...}} - not_loaded or not_wrappable set first_call_dict {} ;# {style {pname {cold <us> warm <us>}}}
set na_dict {} ;# {style {pname ...}} - unsupported for the style
set not_loaded_dict {} ;# {style {pname ...}} - backing package absent
set not_wrappable_dict {} ;# {style {pname ...}} - package present, no wrapper shipped
foreach s $stylelist { foreach s $stylelist {
set sdisco [dict get $discovered $s] set sdisco [dict get $discovered $s]
set candidates {} set candidates {}
set na {} set na {}
set notloaded {} set notloaded {}
set notwrappable {}
if {[llength $parsers]} { if {[llength $parsers]} {
set requested $parsers set requested $parsers
} else { } else {
@ -711,13 +793,15 @@ namespace eval argparsingtest {
continue continue
} }
switch -- [dict get $sdisco $pname] { switch -- [dict get $sdisco $pname] {
loaded { lappend candidates $pname } loaded { lappend candidates $pname }
unsupported { lappend na $pname } unsupported { lappend na $pname }
default { lappend notloaded $pname } not_wrappable { lappend notwrappable $pname }
default { lappend notloaded $pname }
} }
} }
dict set na_dict $s $na dict set na_dict $s $na
dict set not_loaded_dict $s $notloaded dict set not_loaded_dict $s $notloaded
dict set not_wrappable_dict $s $notwrappable
if {[llength $candidates]} { if {[llength $candidates]} {
set timeit_args [list -style $s -iterations $iterations -warmup $warmup -parsers $candidates] set timeit_args [list -style $s -iterations $iterations -warmup $warmup -parsers $candidates]
@ -740,6 +824,7 @@ namespace eval argparsingtest {
set sfc [dict get $first_call_dict $s] set sfc [dict get $first_call_dict $s]
set sna [dict get $na_dict $s] set sna [dict get $na_dict $s]
set snotloaded [dict get $not_loaded_dict $s] set snotloaded [dict get $not_loaded_dict $s]
set snotwrap [dict get $not_wrappable_dict $s]
set colwidth 6 set colwidth 6
foreach nm [concat [dict keys $stimeit] $sna] { foreach nm [concat [dict keys $stimeit] $sna] {
@ -787,6 +872,9 @@ namespace eval argparsingtest {
} else { } else {
lappend lines "not loaded: (none)" lappend lines "not loaded: (none)"
} }
if {[llength $snotwrap] > 0} {
lappend lines "no timing wrapper: [join $snotwrap {, }]"
}
if {[llength $error_names] > 0} { if {[llength $error_names] > 0} {
lappend lines "errors: [join $error_names {, }]" lappend lines "errors: [join $error_names {, }]"
} }
@ -795,13 +883,14 @@ namespace eval argparsingtest {
return [join $style_blocks \n\n] return [join $style_blocks \n\n]
} }
dict { dict {
return [dict create results $timeit_dict first_call $first_call_dict not_loaded $not_loaded_dict unsupported $na_dict] return [dict create results $timeit_dict first_call $first_call_dict not_loaded $not_loaded_dict not_wrappable $not_wrappable_dict unsupported $na_dict]
} }
json { json {
package require json::write package require json::write
set results_pairs {} set results_pairs {}
set fc_pairs {} set fc_pairs {}
set nl_pairs {} set nl_pairs {}
set nw_pairs {}
set na_pairs {} set na_pairs {}
foreach s $stylelist { foreach s $stylelist {
set timing_jsons [dict map {k v} [dict get $timeit_dict $s] { set timing_jsons [dict map {k v} [dict get $timeit_dict $s] {
@ -835,9 +924,10 @@ namespace eval argparsingtest {
lappend fc_pairs $s [json::write object {*}$fc_style_pairs] lappend fc_pairs $s [json::write object {*}$fc_style_pairs]
lappend nl_pairs $s [json::write array-strings {*}[dict get $not_loaded_dict $s]] lappend nl_pairs $s [json::write array-strings {*}[dict get $not_loaded_dict $s]]
lappend nw_pairs $s [json::write array-strings {*}[dict get $not_wrappable_dict $s]]
lappend na_pairs $s [json::write array-strings {*}[dict get $na_dict $s]] lappend na_pairs $s [json::write array-strings {*}[dict get $na_dict $s]]
} }
return [json::write object results [json::write object {*}$results_pairs] first_call [json::write object {*}$fc_pairs] not_loaded [json::write object {*}$nl_pairs] unsupported [json::write object {*}$na_pairs]] return [json::write object results [json::write object {*}$results_pairs] first_call [json::write object {*}$fc_pairs] not_loaded [json::write object {*}$nl_pairs] not_wrappable [json::write object {*}$nw_pairs] unsupported [json::write object {*}$na_pairs]]
} }
} }
} }
@ -1545,6 +1635,89 @@ namespace eval argparsingtest::opts {
return [array get opts] return [array get opts]
} }
# parse_args and argparse (both binary extensions - see the optional-package
# requires in the argparsingtest base namespace) are called by their fully
# qualified names throughout: the wrapper procs deliberately share the
# package/command name, so an unqualified call would resolve to the wrapper
# itself (infinite recursion for argparse) rather than to the library.
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::opts::parse_args
@cmd -name argparsingtest::opts::parse_args -summary "parse_args package arg parsing" -help\
"Accepts 10 keyed options plus -join. Uses parse_args::parse_args
with a result-dict variable rather than its set-locals default, so
the return shape matches the other opts-style wrappers. Result keys
are the option names with the leading dash stripped."
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
}]
}
proc parse_args {args} {
::parse_args::parse_args $args {
-return {-default string}
-frametype {-default \uFFEF}
-show_edge {-default \uFFEF}
-show_seps {-default \uFFEF}
-join {-boolean}
-x {-default ""}
-y {-default b}
-z {-default c}
-1 {-default 1}
-2 {-default 2}
-3 {-default 3}
} opts
return $opts
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::opts::argparse
@cmd -name argparsingtest::opts::argparse -summary "argparse package arg parsing" -help\
"Accepts 10 keyed options plus -join. Uses argparse -inline, which
returns a dict rather than setting caller locals, so the return
shape matches the other opts-style wrappers. Switches taking a
value need an explicit -argument in the argparse element spec;
without it they are flags and the values become excess positionals."
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
}]
}
proc argparse {args} {
return [::argparse -inline {
{-return -argument -default string}
{-frametype -argument -default \uFFEF}
{-show_edge -argument -default \uFFEF}
{-show_seps -argument -default \uFFEF}
{-join}
{-x -argument -default ""}
{-y -argument -default b}
{-z -argument -default c}
{-1 -argument -default 1}
{-2 -argument -default 2}
{-3 -argument -default 3}
} $args]
}
namespace eval argdoc { namespace eval argdoc {
lappend PUNKARGS [list { lappend PUNKARGS [list {
@id -id ::argparsingtest::opts::tepam @id -id ::argparsingtest::opts::tepam
@ -1597,6 +1770,10 @@ namespace eval argparsingtest::opts {
# argp has no wrapper in any positional style: argp::parseArgs walks the entire # argp has no wrapper in any positional style: argp::parseArgs walks the entire
# argument list as {key value} pairs, so any positional word errors as an # argument list as {key value} pairs, so any positional word errors as an
# unknown option (unsupported -> N/A row). # unknown option (unsupported -> N/A row).
# parse_args has no wrapper here either: undashed spec entries are only matched
# after the options, so a leading positional aborts the parse with its generic
# 'Invalid args, should be ?-option ...? ?arg ...?' usage error (unsupported ->
# N/A row). argparse IS supported, but only in -mixed mode - see its wrapper.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest::tkstyle { namespace eval argparsingtest::tkstyle {
namespace export {[a-z]*} ;# Convention: export all lowercase namespace export {[a-z]*} ;# Convention: export all lowercase
@ -1859,6 +2036,51 @@ namespace eval argparsingtest::tkstyle {
return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]]
} }
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::tkstyle::argparse
@cmd -name argparsingtest::tkstyle::argparse -summary "argparse package arg parsing, tk style" -help\
"Accepts 2 leading positional arguments then 10 keyed options plus -join.
Uses argparse -inline -mixed: argparse's default mode requires switches
to precede positionals and rejects leading positionals as excess
arguments, so -mixed (switches permitted anywhere) is what makes this
style expressible. Returns a list {p1 p2 optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
}]
}
proc argparse {args} {
set parsed [::argparse -inline -mixed {
{-return -argument -default string}
{-frametype -argument -default \uFFEF}
{-show_edge -argument -default \uFFEF}
{-show_seps -argument -default \uFFEF}
{-join}
{-x -argument -default ""}
{-y -argument -default b}
{-z -argument -default c}
{-1 -argument -default 1}
{-2 -argument -default 2}
{-3 -argument -default 3}
{p1}
{p2}
} $args]
return [list [dict get $parsed p1] [dict get $parsed p2] [dict remove $parsed p1 p2]]
}
#*** !doctools #*** !doctools
#[list_end] [comment {--- end definitions namespace argparsingtest::tkstyle ---}] #[list_end] [comment {--- end definitions namespace argparsingtest::tkstyle ---}]
} }
@ -1872,6 +2094,8 @@ namespace eval argparsingtest::tkstyle {
# options in the parser's natural form. # options in the parser's natural form.
# cmdline IS supported here: cmdline::getoptions consumes leading options and # cmdline IS supported here: cmdline::getoptions consumes leading options and
# leaves the trailing positionals in the caller's args variable. # leaves the trailing positionals in the caller's args variable.
# parse_args and argparse are both supported in this style - options-then-
# positionals is the arrangement each of them handles natively.
# argp has no wrapper (see the tkstyle namespace comment; unsupported -> N/A row). # argp has no wrapper (see the tkstyle namespace comment; unsupported -> N/A row).
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest::tclstyle { namespace eval argparsingtest::tclstyle {
@ -2235,12 +2459,485 @@ namespace eval argparsingtest::tclstyle {
return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]]
} }
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::tclstyle::parse_args
@cmd -name argparsingtest::tclstyle::parse_args -summary "parse_args package arg parsing, tcl style" -help\
"Accepts 10 keyed options plus -join, then 2 trailing positional arguments.
Positional arguments are declared by undashed name in the parse_args
spec and are only accepted after the options; -required makes both
mandatory. Returns a list {p1 p2 optsdict}."
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
}]
}
proc parse_args {args} {
::parse_args::parse_args $args {
-return {-default string}
-frametype {-default \uFFEF}
-show_edge {-default \uFFEF}
-show_seps {-default \uFFEF}
-join {-boolean}
-x {-default ""}
-y {-default b}
-z {-default c}
-1 {-default 1}
-2 {-default 2}
-3 {-default 3}
p1 {-required}
p2 {-required}
} parsed
return [list [dict get $parsed p1] [dict get $parsed p2] [dict remove $parsed p1 p2]]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::tclstyle::argparse
@cmd -name argparsingtest::tclstyle::argparse -summary "argparse package arg parsing, tcl style" -help\
"Accepts 10 keyed options plus -join, then 2 trailing positional arguments.
This is argparse's default arrangement - switches first, then
positionals - so no -mixed is needed here (contrast the tkstyle
wrapper). Returns a list {p1 p2 optsdict}."
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
}]
}
proc argparse {args} {
set parsed [::argparse -inline {
{-return -argument -default string}
{-frametype -argument -default \uFFEF}
{-show_edge -argument -default \uFFEF}
{-show_seps -argument -default \uFFEF}
{-join}
{-x -argument -default ""}
{-y -argument -default b}
{-z -argument -default c}
{-1 -argument -default 1}
{-2 -argument -default 2}
{-3 -argument -default 3}
{p1}
{p2}
} $args]
return [list [dict get $parsed p1] [dict get $parsed p2] [dict remove $parsed p1 p2]]
}
#*** !doctools #*** !doctools
#[list_end] [comment {--- end definitions namespace argparsingtest::tclstyle ---}] #[list_end] [comment {--- end definitions namespace argparsingtest::tclstyle ---}]
} }
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Parser implementations - sandwich style: 2 mandatory positionals, THEN the 10
# keyed options (the argvec exercises the valueless -join flag as well as
# -flag value pairs), THEN 3 more mandatory positionals.
# All procs return a 3-element list {leaders values opts} where leaders is
# {p1 p2}, values is {p3 p4 p5} and opts is the parsed options in the parser's
# natural form. The other positional styles return a flat {p1 p2 opts}; with
# positionals on BOTH sides of the options, grouping them keeps which-end-is-which
# unambiguous for the parser_contract test.
#
# Only three libraries have wrappers here. Verified 2026-07-26 against the
# packages available on bin/runtime/win32-ix86/tclsh8.6.10-luck-test2.exe:
# - punk::args models the arrangement directly - @leaders, @opts and @values are
# three separate sections - and rejects any other ordering.
# - opt fills positional slots in declaration order, with the flags declared
# between the leader slots and the trailing slots; it likewise rejects the
# options appearing ahead of the leaders.
# - argparse needs -mixed, which permits switches ANYWHERE. It parses this
# argvec correctly, but unlike the two above it does NOT enforce the
# arrangement: the identical spec also accepts all five positionals trailing,
# or positionals interleaved with options. It is timed here for parsing the
# style, which is not a claim that it can express the constraint.
# Its flag convention also differs, as opts is reported in each parser's
# natural form: a supplied bare flag yields an empty-string value and an
# omitted one is absent from the dict entirely, where the punk::args, opt and
# manual wrappers report -join as 1 or 0.
# Unsupported (N/A rows), each verified to fail on this argvec:
# - cmdline: cmdline::getoptions stops at the first non-option word, so it
# returns WITHOUT error having parsed nothing at all - every option left at its
# default and the whole argument list untouched. A wrapper would have to
# hand-roll the option scan itself, so this is unsupported rather than wrapped;
# the silent no-op is the reason it cannot be credited by a smoke test alone.
# - tepam: unnamed arguments form one contiguous block, either before or after
# the named ones (-named_arguments_first 0/1); it cannot split them across the
# options.
# - argp: argp::parseArgs walks the entire argument list as {key value} pairs.
# - parse_args: undashed spec entries only match after the options.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval argparsingtest::sandwich {
namespace export {[a-z]*} ;# Convention: export all lowercase
#*** !doctools
#[subsection {Namespace argparsingtest::sandwich}]
#[para] parser implementations - sandwich style: 2 leading positional arguments, then options, then 3 trailing positional arguments
#[list_begin definitions]
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::sandwich::manual_switch
@cmd -name argparsingtest::sandwich::manual_switch -summary "manual parsing - sandwich style baseline" -help\
"Accepts 2 leading positional arguments, then 10 keyed options plus the
valueless -join flag, then 3 trailing positional arguments.
The leading positionals are plain proc formal parameters; the option
loop consumes one word for -join and two for every other option, then
whatever remains must be exactly the 3 trailing positionals.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
}
proc manual_switch {p1 p2 args} {
set opts [dict create {*}{
-return string
-frametype \uFFEF
-show_edge \uFFEF
-show_seps \uFFEF
-join 0
-x ""
-y b
-z c
-1 1
-2 2
-3 3
}]
set i 0
set argc [llength $args]
while {$i < $argc} {
set k [lindex $args $i]
switch -- $k {
-join {
#valueless flag - consumes one word, not two
dict set opts -join 1
incr i
}
-return - -show_edge - -show_seps - -frametype - -x - -y - -z - -1 - -2 - -3 {
if {$i + 1 >= $argc} {
error "option '$k' requires a value"
}
dict set opts $k [lindex $args [expr {$i + 1}]]
incr i 2
}
default {
#first non-option word ends the option run - the trailing positionals
break
}
}
}
set values [lrange $args $i end]
if {[llength $values] != 3} {
error "expected exactly 3 trailing positional arguments, got [llength $values]"
}
return [list [list $p1 $p2] $values $opts]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::sandwich::punkargs
@cmd -name argparsingtest::sandwich::punkargs -summary "punk::args withdef, sandwich style" -help\
"Accepts 2 leading positional arguments, then 10 keyed options plus -join,
then 3 trailing positional arguments.
Uses punk::args::parse withdef with @leaders, @opts and @values sections -
the arrangement is declared, not inferred.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
}
proc punkargs {args} {
set argd [punk::args::parse $args withdef {
@id -id ::argparsingtest::sandwich::punkargs
@cmd -name argparsingtest::sandwich::punkargs -help "test of punk::args::parse comparative performance"
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-join -type none -multiple 1
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
set leaders [tcl::dict::get $argd leaders]
set values [tcl::dict::get $argd values]
return [list\
[list [tcl::dict::get $leaders p1] [tcl::dict::get $leaders p2]]\
[list [tcl::dict::get $values p3] [tcl::dict::get $values p4] [tcl::dict::get $values p5]]\
[tcl::dict::get $argd opts]]
}
#Sole documentation source is the eager punk::args::define (load-time
#registration is part of what this variant measures) - see the
#opts::punkargs_by_id comment.
punk::args::define {
@id -id ::argparsingtest::sandwich::punkargs_by_id
@cmd -name argparsingtest::sandwich::punkargs_by_id\
-summary "punk::args withid pre-registered, sandwich style"\
-help\
"Accepts 2 leading positional arguments, then 10 keyed options plus -join,
then 3 trailing positional arguments.
Parses via a definition pre-registered at module load, using withid.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-join -type none -multiple 1
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}
proc punkargs_by_id {args} {
set argd [punk::args::parse $args withid ::argparsingtest::sandwich::punkargs_by_id]
set leaders [tcl::dict::get $argd leaders]
set values [tcl::dict::get $argd values]
return [list\
[list [tcl::dict::get $leaders p1] [tcl::dict::get $leaders p2]]\
[list [tcl::dict::get $values p3] [tcl::dict::get $values p4] [tcl::dict::get $values p5]]\
[tcl::dict::get $argd opts]]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::sandwich::punkargs_parsecache
@cmd -name argparsingtest::sandwich::punkargs_parsecache -summary "punk::args withid with parse cache, sandwich style" -help\
"Accepts 2 leading positional arguments, then 10 keyed options plus -join,
then 3 trailing positional arguments.
Uses withid and -cache 1 for repeated parse reuse.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
}
proc punkargs_parsecache {args} {
set argd [punk::args::parse $args -cache 1 withid ::argparsingtest::sandwich::punkargs_by_id]
set leaders [tcl::dict::get $argd leaders]
set values [tcl::dict::get $argd values]
return [list\
[list [tcl::dict::get $leaders p1] [tcl::dict::get $leaders p2]]\
[list [tcl::dict::get $values p3] [tcl::dict::get $values p4] [tcl::dict::get $values p5]]\
[tcl::dict::get $argd opts]]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::sandwich::opt
@cmd -name argparsingtest::sandwich::opt -summary "tcllib opt-based arg parsing, sandwich style" -help\
"Accepts 2 leading positional arguments, then 10 keyed options plus the
valueless -join flag, then 3 trailing positional arguments.
Uses tcl::OptProc with the leading positionals declared first, the flags
next and the trailing positionals last - tcl::OptProc fills positional
slots in declaration order, so the arrangement is expressed by the spec.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
}
tcl::OptProc opt {
{p1 -string "first leading positional argument"}
{p2 -string "second leading positional argument"}
{-return string "return type"}
{-frametype \uFFEF "type of frame"}
{-show_edge \uFFEF "show table outer borders"}
{-show_seps \uFFEF "show separators"}
{-join "solo option"}
{-x "" "x val"}
{-y b "y val"}
{-z c "z val"}
{-1 1 "1val"}
{-2 -int 2 "2val"}
{-3 -int 3 "3val"}
{p3 -string "first trailing positional argument"}
{p4 -string "second trailing positional argument"}
{p5 -string "third trailing positional argument"}
} {
set opts [dict create]
foreach v [info locals] {
if {$v ni {p1 p2 p3 p4 p5 opts args Args}} {
dict set opts $v [set $v]
}
}
return [list [list $p1 $p2] [list $p3 $p4 $p5] $opts]
}
namespace eval argdoc {
lappend PUNKARGS [list {
@id -id ::argparsingtest::sandwich::argparse
@cmd -name argparsingtest::sandwich::argparse -summary "argparse package arg parsing, sandwich style" -help\
"Accepts 2 leading positional arguments, then 10 keyed options plus the
valueless -join flag, then 3 trailing positional arguments.
Uses argparse -inline -mixed. -mixed permits switches anywhere, which is
what lets the leading positionals through; the cost is that this spec
does not CONSTRAIN the arrangement the way the punk::args and opt
wrappers do - it would equally accept all five positionals trailing.
Returns a list {{p1 p2} {p3 p4 p5} optsdict}."
@leaders -min 2 -max 2
p1 -type string -optional 0
p2 -type string -optional 0
@opts -anyopts 0
-return -default string -type string
-frametype -default \uFFEF -type string
-show_edge -default \uFFEF -type string
-show_seps -default \uFFEF -type string
-x -default "" -type string
-y -default b -type string
-z -default c -type string
-1 -default 1 -type boolean
-2 -default 2 -type integer
-3 -default 3 -type integer
-join -type none -multiple 1
@values -min 3 -max 3
p3 -type string -optional 0
p4 -type string -optional 0
p5 -type string -optional 0
}]
}
proc argparse {args} {
set parsed [::argparse -inline -mixed {
{-return -argument -default string}
{-frametype -argument -default \uFFEF}
{-show_edge -argument -default \uFFEF}
{-show_seps -argument -default \uFFEF}
{-join}
{-x -argument -default ""}
{-y -argument -default b}
{-z -argument -default c}
{-1 -argument -default 1}
{-2 -argument -default 2}
{-3 -argument -default 3}
{p1}
{p2}
{p3}
{p4}
{p5}
} $args]
return [list\
[list [dict get $parsed p1] [dict get $parsed p2]]\
[list [dict get $parsed p3] [dict get $parsed p4] [dict get $parsed p5]]\
[dict remove $parsed p1 p2 p3 p4 p5]]
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace argparsingtest::sandwich ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace # Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
