128 changed files with 87243 additions and 5470 deletions
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,3 +1,3 @@
|
||||
0.1.4 |
||||
0.1.7 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,3 +1,3 @@
|
||||
0.1.1 |
||||
0.1.2 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,128 @@
|
||||
|
||||
package require tcltest |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
test parse_withdef_leaders_min_max {Test anonymous leaders with @leaders -min and -max}\ |
||||
-setup $common -body { |
||||
set argd [punk::args::parse {a b c d} withdef {@leaders -min 1 -max 3} ] |
||||
lappend result [dict get $argd leaders] |
||||
lappend result [dict get $argd values] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
{0 a 1 b 2 c} {3 d} |
||||
] |
||||
|
||||
test parse_withdef_leaders_ordering_defaults {Test ordering of leaders when some have defaults}\ |
||||
-setup $common -body { |
||||
set argd [punk::args::parse {a b} withdef @leaders x {y -default 1}] |
||||
set vals [dict get $argd leaders] |
||||
set result $vals |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
x a y b |
||||
] |
||||
|
||||
test parse_withdef_option_ordering_defaults {Test ordering of options when some have defaults}\ |
||||
-setup $common -body { |
||||
#for consistency with leaders and values dicts - try to maintain definition order for options too |
||||
set argd [punk::args::parse {-x a -y b} withdef @opts -x {-y -default 1}] |
||||
set vals [dict get $argd opts] |
||||
set result $vals |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
-x a -y b |
||||
] |
||||
|
||||
test parse_withdef_option_ordering_defaults2 {Test ordering of options when some have defaults and -any is true}\ |
||||
-setup $common -body { |
||||
#for consistency with leaders and values dicts - try to maintain definition order for options too |
||||
set argd [punk::args::parse {-blah etc -x a -y b -solo -z c} withdef {@opts -any 1} -x {-y -default 1} {-solo -type none} -z] |
||||
set vals [dict get $argd opts] |
||||
set result $vals |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
-x a -y b -solo 1 -z c -blah etc |
||||
] |
||||
|
||||
test parse_withdef_values_ordering_defaults {Test ordering of values when some have defaults}\ |
||||
-setup $common -body { |
||||
set argd [punk::args::parse {a b} withdef @values x {y -default 1}] |
||||
set vals [dict get $argd values] |
||||
set result $vals |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
x a y b |
||||
] |
||||
|
||||
test parse_withdef_leader_min_max {Test unnamed leaders with -min and -max}\ |
||||
-setup $common -body { |
||||
#should not error - should allocate d to values |
||||
set argd [punk::args::parse {a b c d} withdef {@leaders -min 1 -max 4} {@values -min 1 -max 1}] |
||||
lappend result [dict get $argd leaders] |
||||
lappend result [dict get $argd values] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
{0 a 1 b 2 c} {3 d} |
||||
] |
||||
|
||||
test parse_withdef_leader_stride {Test stride leaders}\ |
||||
-setup $common -body { |
||||
#see for example ::tcl::dict::create which has a stride of 2 |
||||
set argd [punk::args::parse {k v e k1 v1 k2 v2} withdef {@leaders} {"key val etc" -multiple 0} {"key val" -multiple 1} {@values -min 0 -max 0}] |
||||
lappend result [dict get $argd leaders] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
{{key val etc} {k v e} {key val} {{k1 v1} {k2 v2}}} |
||||
] |
||||
|
||||
test parse_withdef_value_stride {Test stride values}\ |
||||
-setup $common -body { |
||||
#see for example ::tcl::dict::create which has a stride of 2 |
||||
set argd [punk::args::parse {k v e k1 v1 k2 v2} withdef {@values} {"key val etc" -multiple 0} {"key val" -multiple 1}] |
||||
lappend result [dict get $argd values] |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
{{key val etc} {k v e} {key val} {{k1 v1} {k2 v2}}} |
||||
] |
||||
|
||||
test parse_withdef_value_stride_error {Test stride values with error due to not enough args for stride}\ |
||||
-setup $common -body { |
||||
#see for example ::tcl::dict::create which has a stride of 2 |
||||
if {[catch {punk::args::parse {k v} withdef {@values} {"key val etc" -multiple 0}} emsg eopts]} { |
||||
set expected [dict get $eopts -errorcode] |
||||
if {[lindex $expected 0] eq "PUNKARGS" && [lindex $expected 1] eq "VALIDATION" && [lindex $expected 2 0] eq "stridevaluecount"} { |
||||
lappend result "RECEIVED_EXPECTED_ERROR" |
||||
} else { |
||||
lappend result "WRONG_ERROR_RECEIVED - $expected (expected PUNKARGS VALIDATION {stridevaluecount ...} ..." |
||||
} |
||||
} else { |
||||
lappend result "MISSING_REQUIRED_ERROR" |
||||
} |
||||
}\ |
||||
-cleanup { |
||||
}\ |
||||
-result [list\ |
||||
"RECEIVED_EXPECTED_ERROR" |
||||
] |
||||
} |
||||
@ -0,0 +1,125 @@
|
||||
package require tcltest |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
variable common { |
||||
set result "" |
||||
} |
||||
|
||||
test define_tstr_template1 {Test basic tstr substitution finds vars in namespace in which define was called}\ |
||||
-setup $common -body { |
||||
namespace eval whatever { |
||||
set plus +++ |
||||
set minus --- |
||||
|
||||
punk::args::define { |
||||
@id -id ::testspace::test1 |
||||
@values |
||||
param -type string -default "${$plus}XXX${$minus}YYY" |
||||
} |
||||
} |
||||
|
||||
set argd [punk::args::parse {} withid ::testspace::test1] |
||||
set vals [dict get $argd values] |
||||
lappend result [dict get $vals param] |
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::whatever |
||||
}\ |
||||
-result [list\ |
||||
+++XXX---YYY |
||||
] |
||||
|
||||
test define_tstr_template2 {Test basic tstr substitution when @dynamic}\ |
||||
-setup $common -body { |
||||
namespace eval whatever { |
||||
set plus +++ |
||||
set minus --- |
||||
|
||||
punk::args::define { |
||||
@dynamic |
||||
@id -id ::testspace::test2 |
||||
@values |
||||
param -type string -default "${$plus}XXX${$minus}YYY" |
||||
} |
||||
} |
||||
|
||||
set argd [punk::args::parse {} withid ::testspace::test2] |
||||
puts ">>>>define_tstr_template2 argd:$argd" |
||||
set vals [dict get $argd values] |
||||
lappend result [dict get $vals param] |
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::whatever |
||||
}\ |
||||
-result [list\ |
||||
+++XXX---YYY |
||||
] |
||||
|
||||
test define_tstr_template3 {Test double tstr substitution when @dynamic}\ |
||||
-setup $common -body { |
||||
variable test_list |
||||
set test_list {A B C} |
||||
proc ::testspace::get_list {} { |
||||
variable test_list |
||||
return $test_list |
||||
} |
||||
namespace eval whatever { |
||||
set plus +++ |
||||
set minus --- |
||||
set DYN_LIST {${[::testspace::get_list]}} |
||||
set DYN_CLOCKSECONDS {${[clock seconds]}} |
||||
|
||||
punk::args::define { |
||||
@dynamic |
||||
@id -id ::testspace::test2 |
||||
@values |
||||
param1 -type string -default "${$plus}XXX${$minus}YYY" |
||||
param2 -type list -default "${$DYN_LIST}" |
||||
param3 -type string -default "${[clock seconds]}" |
||||
param4 -type string -default "${$DYN_CLOCKSECONDS}" |
||||
} |
||||
} |
||||
|
||||
set argd [punk::args::parse {} withid ::testspace::test2] |
||||
set vals [dict get $argd values] |
||||
lappend result [dict get $vals param1] |
||||
lappend result [dict get $vals param2] |
||||
set c1_at_define [dict get $vals param3] |
||||
set c1_at_resolve [dict get $vals param4] |
||||
|
||||
#update test_list to ensure parse is actually dynamic |
||||
set ::testspace::test_list {X Y Z} |
||||
#update plus - should not affect output as it is resolved at define time |
||||
set ::testspace::whatever::plus "new+" |
||||
#unset minus - should not cause error |
||||
unset ::testspace::whatever::minus |
||||
after 1100 ;#ensure more than 1 sec apart |
||||
|
||||
|
||||
set argd [punk::args::parse {} withid ::testspace::test2] |
||||
set vals [dict get $argd values] |
||||
lappend result [dict get $vals param1] |
||||
lappend result [dict get $vals param2] |
||||
set c2_at_define [dict get $vals param3] |
||||
set c2_at_resolve [dict get $vals param4] |
||||
|
||||
if {$c1_at_define == $c2_at_define} { |
||||
lappend result "OK_define_time_var_match" |
||||
} else { |
||||
lappend result "UNEXPECTED_define_time_var_mismatch" |
||||
} |
||||
if {$c1_at_resolve < $c2_at_resolve} { |
||||
lappend result "OK_resolve_time_2_greater" |
||||
} else { |
||||
lappend result "UNEXPECTED_resolve_time_2_not_greater" |
||||
} |
||||
|
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::whatever |
||||
}\ |
||||
-result [list\ |
||||
+++XXX---YYY {A B C} +++XXX---YYY {X Y Z} OK_define_time_var_match OK_resolve_time_2_greater |
||||
] |
||||
} |
||||
@ -0,0 +1,60 @@
|
||||
|
||||
package require tcltest |
||||
|
||||
namespace eval ::testspace { |
||||
namespace import ::tcltest::* |
||||
namespace import ::punk::ansi::a+ ::punk::ansi::a |
||||
variable common { |
||||
set result "" |
||||
} |
||||
test synopsis_basic {test basic synopsis of punkargs definition}\ |
||||
-setup $common -body { |
||||
namespace eval testns { |
||||
punk::args::define { |
||||
@id -id ::testspace::testns::t1 |
||||
@leaders |
||||
a1 -optional 0 |
||||
@opts |
||||
-o1 -type boolean |
||||
@values |
||||
v1 -optional 1 |
||||
} |
||||
} |
||||
lappend result [punk::ns::synopsis ::testspace::testns::t1] |
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::testns |
||||
}\ |
||||
-result [list\ |
||||
"::testspace::testns::t1 [a+ italic]a1[a] ?-o1 <bool>? ?[a+ italic]v1[a]?" |
||||
] |
||||
|
||||
test synopsis_basic_ensemble-like {test basic synopsis of punkargs ensemble-like definition}\ |
||||
-setup $common -body { |
||||
namespace eval testns { |
||||
punk::args::define { |
||||
@id -id ::testspace::testns::t1 |
||||
@leaders -min 1 |
||||
subcmd -default c1 -choices {c1 c2} |
||||
@values -min 0 -max 0 |
||||
} |
||||
punk::args::define { |
||||
@id -id "::testspace::testns::t1 c1" |
||||
@values -min 0 -max 1 |
||||
v1 -type string |
||||
} |
||||
|
||||
} |
||||
lappend result [punk::ns::synopsis ::testspace::testns::t1] |
||||
lappend result [punk::ns::synopsis ::testspace::testns::t1 c1] |
||||
}\ |
||||
-cleanup { |
||||
namespace delete ::testspace::testns |
||||
}\ |
||||
-result [list\ |
||||
"::testspace::testns::t1 [a+ italic]subcmd[a]"\ |
||||
"::testspace::testns::t1 c1 [a+ italic]v1[a]" |
||||
] |
||||
|
||||
|
||||
} |
||||
@ -0,0 +1,226 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2025 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application test::punk::args 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license MIT |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_test::punk::args 0 999999.0a1.0] |
||||
#[copyright "2025"] |
||||
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||
#[require test::punk::args] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of test::punk::args |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by test::punk::args |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section API] |
||||
|
||||
|
||||
|
||||
|
||||
tcl::namespace::eval test::punk::args { |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[subsection {Namespace test::punk::args}] |
||||
#[para] Core API functions for test::punk::args |
||||
#[list_begin definitions] |
||||
|
||||
variable PUNKARGS |
||||
|
||||
variable pkg test::punk::args |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
|
||||
package require packageTest |
||||
packageTest::makeAPI test::punk::args $version punk::args; #will package provide test::punk::args $version |
||||
|
||||
package forget punk::args |
||||
package require punk::args |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace test::punk::args ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval test::punk::args::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace test::punk::args::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
|
||||
|
||||
# == === === === === === === === === === === === === === === |
||||
# Sample 'about' function with punk::args documentation |
||||
# == === === === === === === === === === === === === === === |
||||
tcl::namespace::eval test::punk::args { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
variable PUNKARGS |
||||
variable PUNKARGS_aliases |
||||
|
||||
lappend PUNKARGS [list { |
||||
@id -id "(package)test::punk::args" |
||||
@package -name "test::punk::args" -help\ |
||||
"Package |
||||
Description" |
||||
}] |
||||
|
||||
namespace eval argdoc { |
||||
#namespace for custom argument documentation |
||||
proc package_name {} { |
||||
return test::punk::args |
||||
} |
||||
proc about_topics {} { |
||||
#info commands results are returned in an arbitrary order (like array keys) |
||||
set topic_funs [info commands [namespace current]::get_topic_*] |
||||
set about_topics [list] |
||||
foreach f $topic_funs { |
||||
set tail [namespace tail $f] |
||||
lappend about_topics [string range $tail [string length get_topic_] end] |
||||
} |
||||
#Adjust this function or 'default_topics' if a different order is required |
||||
return [lsort $about_topics] |
||||
} |
||||
proc default_topics {} {return [list Description *]} |
||||
|
||||
# ------------------------------------------------------------- |
||||
# get_topic_ functions add more to auto-include in about topics |
||||
# ------------------------------------------------------------- |
||||
proc get_topic_Description {} { |
||||
punk::args::lib::tstr [string trim { |
||||
package test::punk::args |
||||
test suite for punk::args |
||||
} \n] |
||||
} |
||||
proc get_topic_License {} { |
||||
return "MIT" |
||||
} |
||||
proc get_topic_Version {} { |
||||
return "$::test::punk::args::version" |
||||
} |
||||
proc get_topic_Contributors {} { |
||||
set authors {{<julian@precisium.com> Julian Noble}} |
||||
set contributors "" |
||||
foreach a $authors { |
||||
append contributors $a \n |
||||
} |
||||
if {[string index $contributors end] eq "\n"} { |
||||
set contributors [string range $contributors 0 end-1] |
||||
} |
||||
return $contributors |
||||
} |
||||
proc get_topic_custom-topic {} { |
||||
punk::args::lib::tstr -return string { |
||||
A custom |
||||
topic |
||||
etc |
||||
} |
||||
} |
||||
# ------------------------------------------------------------- |
||||
} |
||||
|
||||
# we re-use the argument definition from punk::args::standard_about and override some items |
||||
set overrides [dict create] |
||||
dict set overrides @id -id "::test::punk::args::about" |
||||
dict set overrides @cmd -name "test::punk::args::about" |
||||
dict set overrides @cmd -help [string trim [punk::args::lib::tstr { |
||||
About test::punk::args |
||||
}] \n] |
||||
dict set overrides topic -choices [list {*}[test::punk::args::argdoc::about_topics] *] |
||||
dict set overrides topic -choicerestricted 1 |
||||
dict set overrides topic -default [test::punk::args::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict |
||||
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] |
||||
lappend PUNKARGS [list $newdef] |
||||
proc about {args} { |
||||
package require punk::args |
||||
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on |
||||
set argd [punk::args::parse $args withid ::test::punk::args::about] |
||||
lassign [dict values $argd] _leaders opts values _received |
||||
punk::args::package::standard_about -package_about_namespace ::test::punk::args::argdoc {*}$opts {*}[dict get $values topic] |
||||
} |
||||
} |
||||
# end of sample 'about' function |
||||
# == === === === === === === === === === === === === === === |
||||
|
||||
|
||||
# ----------------------------------------------------------------------------- |
||||
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked |
||||
# ----------------------------------------------------------------------------- |
||||
# variable PUNKARGS |
||||
# variable PUNKARGS_aliases |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES ::test::punk::args |
||||
} |
||||
# ----------------------------------------------------------------------------- |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide test::punk::args [tcl::namespace::eval test::punk::args { |
||||
variable pkg test::punk::args |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
@ -0,0 +1,3 @@
|
||||
0.1.5 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in new issue