diff --git a/src/bootsupport/include_modules.config b/src/bootsupport/include_modules.config index cadc55e..51b8bdd 100644 --- a/src/bootsupport/include_modules.config +++ b/src/bootsupport/include_modules.config @@ -8,14 +8,19 @@ set bootsupport_modules [list\ src/vendormodules http\ src/vendormodules dictutils\ src/vendormodules fileutil\ - src/vendormodules textutil::tabify\ + src/vendormodules textutil::adjust\ + src/vendormodules textutil::repeat\ src/vendormodules textutil::split\ + src/vendormodules textutil::string\ + src/vendormodules textutil::tabify\ + src/vendormodules textutil::trim\ src/vendormodules textutil::wcswidth\ src/vendormodules uuid\ src/vendormodules md5\ src/vendormodules sha1\ modules punkcheck\ modules punk::ansi\ + modules punk::assertion\ modules punk::args\ modules punk::cap\ modules punk::cap::handlers::caphandler\ diff --git a/src/bootsupport/modules/punk/assertion-0.1.0.tm b/src/bootsupport/modules/punk/assertion-0.1.0.tm new file mode 100644 index 0000000..1304bef --- /dev/null +++ b/src/bootsupport/modules/punk/assertion-0.1.0.tm @@ -0,0 +1,412 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from -buildversion.txt +# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.2.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) 2024 +# +# @@ Meta Begin +# Application punk::assertion 0.1.0 +# Meta platform tcl +# Meta license +# @@ Meta End + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# doctools header +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[manpage_begin shellspy_module_punk::assertion 0 0.1.0] +#[copyright "2024"] +#[titledesc {assertion alternative to control::assert}] [comment {-- Name section and table of contents description --}] +#[moddesc {per-namespace assertions with }] [comment {-- Description at end of page heading --}] +#[require punk::assertion] +#[keywords module assertion assert debug] +#[description] +#[para] The punk::assertion library has the same semantics as Tcllib's control::assert library for the assert command itself. +#[para] The main difference is the way in which assert is enabled/disabled in namespaces. +#[para] Due to commands such as 'namespace path' - the assert command could be available in arbitrary namespaces unrelated by tree structure to namespaces where assert has been directly imported. +#[para] punk::assertion::active 0|1 allows activating and deactivating assertions in any namespace where the assert command is available - but only affecting the activations state of the namespace in which it is called. +#[para] If such a non-primary assertion namespace never had active set to 0 or 1 - then it will activate/deactivate when the namespace corresponding to the found assert command (primary) is activated/deactivated. +#[para] Once marked active or inactive - such a non-primary namespace will no longer follow the primary + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section Overview] +#[para] overview of punk::assertion +#[subsection Concepts] +#[para] - + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[subsection dependencies] +#[para] packages used by punk::assertion +#[list_begin itemized] + +package require Tcl 8.6 +#*** !doctools +#[item] [package {Tcl 8.6}] + +# #package require frobz +# #*** !doctools +# #[item] [package {frobz}] + +#*** !doctools +#[list_end] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#*** !doctools +#[section API] + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# oo::class namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::assertion::class { + #*** !doctools + #[subsection {Namespace punk::assertion::class}] + #[para] class definitions + if {[info commands [namespace current]::interface_sample1] eq ""} { + #*** !doctools + #[list_begin enumerated] + + # oo::class create interface_sample1 { + # #*** !doctools + # #[enum] CLASS [class interface_sample1] + # #[list_begin definitions] + + # method test {arg1} { + # #*** !doctools + # #[call class::interface_sample1 [method test] [arg arg1]] + # #[para] test method + # puts "test: $arg1" + # } + + # #*** !doctools + # #[list_end] [comment {-- end definitions interface_sample1}] + # } + + #*** !doctools + #[list_end] [comment {--- end class enumeration ---}] + } +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + +#keep 2 namespaces for assertActive and assertInactive so there is introspection available via namespace origin +namespace eval punk::assertion::primary { + + namespace export * + proc assertActive {expr args} { + + set code [catch {uplevel 1 [list expr $expr]} res] + if {$code} { + return -code $code $res + } + if {![string is boolean -strict $res]} { + return -code error "invalid boolean expression: $expr" + } + + if {$res} {return} + + if {[llength $args]} { + #set msg "[join $args]" + set msg "$args punk::assertion failed expr $expr" + } else { + set msg "punk::assertion failed expr $expr" ;#give a clue in the default msg about which assert lib is in use + } + + upvar ::punk::assertion::CallbackCmd CallbackCmd + # Might want to catch this + namespace eval :: $CallbackCmd [list $msg] + } + proc assertInactive args {} + +} +namespace eval punk::assertion::secondary { + namespace export * + #we need to actually define these procs here, (not import then re-export) - or namespace origin will report the original source namespace - which isn't what we want. + proc assertActive {expr args} [info body ::punk::assertion::primary::assertActive] + proc assertInactive args {} +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Base namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::assertion { + variable CallbackCmd [list return -code error] + namespace import ::punk::assertion::primary::assertActive + rename assertActive assert + + namespace export * + #variable xyz + + #*** !doctools + #[subsection {Namespace punk::assertion}] + #[para] Core API functions for punk::assertion + #[list_begin definitions] + + + #proc sample1 {p1 n args} { + # #*** !doctools + # #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] + # #[para]Description of sample1 + # #[para] Arguments: + # # [list_begin arguments] + # # [arg_def tring p1] A description of string argument p1. + # # [arg_def integer n] A description of integer argument n. + # # [list_end] + # return "ok" + #} + + #like tcllib's control::assert - we are limited to the same callback for all namespaces. + #review - a per namespace - or per assert command callback may be tricky to do performantly. + #Would probably involve rewriting the proc body - otherwise we have a runtime penalty in the assert of looking it up. + proc callback {args} { + #set nscaller [uplevel 1 [list namespace current]] + #set which_assert [namespace eval $nscaller {namespace which assert}] + + upvar ::punk::assertion::CallbackCmd cb + set n [llength $args] + if {$n > 1} { + return -code error "wrong # args: should be\ + \"[lindex [info level 0] 0] ?command?\"" + } + if {$n} { + set cb [lindex $args 0] + return + } + return $cb + } + + proc active {{on_off ""}} { + set nscaller [uplevel 1 [list namespace current]] + set which_assert [namespace eval $nscaller {namespace which assert}] + #puts "nscaller:'$nscaller'" + #puts "which_assert: $which_assert" + + if {$on_off eq ""} { + if {$which_assert eq ""} {return 0} + set assertorigin [namespace origin $which_assert] + #puts "ns which assert: $which_assert" + #puts "ns origin assert: $assertorigin" + return [expr {"assertActive" eq [namespace tail $assertorigin]}] + } + if {![string is boolean -strict $on_off]} { + error "invalid boolean value : $on_off" + } else { + set info_command [namespace eval $nscaller {info commands assert}] + if {$on_off} { + #Enable it in calling namespace + if {"assert" eq $info_command} { + #There is an assert command reachable - due to namespace path etc, it could be in another namespace entirely - (not necessarily in an ancestor namespace of the namespace's tree structure) + if {$which_assert eq [punk::assertion::system::nsjoin ${nscaller} assert]} { + namespace eval $nscaller { + set assertorigin [namespace origin assert] + set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] + switch -- $assertorigin_ns { + ::punk::assertion { + #original import - switch to primary origin + rename assert {} + namespace import ::punk::assertion::primary::assertActive + rename assertActive assert + } + ::punk::assertion::primary - ::punk::assertion::secondary { + #keep using from same origin ns + rename assert {} + namespace import ${assertorigin_ns}::assertActive + rename assertActive assert + } + default { + error "The assert command in this namespace is not from punk::assertion package. Use the enable mechanism from the package associated with $assertorigin or remove the existing assert command and namespace import punk::assertion::assert" + } + } + } + return 1 + } else { + #assert is available, but isn't in the calling namespace - we should enable it in a way that is distinguishable from case where assert was explicitly imported to this namespace + namespace eval $nscaller { + set assertorigin [namespace origin assert] + if {[string match ::punk::assertion::* $assertorigin]} { + namespace import ::punk::assertion::secondary::assertActive + rename assertActive assert + } else { + error "The reachable assert command at '$which_assert' is not from punk::assertion package. Import punk::assertion::assert - or use the enable mechanism from the package associated with $assertorigin" + } + } + return 1 + } + + } else { + #no assert command reachable + puts stderr "no assert command visible from namespace '$nscaller' - use: namespace import ::punk::assertion::assert" + return 0 + } + } else { + #Disable + if {"assert" eq $info_command} { + if {$which_assert eq [punk::assertion::system::nsjoin ${nscaller} assert]} { + #assert is present in callers NS + namespace eval $nscaller { + set assertorigin [namespace origin assert] + set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] + switch -glob -- $assertorigin_ns { + ::punk::assertion { + #original import + rename assert {} + namespace import punk::assertion::primary::assertInactive + rename assertInactive assert + } + ::punk::assertion::primary - ::punk::assertion::secondary { + #keep using from same origin ns + rename assert {} + namespace import ${assertorigin_ns}::assertInactive + rename assertInactive assert + } + default { + error "The assert command in this namespace is not from punk::assertion package. Use the disable mechanism from the package associated with $assertorigin or remove the existing assert command and namespace import punk::assertion::assert" + } + } + } + return 0 + } else { + #assert not present in callers NS - first install of secondary (if assert is from punk::assertion::*) + namespace eval $nscaller { + set assertorigin [namespace origin assert] + set assertorigin_ns [punk::assertion::system::nsprefix $assertorigin] + if {[string match ::punk::assertion::* $assertorigin]} { + namespace import ::punk::assertion::secondary::assertInactive + rename assertInactive assert + } else { + error "The reachable assert command at '$which_assert' is not from punk::assertion package. Import punk::assertion::assert - or use the enable mechanism from the package associated with $assertorigin" + } + } + return 0 + } + } else { + #no assert command reachable + #If caller is using assert in this namespace - they should have imported it, or ensured it was reachable via namespace path + puts stderr "no assert command visible from namespace '$nscaller' - use: namespace import ::punk::assertion::assert" + return 0 + } + } + } + } + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::assertion ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +# Secondary API namespace +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::assertion::lib { + namespace export * + namespace path [namespace parent] + #*** !doctools + #[subsection {Namespace punk::assertion::lib}] + #[para] Secondary functions that are part of the API + #[list_begin definitions] + + #proc utility1 {p1 args} { + # #*** !doctools + # #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] + # #[para]Description of utility1 + # return 1 + #} + + + + #*** !doctools + #[list_end] [comment {--- end definitions namespace punk::assertion::lib ---}] +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#*** !doctools +#[section Internal] +namespace eval punk::assertion::system { + #*** !doctools + #[subsection {Namespace punk::assertion::system}] + #[para] Internal functions that are not part of the API + + #Maintenance - snarfed from punk::ns to reduce dependencies - punk::ns::nsprefix is the master version + #nsprefix/nstail are string functions - they do not concern themselves with what namespaces are present in the system + proc nsprefix {{nspath {}}} { + #normalize the common case of :::: + set nspath [string map [list :::: ::] $nspath] + set rawprefix [string range $nspath 0 end-[string length [nstail $nspath]]] + if {$rawprefix eq "::"} { + return $rawprefix + } else { + if {[string match *:: $rawprefix]} { + return [string range $rawprefix 0 end-2] + } else { + return $rawprefix + } + #return [string trimright $rawprefix :] + } + } + #see also punk::ns - keep in sync + proc nstail {nspath args} { + #normalize the common case of :::: + set nspath [string map [list :::: ::] $nspath] + set mapped [string map [list :: \u0FFF] $nspath] + set parts [split $mapped \u0FFF] + + set defaults [list -strict 0] + set opts [dict merge $defaults $args] + set strict [dict get $opts -strict] + + if {$strict} { + foreach p $parts { + if {[string match :* $p]} { + error "nstail unpaired colon ':' in $nspath" + } + } + } + #e.g ::x::y:::z should return ":z" despite it being a bad idea for a command name. + return [lindex $parts end] + } + proc nsjoin {prefix name} { + if {[string match ::* $name]} { + if {"$prefix" ne ""} { + error "nsjoin: won't join non-empty prefix to absolute namespace path '$name'" + } + return $name + } + if {"$prefix" eq "::"} { + return ::$name + } + #if {"$name" eq ""} { + # return $prefix + #} + #nsjoin ::x::y "" should return ::x::y:: - this is the correct fully qualified form used to call a command that is the empty string + return ${prefix}::$name + } + +} +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::assertion [namespace eval punk::assertion { + variable pkg punk::assertion + variable version + set version 0.1.0 +}] +return + +#*** !doctools +#[manpage_end] + diff --git a/src/bootsupport/modules/punk/lib-0.1.1.tm b/src/bootsupport/modules/punk/lib-0.1.1.tm index 08632b1..56e05da 100644 --- a/src/bootsupport/modules/punk/lib-0.1.1.tm +++ b/src/bootsupport/modules/punk/lib-0.1.1.tm @@ -856,7 +856,8 @@ namespace eval punk::lib { #Each resulting line should have a reset of some type at start and a pure-reset at end to stop #see if we can find an ST sequence that most terminals will not display for marking sections? if {$opt_ansiresets} { - set RST [a] + package require punk::ansi + set RST [punk::ansi::a] set replaycodes $RST ;#todo - default? set transformed [list] #shortcircuit common case of no ansi diff --git a/src/modules/punk/lib-999999.0a1.0.tm b/src/modules/punk/lib-999999.0a1.0.tm index 9549d16..548666f 100644 --- a/src/modules/punk/lib-999999.0a1.0.tm +++ b/src/modules/punk/lib-999999.0a1.0.tm @@ -856,7 +856,8 @@ namespace eval punk::lib { #Each resulting line should have a reset of some type at start and a pure-reset at end to stop #see if we can find an ST sequence that most terminals will not display for marking sections? if {$opt_ansiresets} { - set RST [a] + package require punk::ansi + set RST [punk::ansi::a] set replaycodes $RST ;#todo - default? set transformed [list] #shortcircuit common case of no ansi