You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
490 lines
22 KiB
490 lines
22 KiB
package require tcltest |
|
|
|
namespace eval ::testspace { |
|
namespace import ::tcltest::* |
|
variable common { |
|
set result "" |
|
} |
|
|
|
|
|
test choices_typeignored_when_choice_in_list {Test that -type is not validated for a value that matches a choice}\ |
|
-setup $common -body { |
|
#1 abbreviated choice |
|
set argd [punk::args::parse {li} withdef @values {frametype -type dict -choices {heavy light arc}}] |
|
lappend result [dict get $argd values] |
|
|
|
#2 exact match for a choice |
|
set argd [punk::args::parse {light} withdef @values {frametype -type dict -choices {heavy light arc}}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{frametype light}\ |
|
{frametype light}\ |
|
] |
|
|
|
test choices_type_validation_choicerestricted1 {Test that -type is validated for value outside of choicelist based on -choicerestricted}\ |
|
-setup $common -body { |
|
|
|
set argd [punk::args::parse {11} withdef @values {frametype -type int -choicerestricted 0 -choices {heavy light arc}}] |
|
lappend result [dict get $argd values] |
|
|
|
if {[catch { |
|
punk::args::parse {z} withdef @values {frametype -type int -choicerestricted 0 -choices {heavy light arc}} |
|
}]} { |
|
lappend result "ok_got_expected_error1" |
|
} else { |
|
lappend result "missing_required_error_when_type_mismatch_for_choice_outside_list" |
|
} |
|
|
|
#when -choicerestricted - value matching -type still shouldn't pass |
|
if {[catch { |
|
set argd [punk::args::parse {11} withdef @values {frametype -type int -choicerestricted 1 -choices {heavy light arc}}] |
|
}]} { |
|
lappend result "ok_got_expected_error2" |
|
} else { |
|
lappend result "missing_required_error_when_choicerestricted_and_choice_outside_list" |
|
} |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{frametype 11}\ |
|
ok_got_expected_error1\ |
|
ok_got_expected_error2\ |
|
] |
|
|
|
test choices_type_validation_choicerestricted2 {Test that -type dict is validated for value outside of choicelist based on -choicerestricted}\ |
|
-setup $common -body { |
|
#same as choices_type_validation_choicrestricted1 - but with a more complex type 'dict' - tests list protection is correct |
|
set argd [punk::args::parse {{hl -}} withdef @values {frametype -type dict -choicerestricted 0 -choices {heavy light arc}}] |
|
lappend result [dict get $argd values] |
|
|
|
if {[catch { |
|
punk::args::parse {z} withdef @values {frametype -type dict -choicerestricted 0 -choices {heavy light arc}} |
|
}]} { |
|
lappend result "ok_got_expected_error1" |
|
} else { |
|
lappend result "missing_required_error_when_type_mismatch_for_choice_outside_list" |
|
} |
|
|
|
#when -choicerestricted - value matching -type dict still shouldn't pass |
|
if {[catch { |
|
set argd [punk::args::parse {{hl -}} withdef @values {frametype -type dict -choicerestricted 1 -choices {heavy light arc}}] |
|
}]} { |
|
lappend result "ok_got_expected_error2" |
|
} else { |
|
lappend result "missing_required_error_when_choicerestricted_and_choice_outside_list" |
|
} |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{frametype {hl -}}\ |
|
ok_got_expected_error1\ |
|
ok_got_expected_error2\ |
|
] |
|
|
|
test choice_multiple_with_choiceprefix {test -choices with both -multiple and -choiceprefix}\ |
|
-setup $common -body { |
|
#test with full value choices. |
|
set argd [punk::args::parse {license description} withdef @values {topic -choices {license contributors description} -choiceprefix 1 -multiple 1 }] |
|
lappend result [dict get $argd values] |
|
|
|
#test with prefixes of choice. |
|
set argd [punk::args::parse {lic desc} withdef @values {topic -choices {license contributors description} -choiceprefix 1 -multiple 1 }] |
|
lappend result [dict get $argd values] |
|
|
|
#test with mixes of full value and prefix of choice. |
|
set argd [punk::args::parse {license desc} withdef @values {topic -choices {license contributors description} -choiceprefix 1 -multiple 1 }] |
|
lappend result [dict get $argd values] |
|
|
|
set argd [punk::args::parse {desc license} withdef @values {topic -choices {license contributors description} -choiceprefix 1 -multiple 1 }] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{topic {license description}}\ |
|
{topic {license description}}\ |
|
{topic {license description}}\ |
|
{topic {description license}}\ |
|
] |
|
#todo -nocase tests |
|
|
|
test choice_multiple_multiple {test -choices with both -multiple and -choicemultiple}\ |
|
-setup $common -body { |
|
set argd [punk::args::parse {a {c a} {a b c}} withdef @values {X -type string -choices {aa bb cc} -multiple 1 -choicemultiple {1 3} -optional 1}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{X {aa {cc aa} {aa bb cc}}} |
|
] |
|
# -choicemultiple allows duplicates in result by default (default for -choicemultipleunique 0) |
|
|
|
test choicemultiple_list {test -choices with both -multiple and -choicemultiple}\ |
|
-setup $common -body { |
|
set argd [punk::args::parse {{read write w}} withdef @values {mode -type list -choices {read write} -choicemultiple {1 -1}}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{mode {read write write}} |
|
] |
|
|
|
test choiceprefix_reservelist_blocks_reserved_prefix {test -choiceprefixreservelist participates in prefix matching without adding choices}\ |
|
-setup $common -body { |
|
set docid ::testspace::choiceprefix_reservelist_blocks_reserved_prefix |
|
punk::args::define [list @id -id $docid] @values {state -choices {idle} -choiceprefixreservelist {info}} |
|
|
|
set argd [punk::args::parse {idle} withid $docid] |
|
lappend result [dict get $argd values] |
|
|
|
if {[catch {punk::args::parse {i} withid $docid}]} { |
|
lappend result expected-error-prefix-reserved |
|
} else { |
|
lappend result missing-error-prefix-reserved |
|
} |
|
|
|
if {[catch {punk::args::parse {info} withid $docid}]} { |
|
lappend result expected-error-reserved-not-choice |
|
} else { |
|
lappend result missing-error-reserved-not-choice |
|
} |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{state idle}\ |
|
expected-error-prefix-reserved\ |
|
expected-error-reserved-not-choice |
|
] |
|
|
|
test choiceprefix_denylist_requires_full_choice {test -choiceprefixdenylist requires full spelling for selected choices}\ |
|
-setup $common -body { |
|
set docid ::testspace::choiceprefix_denylist_requires_full_choice |
|
punk::args::define [list @id -id $docid] @values {action -choices {delete describe} -choiceprefixdenylist {delete}} |
|
|
|
set argd [punk::args::parse {delete} withid $docid] |
|
lappend result [dict get $argd values] |
|
|
|
set argd [punk::args::parse {des} withid $docid] |
|
lappend result [dict get $argd values] |
|
|
|
if {[catch {punk::args::parse {del} withid $docid}]} { |
|
lappend result expected-error-denied-prefix |
|
} else { |
|
lappend result missing-error-denied-prefix |
|
} |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{action delete}\ |
|
{action describe}\ |
|
expected-error-denied-prefix |
|
] |
|
|
|
test choice_multielement_clause {test -choice with a clause-length greater than 1}\ |
|
-setup $common -body { |
|
#The same -choices list always applies to each member of -type - which isn't always ideal for a multi-element clause |
|
#for a clause where each element has a different choiceset - we would need to introduce a more complex -typechoices option |
|
#(or use a -parsekey mechanism on leaders/values to group them) |
|
|
|
#test all combinations of prefix and complete for 2 entries |
|
set argd [punk::args::parse {light heavy} withdef @values {leftright -type {any any} -choices {light heavy} -choicerestricted 1}] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {li heavy} withdef @values {leftright -type {any any} -choices {light heavy} -choicerestricted 1}] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {li he} withdef @values {leftright -type {any any} -choices {light heavy} -choicerestricted 1}] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {light he} withdef @values {leftright -type {any any} -choices {light heavy} -choicerestricted 1}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{leftright {light heavy}}\ |
|
{leftright {light heavy}}\ |
|
{leftright {light heavy}}\ |
|
{leftright {light heavy}}\ |
|
] |
|
|
|
test choice_multielement_clause_unrestricted {test -choice with a clause-length greater than 1 and values outside of choicelist}\ |
|
-setup $common -body { |
|
#1 both values outside of -choices |
|
set argd [punk::args::parse {11 x} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
# |
|
set argd [punk::args::parse {11 arc} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
# |
|
set argd [punk::args::parse {11 a} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
# |
|
set argd [punk::args::parse {heavy x} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
# |
|
set argd [punk::args::parse {h x} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
# |
|
set argd [punk::args::parse {a h} withdef @values {leftright -type {int char} -choices {light heavy arc} -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{leftright {11 x}}\ |
|
{leftright {11 arc}}\ |
|
{leftright {11 arc}}\ |
|
{leftright {heavy x}}\ |
|
{leftright {heavy x}}\ |
|
{leftright {arc heavy}}\ |
|
] |
|
|
|
# ---- unrestricted (-choicerestricted 0) interplay with prefix/deny/reserve ---- |
|
# Characterization added 2026-07-08 ahead of G-040 (choice aliasing). |
|
# Key properties pinned here: |
|
# - a matching prefix is NORMALIZED to the full (canonical) choice in the parse result |
|
# - non-matching words (unknown, ambiguous prefix, denied prefix, reserved word) pass |
|
# through unchanged instead of erroring - the pattern used by ::punk::help's topic |
|
# leader where unrecognised words fall through to command lookup |
|
|
|
test choiceprefix_unrestricted_normalizes_to_canonical {prefix input normalized to the full choice in the parse result when -choicerestricted 0}\ |
|
-setup $common -body { |
|
#unique prefix -> canonical choice in result |
|
set argd [punk::args::parse {env} withdef @values {topic -choices {topics environment console} -choiceprefix 1 -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
#unknown word passes through unchanged |
|
set argd [punk::args::parse {lindex} withdef @values {topic -choices {topics environment console} -choiceprefix 1 -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
#ambiguous prefix passes through unchanged (no error when unrestricted) |
|
set argd [punk::args::parse {t} withdef @values {topic -choices {topics tcl environment} -choiceprefix 1 -choicerestricted 0}] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
}\ |
|
-result [list\ |
|
{topic environment}\ |
|
{topic lindex}\ |
|
{topic t}\ |
|
] |
|
|
|
test choiceprefix_denylist_unrestricted_passthrough {denied prefix falls through as an ordinary value when -choicerestricted 0}\ |
|
-setup $common -body { |
|
set docid ::testspace::choiceprefix_denylist_unrestricted_passthrough |
|
punk::args::define [list @id -id $docid] @values {action -choices {delete describe} -choiceprefixdenylist {delete} -choicerestricted 0} |
|
|
|
#denied prefix -> passthrough, not an error and not a match |
|
set argd [punk::args::parse {del} withid $docid] |
|
lappend result [dict get $argd values] |
|
#full denied word still matches |
|
set argd [punk::args::parse {delete} withid $docid] |
|
lappend result [dict get $argd values] |
|
#undenied choice still prefix-matches and normalizes |
|
set argd [punk::args::parse {des} withid $docid] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{action del}\ |
|
{action delete}\ |
|
{action describe}\ |
|
] |
|
|
|
test choiceprefix_reservelist_unrestricted_passthrough {reserved word and shorter prefixes fall through when -choicerestricted 0; longer prefixes normalize}\ |
|
-setup $common -body { |
|
set docid ::testspace::choiceprefix_reservelist_unrestricted_passthrough |
|
punk::args::define [list @id -id $docid] @values {state -choices {environment} -choiceprefixreservelist {en} -choicerestricted 0} |
|
|
|
#shorter than the reserved phantom: ambiguous -> passthrough |
|
set argd [punk::args::parse {e} withid $docid] |
|
lappend result [dict get $argd values] |
|
#the reserved word itself: not a selectable choice -> passthrough |
|
set argd [punk::args::parse {en} withid $docid] |
|
lappend result [dict get $argd values] |
|
#beyond the phantom: unique prefix -> canonical |
|
set argd [punk::args::parse {env} withid $docid] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {environment} withid $docid] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{state e}\ |
|
{state en}\ |
|
{state environment}\ |
|
{state environment}\ |
|
] |
|
|
|
test choiceprefix_collapse_recipe_multi_leader {combined prefix+deny+reserve on an unrestricted -multiple leader (the punk::help topic pattern)}\ |
|
-setup $common -body { |
|
set docid ::testspace::choiceprefix_collapse_recipe_multi_leader |
|
punk::args::define [list @id -id $docid] {@leaders -min 0 -max -1} {topic -optional 1 -multiple 1 -type string -choicerestricted 0 -choiceprefix 1 -choiceprefixdenylist {help} -choiceprefixreservelist {en ter} -choices {topics help tcl environment console terminal}} {@values -min 0 -max 0} |
|
|
|
foreach word {env environment en term ter help hel to lindex} { |
|
set argd [punk::args::parse [list $word] withid $docid] |
|
lappend result [dict get [dict get $argd leaders] topic] |
|
} |
|
set result |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
environment\ |
|
environment\ |
|
en\ |
|
terminal\ |
|
ter\ |
|
help\ |
|
hel\ |
|
topics\ |
|
lindex\ |
|
] |
|
|
|
# ---- -choicealiases (G-040) ---- |
|
|
|
test choicealiases_exact_and_prefix_normalize {alias exact match and unique alias prefix normalize to the canonical choice}\ |
|
-setup $common -body { |
|
set docid ::testspace::choicealiases_exact_and_prefix_normalize |
|
punk::args::define [list @id -id $docid] @values {mode -choices {read write} -choicealiases {rd read wr write}} |
|
|
|
set argd [punk::args::parse {rd} withid $docid] |
|
lappend result [dict get $argd values] |
|
#canonical exact and canonical prefix still work |
|
set argd [punk::args::parse {write} withid $docid] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {rea} withid $docid] |
|
lappend result [dict get $argd values] |
|
#'w' is a prefix of both the choice 'write' and the alias 'wr' (same target) - currently ambiguous |
|
if {[catch {punk::args::parse {w} withid $docid}]} { |
|
lappend result w-ambiguous-rejected |
|
} else { |
|
lappend result w-UNEXPECTEDLY-accepted |
|
} |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{mode read}\ |
|
{mode write}\ |
|
{mode read}\ |
|
w-ambiguous-rejected\ |
|
] |
|
|
|
test choicealiases_noprefix_exact_only {with -choiceprefix 0 an exact alias still matches and normalizes; alias prefixes do not}\ |
|
-setup $common -body { |
|
set docid ::testspace::choicealiases_noprefix_exact_only |
|
punk::args::define [list @id -id $docid] @values {mode -choiceprefix 0 -choices {read write} -choicealiases {rd read}} |
|
|
|
set argd [punk::args::parse {rd} withid $docid] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {read} withid $docid] |
|
lappend result [dict get $argd values] |
|
if {[catch {punk::args::parse {r} withid $docid}]} { |
|
lappend result r-prefix-rejected |
|
} else { |
|
lappend result r-prefix-UNEXPECTEDLY-accepted |
|
} |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{mode read}\ |
|
{mode read}\ |
|
r-prefix-rejected\ |
|
] |
|
|
|
test choicealiases_nocase {aliases participate in -nocase matching and normalize to the canonical}\ |
|
-setup $common -body { |
|
set docid ::testspace::choicealiases_nocase |
|
punk::args::define [list @id -id $docid] @values {mode -nocase 1 -choices {read write} -choicealiases {rd read}} |
|
|
|
set argd [punk::args::parse {RD} withid $docid] |
|
lappend result [dict get $argd values] |
|
set argd [punk::args::parse {READ} withid $docid] |
|
lappend result [dict get $argd values] |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
{mode read}\ |
|
{mode read}\ |
|
] |
|
|
|
test choicealiases_denylist_applies_to_alias_name {an alias in -choiceprefixdenylist requires the full alias; exact alias still normalizes}\ |
|
-setup $common -body { |
|
set docid ::testspace::choicealiases_denylist_applies_to_alias_name |
|
punk::args::define [list @id -id $docid] {@leaders -min 0 -max -1} {topic -optional 1 -multiple 1 -choicerestricted 0 -choiceprefix 1 -choices {topics tcl env console} -choicealiases {help topics environment env term console terminal console} -choiceprefixdenylist {help} -choiceprefixreservelist {c to tc}} {@values -min 0 -max 0} |
|
|
|
#the punk::help topic policy matrix (user-decided 2026-07-08: c/to/tc fall through) |
|
foreach word {help hel h environment environ env en term terminal termi ter c to tc co top tcl lindex} { |
|
set argd [punk::args::parse [list $word] withid $docid] |
|
lappend result [dict get [dict get $argd leaders] topic] |
|
} |
|
set result |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
}\ |
|
-result [list\ |
|
topics\ |
|
hel\ |
|
h\ |
|
env\ |
|
env\ |
|
env\ |
|
en\ |
|
console\ |
|
console\ |
|
console\ |
|
ter\ |
|
c\ |
|
to\ |
|
tc\ |
|
console\ |
|
topics\ |
|
tcl\ |
|
lindex\ |
|
] |
|
|
|
test choicealiases_resolve_validation {alias to a missing canonical or colliding with a choice fails at definition resolve time}\ |
|
-setup $common -body { |
|
set docid ::testspace::choicealiases_resolve_validation_a |
|
punk::args::define [list @id -id $docid] @values {v -choices {a b} -choicealiases {x q}} |
|
#define is lazy - the validation error surfaces at first resolve/parse |
|
if {[catch {punk::args::parse {a} withid $docid} errmsg]} { |
|
lappend result [string match "*is not in -choices/-choicegroups*" $errmsg] |
|
} else { |
|
lappend result missing-canonical-UNEXPECTEDLY-accepted |
|
} |
|
set docid2 ::testspace::choicealiases_resolve_validation_b |
|
punk::args::define [list @id -id $docid2] @values {v -choices {a b} -choicealiases {a b}} |
|
if {[catch {punk::args::parse {b} withid $docid2} errmsg]} { |
|
lappend result [string match "*collides with a defined choice*" $errmsg] |
|
} else { |
|
lappend result collision-UNEXPECTEDLY-accepted |
|
} |
|
}\ |
|
-cleanup { |
|
punk::args::undefine $docid 1 |
|
punk::args::undefine $docid2 1 |
|
}\ |
|
-result [list 1 1] |
|
} |
|
tcltest::cleanupTests ;#needed to produce test summary line. |
|
|
|
|