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.
235 lines
9.8 KiB
235 lines
9.8 KiB
#!punk902testrunner shellspy |
|
#This script uses shellfilter::run calls under the hood - which probably requires a built punkshell binary to function properly. |
|
#(plain tclsh may stall - todo - review reasons for this and whether shellfilter can be modified to support ordinary tclsh) |
|
#A known working copy of a punk shell executable should be placed on the path and the shebang line updated to reflect this |
|
|
|
#------------------------------------ |
|
lassign [split [info tclversion] .] tcl_major tcl_minor |
|
set script_dir [file dirname [file normalize [info script]]] |
|
set modules_posn [string first /modules/ $script_dir] |
|
if {$modules_posn < 0} { |
|
puts stderr "Error: script dir $script_dir does not contain /modules/" |
|
#exit 2 ;#don't call exit. If run in a single proc it can cause the hole test suite exit before summary can be printed. |
|
return -code error "Error: script dir $script_dir does not contain /modules/" |
|
} |
|
set modules_base [string range $script_dir 0 $modules_posn-1] |
|
if {[file tail $modules_base] eq "src"} { |
|
set project_root [file dirname $modules_base] |
|
} else { |
|
set project_root $modules_base |
|
} |
|
puts stderr "runtestmodules.tcl project_root: $project_root" |
|
#use the unbuilt modules/libraries under development rather than the installed versions. |
|
#The unbuilt modules should have a higher version number (such as the magic version number 999999.0a1.0) than any installed versions to ensure they are preferred. |
|
tcl::tm::add [file normalize $project_root/src/modules] |
|
tcl::tm::add [file normalize $project_root/src/modules_tcl$tcl_major] |
|
tcl::tm::add [file normalize $project_root/src/vendormodules] |
|
tcl::tm::add [file normalize $project_root/src/vendormodules_tcl$tcl_major] |
|
|
|
# add 'package ifneeded' definitions for unbuilt #modpod modules. |
|
#first gather subdirectories of modules that contain #modpod-*-999999.0a1.0 in their name - these should be the unbuilt versions of zip based modules. |
|
#set subfolders [punk::path::subfolders -recursive [file normalize $project_root/src/modules] -match */#modpod-*-999999.0a1.0] |
|
#'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 [file normalize $project_root/src/modules] -exclude {**/_build/** **/_build}] |
|
foreach sub $subfolders { |
|
#In most cases we could use string match - but the * within modpod-*-999999.0a1.0 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 {[globmatchpath "**/#modpod-*-999999.0a1.0" $sub]} { |
|
set modname [file tail $sub] |
|
set modname [string range $modname 8 end-12] ;#strip off #modpod- and -999999.0a1.0 |
|
set modpath [file join $sub "$modname-999999.0a1.0.tm"] |
|
#!!!! |
|
#todo - calculate fully qualified module name based on path relative to the modules folder we added to the tcl::tm path. |
|
if {[file exists $modpath]} { |
|
puts stderr "runtestmodules.tcl adding package ifneeded for modpod module $modname at path $modpath" |
|
package ifneeded $modname 999999.0a1.0 [list source $modpath] |
|
} else { |
|
puts stderr "runtestmodules.tcl warning: expected mod.tcl not found for modpod module $modname at path $modpath" |
|
} |
|
} |
|
} |
|
|
|
set libdir [file normalize $project_root/src/lib] |
|
set libvdir [file normalize $project_root/src/lib/tcl$tcl_major] |
|
set libvldir [file normalize $project_root/src/vendorlib] |
|
set libvlvdir [file normalize $project_root/src/vendorlib_tcl$tcl_major] |
|
foreach d [list $libdir $libvdir $libvldir $libvlvdir] { |
|
if {$d ni $::auto_path} { |
|
lappend ::auto_path $d |
|
} |
|
} |
|
#------------------------------------ |
|
puts stderr "runtestmodules.tcl ::auto_path: $::auto_path" |
|
puts stderr "runtestmodules.tcl tcl::tm::list: [tcl::tm::list]" |
|
|
|
|
|
package require punk |
|
package require punk::args |
|
punk::args::define { |
|
@id -id (script)::runtestmodules |
|
@cmd -name runtestmodules -help\ |
|
"Run test:: modules that support the packagetest api |
|
(have RUN command)" |
|
-tcltestoptions -type list -default "" -help\ |
|
"arguments that will be left in ::argv for tcltest |
|
to handle" |
|
@values -min 0 -max -1 |
|
glob -type string -multiple 1 -optional 1 -help\ |
|
" names or glob patterns of test modules to run. |
|
Note that this script will search for all modules |
|
within the test namespace that are known to the |
|
current interpreter - not just those within the |
|
current project." |
|
} |
|
set argd [punk::args::parse $::argv withid (script)::runtestmodules] |
|
lassign [dict values $argd] leaders opts values received |
|
set tcltestoptions [dict get $opts -tcltestoptions] |
|
if {![dict exists $received glob]} { |
|
set pkg_globs [list *] |
|
} else { |
|
set pkg_globs [dict get $values glob] |
|
} |
|
|
|
set ::argv $tcltestoptions |
|
set ::argc [llength $tcltestoptions] |
|
|
|
|
|
#bogus require to ensure modules within path test have been scanned to be in Tcl's 'package ifneeded' in-memory database |
|
catch {package require test::bogus666} |
|
set tmlist [tcl::tm::list] |
|
foreach tmfolder $tmlist { |
|
set tfolder [file join $tmfolder test] |
|
if {[file exists $tfolder]} { |
|
puts stdout "checking tm test folder $tfolder" |
|
set subfolders [glob -nocomplain -dir $tfolder -type d -tail *] |
|
foreach sub $subfolders { |
|
if {[string match #* $sub]} { |
|
continue |
|
} |
|
puts stdout "bogus require of test::${sub}::bogus666" |
|
catch {package require test::${sub}::bogus666} |
|
} |
|
} |
|
} |
|
set alltestpkgs [lsearch -all -inline [package names] test::*] |
|
if {![llength $alltestpkgs]} { |
|
puts stder "No packages matching test::* found" |
|
exit 1 |
|
} |
|
if {[llength $pkg_globs] == 1 && [lindex $pkg_globs 0] eq "*"} { |
|
set matchedtestpkgs $alltestpkgs |
|
} else { |
|
set matchedtestpkgs [list] |
|
foreach pkg $alltestpkgs { |
|
foreach g $pkg_globs { |
|
if {[string match $g $pkg]} { |
|
lappend matchedtestpkgs $pkg |
|
break |
|
} |
|
} |
|
} |
|
} |
|
if {![llength $matchedtestpkgs]} { |
|
puts stderr "No test packages matched supplied glob patterns" |
|
exit 1 |
|
} |
|
puts "matchedtestpkgs: $matchedtestpkgs" |
|
set punktestpkgs [list] |
|
foreach pkg $matchedtestpkgs { |
|
if {![catch {package require $pkg}]} { |
|
if {[info commands ::${pkg}::RUN] ne ""} { |
|
lappend punktestpkgs $pkg |
|
} |
|
} else { |
|
puts stderr "failed to load test package $pkg" |
|
} |
|
} |
|
if {![llength $punktestpkgs]} { |
|
puts stderr "No test packages with RUN command were able to be loaded" |
|
exit 1 |
|
} |
|
set scriptname [file tail [info script]] |
|
set results [dict create] |
|
dict set results total 0 |
|
dict set results passed 0 |
|
dict set results skipped 0 |
|
dict set results failed 0 |
|
set pkgs_with_fails [list] |
|
set pkgs_without_fails [list] |
|
package require shellrun |
|
puts "running tests in [llength $punktestpkgs] packages $punktestpkgs" |
|
flush stderr |
|
flush stdout |
|
package require punk::ansi |
|
foreach pkg $punktestpkgs { |
|
puts stdout "running test pkg $pkg" |
|
if {[catch { |
|
#set result [shellrun::runout -tcl ${pkg}::RUN] |
|
set result [shellrun::runx -tcl ${pkg}::RUN] |
|
#set result [shellrun::runx ls] |
|
} errM]} { |
|
puts stderr "error calling 'runout -tcl ${pkg}::RUN' $errM"; flush stderr |
|
set result {none ""} |
|
} |
|
puts stdout "executed ${pkg}::RUN" |
|
flush stdout |
|
set i 0 |
|
dict for {what chunk} $result { |
|
set chunk [string map [list \r\n \n] $chunk] |
|
switch -- $what { |
|
stdout { |
|
foreach ln [split $chunk \n] { |
|
incr i |
|
if {[string match "Tests ended at*" $ln]} { |
|
puts stdout "<stdout><$pkg> $ln" |
|
} elseif {[string match "*:*Total*Passed*Skipped*Failed*" $ln]} { |
|
set fields [lrange $ln 1 end] |
|
dict for {K v} $fields { |
|
set k [string tolower $K] |
|
dict incr results $k $v |
|
if {$k eq "failed"} { |
|
if {$v == 0} { |
|
lappend pkgs_without_fails $pkg |
|
} elseif {$v > 0} { |
|
lappend pkgs_with_fails $pkg |
|
} |
|
} |
|
} |
|
puts stdout "<stdout><$pkg> $ln" |
|
} elseif {[string match "*Sourced * Test Files*" $ln]} { |
|
puts stdout "<stdout><$pkg> $ln" |
|
} else { |
|
if {[string trim $ln] ne ""} { |
|
puts stdout "<stdout> $ln" |
|
} else { |
|
puts -nonewline stdout "\n" |
|
} |
|
#puts stdout "$i" |
|
} |
|
} |
|
flush stdout |
|
} |
|
stderr { |
|
#puts stderr "<stderr> [punk::ansi::ansistring VIEW -lf 2 -cr 1 $chunk]" |
|
set chunkview [punk::ansi::ansistring VIEW -lf 2 -cr 1 $chunk] |
|
foreach ln [split $chunkview \n] { |
|
puts stderr "<stderr> $ln" |
|
} |
|
flush stderr |
|
} |
|
default { |
|
puts stderr "<${what}> $chunk" |
|
flush stderr |
|
} |
|
} |
|
} |
|
puts stdout "completed pkg test ${pkg}" |
|
} |
|
puts stdout "packages without failures: $pkgs_without_fails" |
|
puts stdout "packages with failures: $pkgs_with_fails" |
|
puts stdout "results: Total [dict get $results total] Passed [dict get $results passed] Skipped [dict get $results skipped] Failed [dict get $results failed]" |
|
#after 5000 {set ::done true} |
|
#vwait ::done |
|
puts stdout "DONE" |
|
#exit 0 |
|
|
|
|