34 changed files with 6206 additions and 2198 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
@ -0,0 +1,66 @@ |
|||||||
|
#!tclsh |
||||||
|
#This script uses shellfilter::run calls under the hood |
||||||
|
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||||
|
|
||||||
|
set script_dir [file dirname [info script]] |
||||||
|
|
||||||
|
#------------------------------------ |
||||||
|
#use the unbuilt modules/libraries under development rather than the installed versions. |
||||||
|
set original_tmlist [tcl::tm::list] |
||||||
|
tcl::tm::remove {*}$original_tmlist |
||||||
|
tcl::tm::add [file normalize $script_dir/../modules] ;#ie <projectroot>/src/modules |
||||||
|
tcl::tm::add [file normalize $script_dir/../modules_tcl$tcl_major] |
||||||
|
tcl::tm::add {*}[lreverse $original_tmlist] |
||||||
|
set libdir [file normalize $script_dir/../lib] |
||||||
|
set libvdir [file normalize $script_dir/../lib/tcl$tcl_major] |
||||||
|
if {$libdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libdir |
||||||
|
} |
||||||
|
if {$libvdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libvdir |
||||||
|
} |
||||||
|
#------------------------------------ |
||||||
|
package require tcltest |
||||||
|
|
||||||
|
|
||||||
|
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 dict -default "" -help\ |
||||||
|
"pairs of flags/values that will be passed to tcltest::configure before running the tests. |
||||||
|
For example, to run only tests with names matching *foo* and *bar* you could use: |
||||||
|
-tcltestoptions {-file {*foo* *bar*}} |
||||||
|
" |
||||||
|
@values -min 0 -max -1 |
||||||
|
glob -type string -multiple 1 -optional 1 -help\ |
||||||
|
" names or glob patterns of test files to run." |
||||||
|
} |
||||||
|
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 file_globs [list *.test] |
||||||
|
} else { |
||||||
|
set file_globs [dict get $values glob] |
||||||
|
} |
||||||
|
|
||||||
|
set ::argv $tcltestoptions |
||||||
|
set ::argc [llength $tcltestoptions] |
||||||
|
#set ::argv {} |
||||||
|
#set ::argc 0 |
||||||
|
|
||||||
|
tcltest::configure -verbose "body pass skip error usec" |
||||||
|
tcltest::configure -testdir $script_dir |
||||||
|
tcltest::configure -file $file_globs |
||||||
|
#review - single process has less isolation - but works better in this case. |
||||||
|
#(some tclsh shells can hang when running with -singleproc false - needs investigation) |
||||||
|
#tclte::configure -singleproc true |
||||||
|
tcltest::configure -singleproc true |
||||||
|
dict for {k v} $tcltestoptions { |
||||||
|
tcltest::configure $k $v |
||||||
|
} |
||||||
|
tcltest::runAllTests |
||||||
@ -0,0 +1,39 @@ |
|||||||
|
|
||||||
|
if {[llength $::argv]} { |
||||||
|
puts stderr "$script_dir ::argv $::argv" |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
#------------------------------------ |
||||||
|
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||||
|
set script_dir [file dirname [file normalize [info script]]] |
||||||
|
set src_tests_posn [string first /src/tests/ $script_dir] |
||||||
|
if {$src_tests_posn < 0} { |
||||||
|
puts stderr "Error: script dir $script_dir does not contain /src/tests/" |
||||||
|
#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 /src/tests/" |
||||||
|
} |
||||||
|
set project_root [string range $script_dir 0 $src_tests_posn-1] |
||||||
|
#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] |
||||||
|
set libdir [file normalize $project_root/src/lib] |
||||||
|
set libvdir [file normalize $project_root/src/lib/tcl$tcl_major] |
||||||
|
if {$libdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libdir |
||||||
|
} |
||||||
|
if {$libvdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libvdir |
||||||
|
} |
||||||
|
#------------------------------------ |
||||||
|
|
||||||
|
package require tcltest |
||||||
|
puts "----------------- [tcl::tm::list]" |
||||||
|
|
||||||
|
#tcltest::configure -debug 1 |
||||||
|
tcltest::configure -singleproc true |
||||||
|
tcltest::configure {*}$::argv |
||||||
|
tcltest::configure -testdir $script_dir |
||||||
|
tcltest::configure -asidefromdir * ;#only the toplevel all.tcl should recurse. |
||||||
|
tcltest::runAllTests |
||||||
@ -0,0 +1,84 @@ |
|||||||
|
package require tcltest |
||||||
|
tcltest::configure {*}$::argv |
||||||
|
|
||||||
|
#------------------------------------ |
||||||
|
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||||
|
set script_dir [file dirname [file normalize [info script]]] |
||||||
|
set src_tests_posn [string first /src/tests/ $script_dir] |
||||||
|
if {$src_tests_posn < 0} { |
||||||
|
puts stderr "Error: script dir $script_dir does not contain /src/tests/" |
||||||
|
#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 /src/tests/" |
||||||
|
} |
||||||
|
set project_root [string range $script_dir 0 $src_tests_posn-1] |
||||||
|
#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] |
||||||
|
set libdir [file normalize $project_root/src/lib] |
||||||
|
set libvdir [file normalize $project_root/src/lib/tcl$tcl_major] |
||||||
|
if {$libdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libdir |
||||||
|
} |
||||||
|
if {$libvdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libvdir |
||||||
|
} |
||||||
|
#------------------------------------ |
||||||
|
|
||||||
|
puts stdout "==================== $::argv" |
||||||
|
puts stdout "==================== [tcl::tm::list]" |
||||||
|
package require overtype |
||||||
|
package require opunk::str |
||||||
|
|
||||||
|
namespace eval ::testspace { |
||||||
|
namespace import ::tcltest::* |
||||||
|
variable common { |
||||||
|
set result "" |
||||||
|
} |
||||||
|
|
||||||
|
# Temporarily replaces punk::console::get_tabstops so tab-related tests are deterministic. |
||||||
|
proc with_tabstops {tabstops body} { |
||||||
|
variable __tabstops |
||||||
|
set __tabstops $tabstops |
||||||
|
set had_original [expr {[llength [info commands ::punk::console::get_tabstops]] > 0}] |
||||||
|
if {$had_original} { |
||||||
|
rename ::punk::console::get_tabstops ::testspace::__orig_get_tabstops |
||||||
|
} |
||||||
|
namespace eval ::punk::console {} |
||||||
|
proc ::punk::console::get_tabstops {{inoutchannels {stdin stdout}}} { |
||||||
|
return [set ::testspace::__tabstops] |
||||||
|
} |
||||||
|
|
||||||
|
set code [catch {uplevel 1 $body} out opts] |
||||||
|
|
||||||
|
rename ::punk::console::get_tabstops {} |
||||||
|
if {$had_original} { |
||||||
|
rename ::testspace::__orig_get_tabstops ::punk::console::get_tabstops |
||||||
|
} |
||||||
|
return -options $opts $out |
||||||
|
} |
||||||
|
proc vis {s} { |
||||||
|
string map [list "\u0000" "<NUL>" "\x1b" "<ESC>" "\n" "<LF>" "\r" "<CR>" "\t" "<TAB>"] $s |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
test opunkstr_basic {basic string object creation and properties}\ |
||||||
|
-setup $common -body { |
||||||
|
set text "abcde" |
||||||
|
set o [opunk::Str new $text] |
||||||
|
set result [list \ |
||||||
|
[string equal $text [opunk::Str::get $o]] \ |
||||||
|
[opunk::Str::count $o] \ |
||||||
|
[expr {[opunk::Str::has_ansi $o] && true}] \ |
||||||
|
] |
||||||
|
|
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list {*}{ |
||||||
|
1 5 0 |
||||||
|
}] |
||||||
|
|
||||||
|
} |
||||||
|
|
||||||
|
tcltest::cleanupTests ;#needed to produce test summary. |
||||||
@ -0,0 +1,38 @@ |
|||||||
|
|
||||||
|
lassign [split [info tclversion] .] tcl_major tcl_minor |
||||||
|
|
||||||
|
|
||||||
|
set script_dir [file dirname [file normalize [info script]]] |
||||||
|
if {[llength $::argv]} { |
||||||
|
puts stderr "$script_dir ::argv $::argv" |
||||||
|
} |
||||||
|
|
||||||
|
set src_tests_posn [string first /src/tests/ $script_dir] |
||||||
|
if {$src_tests_posn < 0} { |
||||||
|
puts "Error: script dir $script_dir does not contain /src/tests/" |
||||||
|
exit 2 |
||||||
|
} |
||||||
|
set project_root [string range $script_dir 0 $src_tests_posn-1] |
||||||
|
|
||||||
|
#------------------------------------ |
||||||
|
#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] |
||||||
|
set libdir [file normalize $project_root/src/lib] |
||||||
|
set libvdir [file normalize $project_root/src/lib/tcl$tcl_major] |
||||||
|
if {$libdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libdir |
||||||
|
} |
||||||
|
if {$libvdir ni $::auto_path} { |
||||||
|
lappend ::auto_path $libvdir |
||||||
|
} |
||||||
|
#------------------------------------ |
||||||
|
package require tcltest |
||||||
|
|
||||||
|
#tcltest::configure -debug 1 |
||||||
|
tcltest::configure -singleproc true |
||||||
|
tcltest::configure {*}$::argv |
||||||
|
tcltest::configure -testdir $script_dir |
||||||
|
tcltest::configure -asidefromdir * ;#only the toplevel all.tcl should recurse. |
||||||
|
tcltest::runAllTests |
||||||
@ -0,0 +1,33 @@ |
|||||||
|
package require tcltest |
||||||
|
tcltest::configure {*}$::argv |
||||||
|
|
||||||
|
|
||||||
|
package require overtype |
||||||
|
package require punk::path |
||||||
|
|
||||||
|
namespace eval ::testspace { |
||||||
|
namespace import ::tcltest::* |
||||||
|
variable common { |
||||||
|
set result "" |
||||||
|
} |
||||||
|
|
||||||
|
|
||||||
|
test globmatchpath_basic {Test single star between slashes pathglob argument will match exactly a single level}\ |
||||||
|
-setup $common -body { |
||||||
|
|
||||||
|
set result [list {*}{ |
||||||
|
} [punk::path::globmatchpath /etc/*/*.doc /etc/A/test.doc] {*}{ |
||||||
|
} [punk::path::globmatchpath /etc/*/*.doc /etc/A/B/test.doc] {*}{ |
||||||
|
} [punk::path::globmatchpath /etc/*/*.doc /etc/test.doc] |
||||||
|
] |
||||||
|
|
||||||
|
}\ |
||||||
|
-cleanup { |
||||||
|
}\ |
||||||
|
-result [list {*}{ |
||||||
|
1 0 0 |
||||||
|
}] |
||||||
|
|
||||||
|
} |
||||||
|
|
||||||
|
tcltest::cleanupTests ;#needed to produce test summary. |
||||||
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
Binary file not shown.
Loading…
Reference in new issue