jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

project layouts: propagate tcltestrun 0.3.0 bootsupport snapshot to punk.project and punk.shell layouts 

Generated by tclsh src/make.tcl bootsupport after rebuilding from the updated source in src/modules/punk/tcltestrun-999999.0a1.0.tm.
master
Julian Noble 2 weeks ago
parent
4bd27338e7
commit
4a359f3c88
2 changed files with 150 additions and 42 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 96
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/tcltestrun-0.3.0.tm
  2. 96
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/tcltestrun-0.3.0.tm

96
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/tcltestrun-0.1.0.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/tcltestrun-0.3.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2026
#
# @@ Meta Begin
# Application punk::tcltestrun 0.1.0
# Application punk::tcltestrun 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -93,14 +93,18 @@ tcl::namespace::eval punk::tcltestrun {
#'took' lines can occur for both passing and failing tests, but will occur before the ++++ PASSED or ==== FAILED lines for a test case,
if {[string match "++++ * took * µs" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
# The test name may itself contain the word "took", so locate the " took " delimiter from the right (last occurrence).
# Name is the substring between "++++ " (5 chars) and the last " took ".
set took_pos [string last " took " $ln_trimright]
set nm [string range $ln_trimright 5 [expr {$took_pos - 1}]]
dict set test_case_time $nm [dict create microseconds [lindex $ln end-1]]
continue
}
if {[string match "++++ * PASSED" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
# " PASSED" is terminal (7 chars); trim "++++ " (5 chars) from front and " PASSED" from end to get the full name.
set nm [string range $ln_trimright 5 end-7]
if {[dict exists $test_case_time $nm]} {
dict set results testcase_passes $nm [dict get $test_case_time $nm]
} else {
@ -111,8 +115,11 @@ tcl::namespace::eval punk::tcltestrun {
# ++++ <testname_words> SKIPPED: <constraint/reason>
if {[string match "++++ * SKIPPED: *" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
set reason [string trim [string range $ln [expr {[string first "SKIPPED:" $ln] + 8}] end]]
# Anchor on " SKIPPED:" (with leading space) so the name is extracted as the substring before it.
# Leftmost occurrence is used because the reason is free text after the delimiter and may itself contain "SKIPPED:".
set skip_pos [string first " SKIPPED:" $ln_trimright]
set nm [string range $ln_trimright 5 [expr {$skip_pos - 1}]]
set reason [string trim [string range $ln_trimright [expr {$skip_pos + 9}] end]]
dict set results testcase_constraintskips $nm [list reason $reason]
continue
}
@ -222,6 +229,33 @@ tcl::namespace::eval punk::tcltestrun {
}
# Result capture for FAILED (non-error) tests: grab "---- Result was:" and "---- Result should have been" blocks.
if {$fail_stage eq "contents"} {
if {[dict exists $test_case_fail result_stage] && [dict get $test_case_fail result_stage] ne ""} {
if {[string match "---- *" $ln] || [string match "==== * FAILED" $ln_trimright] || [string match "++++ *" $ln]} {
dict set test_case_fail result_stage ""
# fall through to normal handling below (do not continue)
} else {
dict append test_case_fail [dict get $test_case_fail result_stage] "$ln\n"
dict append results out "<stdout><$pkg> $ln" \n
continue
}
} elseif {[string match "---- Result was:*" $ln]} {
dict set test_case_fail result_stage "result_was"
if {![dict exists $test_case_fail result_was]} {
dict set test_case_fail result_was ""
}
dict append results out "<stdout><$pkg> $ln" \n
continue
} elseif {[string match "---- Result should have been*" $ln]} {
dict set test_case_fail result_stage "result_expected"
if {![dict exists $test_case_fail result_expected]} {
dict set test_case_fail result_expected ""
}
dict append results out "<stdout><$pkg> $ln" \n
continue
}
}
if {$fail_stage eq "contents" && ![string match "---- *" $ln] && ![string match "++++ *" $ln] && ![string match "==== * FAILED" $ln_trimright]} {
dict append test_case_fail test_body "$ln\n"
dict append results out "<stdout><$pkg> $ln" \n
@ -247,8 +281,17 @@ tcl::namespace::eval punk::tcltestrun {
} errorcode [dict get $test_case_fail errorcode] {*}{
}
]
if {[dict exists $test_case_time $nm]} {
dict set results testcase_fails $nm microseconds [dict get $test_case_time $nm microseconds]
if {[dict exists $test_case_time $test_name]} {
dict set results testcase_fails $test_name microseconds [dict get $test_case_time $test_name microseconds]
}
if {[dict exists $test_case_fail errorinfo] && [dict get $test_case_fail errorinfo] ne ""} {
dict set results testcase_fails $test_name errorinfo [dict get $test_case_fail errorinfo]
}
if {[dict exists $test_case_fail result_was] && [dict get $test_case_fail result_was] ne ""} {
dict set results testcase_fails $test_name result_was [dict get $test_case_fail result_was]
}
if {[dict exists $test_case_fail result_expected] && [dict get $test_case_fail result_expected] ne ""} {
dict set results testcase_fails $test_name result_expected [dict get $test_case_fail result_expected]
}
dict set test_case_fail stage ""
@ -257,6 +300,10 @@ tcl::namespace::eval punk::tcltestrun {
dict set test_case_fail test_body ""
dict set test_case_fail returncode ""
dict set test_case_fail errorcode ""
dict unset test_case_fail errorinfo
dict unset test_case_fail result_was
dict unset test_case_fail result_expected
dict unset test_case_fail result_stage
dict append results out "<stdout><$pkg> $ln" \n
continue ;#skip to next line.
@ -312,31 +359,39 @@ tcl::namespace::eval punk::tcltestrun {
"Add package ifneeded definitions for any unbuilt #modpod modules found in the specified path."
@leaders
@opts
@values -min 1 -max 1
@values -min 2 -max 2
tmpath -type string -help\
"Path to a folder containing unbuilt #modpod modules."
project_root -type string -help\
"Project root directory used to compute the fully qualified module name from the #modpod directory's path relative to <project_root>/src/modules."
}]
}
proc tm_path_additional_ifneeded {tmpath} {
proc tm_path_additional_ifneeded {tmpath project_root} {
#If the supplied tmpath contains any unbuilt #modpod modules, we want to add package ifneeded definitions for those modules.
#return a single script containing the package ifneeded definitions.
#when running against unbuilt modules - we want to ensure that the unbuilt versions of any modules are used rather than any installed versions - so we add package ifneeded definitions for the unbuilt versions of any modules that are present.
# add 'package ifneeded' definitions for unbuilt #modpod modules.
#first gather subdirectories of modules that contain #modpod-*-0.1.0 in their name - these should be the unbuilt versions of zip based modules.
#set subfolders [punk::path::subfolders -recursive $tmpath -match */#modpod-*-0.1.0]
#first gather subdirectories of modules that contain #modpod-*-<version> in their name - these should be the unbuilt versions of zip based modules.
#'punk::path::subfolders' currently only supports negative matching with -exclude, so we have to filter for the positive match ourselves.
set subfolders [punk::path::subfolders -recursive -exclude {**/_build/** **/_build} $tmpath]
set script ""
foreach sub $subfolders {
#In most cases we could use string match - but the * within modpod-*-0.1.0 could match a forward slash which could then match some other file under a #modpod- folder structure,
#In most cases we could use string match - but the * within modpod-*-<version> could match a forward slash which could then match some other file under a #modpod- folder structure,
#so we use globmatchpath which treats * as matching any characters except path separators.
if {[punk::path::globmatchpath "**/#modpod-*-0.1.0" $sub]} {
set modname [file tail $sub]
set modname [string range $modname 8 end-13] ;#strip off #modpod- and -0.1.0
set modpath [file join $sub "$modname-0.1.0.tm"]
if {[punk::path::globmatchpath "**/#modpod-*" $sub]} {
set tail [file tail $sub]
# Extract modname and version from the #modpod-<modname>-<version> directory name.
# The directory name format is: #modpod-<modname>-<version>
# Strip the leading "#modpod-" (8 chars), then split on the last "-" to separate modname from version.
set rest [string range $tail 8 end]
set last_dash [string last "-" $rest]
if {$last_dash < 0} { continue }
set modname [string range $rest 0 [expr {$last_dash - 1}]]
set modver [string range $rest [expr {$last_dash + 1}] end]
set modpath [file join $sub "$modname-$modver.tm"]
#calculate fully qualified module name based on path relative to the modules folder we added to the tcl::tm path.
set relpath [punk::path::relative $project_root/src/modules [file dirname $sub]]
set relpath [punk::path::relative [file join $project_root src modules] [file dirname $sub]]
if {$relpath eq "."} {
set relpath ""
set fullmodname $modname
@ -350,10 +405,9 @@ tcl::namespace::eval punk::tcltestrun {
if {[file exists $modpath]} {
puts stderr "runtestmodules.tcl adding package ifneeded for modpod module $fullmodname at path $modpath"
#package ifneeded $modname 0.1.0 [list source $modpath]
append script [list package ifneeded $fullmodname 0.1.0 [list source $modpath]] { ;} \n
append script [list package ifneeded $fullmodname $modver [list source $modpath]] { ;} \n
} else {
puts stderr "runtestmodules.tcl warning: expected mod.tcl not found for modpod module $fullmodname at path $modpath"
puts stderr "runtestmodules.tcl warning: expected tcl module file not found for modpod module $fullmodname at path $modpath"
}
}
}
@ -489,7 +543,7 @@ namespace eval ::punk::args::register {
package provide punk::tcltestrun [tcl::namespace::eval punk::tcltestrun {
variable pkg punk::tcltestrun
variable version
set version 0.1.0
set version 0.3.0
}]
return

96
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/tcltestrun-0.1.0.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/tcltestrun-0.3.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2026
#
# @@ Meta Begin
# Application punk::tcltestrun 0.1.0
# Application punk::tcltestrun 0.3.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -93,14 +93,18 @@ tcl::namespace::eval punk::tcltestrun {
#'took' lines can occur for both passing and failing tests, but will occur before the ++++ PASSED or ==== FAILED lines for a test case,
if {[string match "++++ * took * µs" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
# The test name may itself contain the word "took", so locate the " took " delimiter from the right (last occurrence).
# Name is the substring between "++++ " (5 chars) and the last " took ".
set took_pos [string last " took " $ln_trimright]
set nm [string range $ln_trimright 5 [expr {$took_pos - 1}]]
dict set test_case_time $nm [dict create microseconds [lindex $ln end-1]]
continue
}
if {[string match "++++ * PASSED" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
# " PASSED" is terminal (7 chars); trim "++++ " (5 chars) from front and " PASSED" from end to get the full name.
set nm [string range $ln_trimright 5 end-7]
if {[dict exists $test_case_time $nm]} {
dict set results testcase_passes $nm [dict get $test_case_time $nm]
} else {
@ -111,8 +115,11 @@ tcl::namespace::eval punk::tcltestrun {
# ++++ <testname_words> SKIPPED: <constraint/reason>
if {[string match "++++ * SKIPPED: *" $ln_trimright]} {
dict append results out "<stdout><$pkg> $ln" \n
set nm [lindex $ln 1]
set reason [string trim [string range $ln [expr {[string first "SKIPPED:" $ln] + 8}] end]]
# Anchor on " SKIPPED:" (with leading space) so the name is extracted as the substring before it.
# Leftmost occurrence is used because the reason is free text after the delimiter and may itself contain "SKIPPED:".
set skip_pos [string first " SKIPPED:" $ln_trimright]
set nm [string range $ln_trimright 5 [expr {$skip_pos - 1}]]
set reason [string trim [string range $ln_trimright [expr {$skip_pos + 9}] end]]
dict set results testcase_constraintskips $nm [list reason $reason]
continue
}
@ -222,6 +229,33 @@ tcl::namespace::eval punk::tcltestrun {
}
# Result capture for FAILED (non-error) tests: grab "---- Result was:" and "---- Result should have been" blocks.
if {$fail_stage eq "contents"} {
if {[dict exists $test_case_fail result_stage] && [dict get $test_case_fail result_stage] ne ""} {
if {[string match "---- *" $ln] || [string match "==== * FAILED" $ln_trimright] || [string match "++++ *" $ln]} {
dict set test_case_fail result_stage ""
# fall through to normal handling below (do not continue)
} else {
dict append test_case_fail [dict get $test_case_fail result_stage] "$ln\n"
dict append results out "<stdout><$pkg> $ln" \n
continue
}
} elseif {[string match "---- Result was:*" $ln]} {
dict set test_case_fail result_stage "result_was"
if {![dict exists $test_case_fail result_was]} {
dict set test_case_fail result_was ""
}
dict append results out "<stdout><$pkg> $ln" \n
continue
} elseif {[string match "---- Result should have been*" $ln]} {
dict set test_case_fail result_stage "result_expected"
if {![dict exists $test_case_fail result_expected]} {
dict set test_case_fail result_expected ""
}
dict append results out "<stdout><$pkg> $ln" \n
continue
}
}
if {$fail_stage eq "contents" && ![string match "---- *" $ln] && ![string match "++++ *" $ln] && ![string match "==== * FAILED" $ln_trimright]} {
dict append test_case_fail test_body "$ln\n"
dict append results out "<stdout><$pkg> $ln" \n
@ -247,8 +281,17 @@ tcl::namespace::eval punk::tcltestrun {
} errorcode [dict get $test_case_fail errorcode] {*}{
}
]
if {[dict exists $test_case_time $nm]} {
dict set results testcase_fails $nm microseconds [dict get $test_case_time $nm microseconds]
if {[dict exists $test_case_time $test_name]} {
dict set results testcase_fails $test_name microseconds [dict get $test_case_time $test_name microseconds]
}
if {[dict exists $test_case_fail errorinfo] && [dict get $test_case_fail errorinfo] ne ""} {
dict set results testcase_fails $test_name errorinfo [dict get $test_case_fail errorinfo]
}
if {[dict exists $test_case_fail result_was] && [dict get $test_case_fail result_was] ne ""} {
dict set results testcase_fails $test_name result_was [dict get $test_case_fail result_was]
}
if {[dict exists $test_case_fail result_expected] && [dict get $test_case_fail result_expected] ne ""} {
dict set results testcase_fails $test_name result_expected [dict get $test_case_fail result_expected]
}
dict set test_case_fail stage ""
@ -257,6 +300,10 @@ tcl::namespace::eval punk::tcltestrun {
dict set test_case_fail test_body ""
dict set test_case_fail returncode ""
dict set test_case_fail errorcode ""
dict unset test_case_fail errorinfo
dict unset test_case_fail result_was
dict unset test_case_fail result_expected
dict unset test_case_fail result_stage
dict append results out "<stdout><$pkg> $ln" \n
continue ;#skip to next line.
@ -312,31 +359,39 @@ tcl::namespace::eval punk::tcltestrun {
"Add package ifneeded definitions for any unbuilt #modpod modules found in the specified path."
@leaders
@opts
@values -min 1 -max 1
@values -min 2 -max 2
tmpath -type string -help\
"Path to a folder containing unbuilt #modpod modules."
project_root -type string -help\
"Project root directory used to compute the fully qualified module name from the #modpod directory's path relative to <project_root>/src/modules."
}]
}
proc tm_path_additional_ifneeded {tmpath} {
proc tm_path_additional_ifneeded {tmpath project_root} {
#If the supplied tmpath contains any unbuilt #modpod modules, we want to add package ifneeded definitions for those modules.
#return a single script containing the package ifneeded definitions.
#when running against unbuilt modules - we want to ensure that the unbuilt versions of any modules are used rather than any installed versions - so we add package ifneeded definitions for the unbuilt versions of any modules that are present.
# add 'package ifneeded' definitions for unbuilt #modpod modules.
#first gather subdirectories of modules that contain #modpod-*-0.1.0 in their name - these should be the unbuilt versions of zip based modules.
#set subfolders [punk::path::subfolders -recursive $tmpath -match */#modpod-*-0.1.0]
#first gather subdirectories of modules that contain #modpod-*-<version> in their name - these should be the unbuilt versions of zip based modules.
#'punk::path::subfolders' currently only supports negative matching with -exclude, so we have to filter for the positive match ourselves.
set subfolders [punk::path::subfolders -recursive -exclude {**/_build/** **/_build} $tmpath]
set script ""
foreach sub $subfolders {
#In most cases we could use string match - but the * within modpod-*-0.1.0 could match a forward slash which could then match some other file under a #modpod- folder structure,
#In most cases we could use string match - but the * within modpod-*-<version> could match a forward slash which could then match some other file under a #modpod- folder structure,
#so we use globmatchpath which treats * as matching any characters except path separators.
if {[punk::path::globmatchpath "**/#modpod-*-0.1.0" $sub]} {
set modname [file tail $sub]
set modname [string range $modname 8 end-13] ;#strip off #modpod- and -0.1.0
set modpath [file join $sub "$modname-0.1.0.tm"]
if {[punk::path::globmatchpath "**/#modpod-*" $sub]} {
set tail [file tail $sub]
# Extract modname and version from the #modpod-<modname>-<version> directory name.
# The directory name format is: #modpod-<modname>-<version>
# Strip the leading "#modpod-" (8 chars), then split on the last "-" to separate modname from version.
set rest [string range $tail 8 end]
set last_dash [string last "-" $rest]
if {$last_dash < 0} { continue }
set modname [string range $rest 0 [expr {$last_dash - 1}]]
set modver [string range $rest [expr {$last_dash + 1}] end]
set modpath [file join $sub "$modname-$modver.tm"]
#calculate fully qualified module name based on path relative to the modules folder we added to the tcl::tm path.
set relpath [punk::path::relative $project_root/src/modules [file dirname $sub]]
set relpath [punk::path::relative [file join $project_root src modules] [file dirname $sub]]
if {$relpath eq "."} {
set relpath ""
set fullmodname $modname
@ -350,10 +405,9 @@ tcl::namespace::eval punk::tcltestrun {
if {[file exists $modpath]} {
puts stderr "runtestmodules.tcl adding package ifneeded for modpod module $fullmodname at path $modpath"
#package ifneeded $modname 0.1.0 [list source $modpath]
append script [list package ifneeded $fullmodname 0.1.0 [list source $modpath]] { ;} \n
append script [list package ifneeded $fullmodname $modver [list source $modpath]] { ;} \n
} else {
puts stderr "runtestmodules.tcl warning: expected mod.tcl not found for modpod module $fullmodname at path $modpath"
puts stderr "runtestmodules.tcl warning: expected tcl module file not found for modpod module $fullmodname at path $modpath"
}
}
}
@ -489,7 +543,7 @@ namespace eval ::punk::args::register {
package provide punk::tcltestrun [tcl::namespace::eval punk::tcltestrun {
variable pkg punk::tcltestrun
variable version
set version 0.1.0
set version 0.3.0
}]
return
Write Preview
Loading…
Cancel
Save