ad7092b843 2019-09-16 1: #! /usr/bin/env tclsh
ad7092b843 2019-09-16 2:
ad7092b843 2019-09-16 3: package require tcltest
ad7092b843 2019-09-16 4:
ad7092b843 2019-09-16 5: tcltest::configure -verbose pbse
ad7092b843 2019-09-16 6: tcltest::configure {*}$argv
ad7092b843 2019-09-16 7:
ad7092b843 2019-09-16 8: set rootDir "//xvfs:/example"
ad7092b843 2019-09-16 9: set rootDirNative [file join [pwd] example]
ad7092b843 2019-09-16 10: #set rootDir $rootDirNative
ad7092b843 2019-09-16 11: set testFile "${rootDir}/foo"
5583d77f1c 2019-09-14 12:
5583d77f1c 2019-09-14 13: proc glob_verify {args} {
ad7092b843 2019-09-16 14: set rv [glob -nocomplain -directory $::rootDir {*}$args]
ad7092b843 2019-09-16 15: set verify [glob -nocomplain -directory $::rootDirNative {*}$args]
5583d77f1c 2019-09-14 16:
5583d77f1c 2019-09-14 17: if {[llength $rv] != [llength $verify]} {
5583d77f1c 2019-09-14 18: error "VERIFY FAILED: glob ... $args ($rv versus $verify)"
5583d77f1c 2019-09-14 19: }
5583d77f1c 2019-09-14 20:
5583d77f1c 2019-09-14 21: return $rv
5583d77f1c 2019-09-14 22: }
5583d77f1c 2019-09-14 23:
ad7092b843 2019-09-16 24: tcltest::customMatch boolean [list apply {{expected actual} {
ad7092b843 2019-09-16 25: if {!!$expected == !!$actual} {
ad7092b843 2019-09-16 26: return true
ad7092b843 2019-09-16 27: } else {
ad7092b843 2019-09-16 28: return false
ad7092b843 2019-09-16 29: }
ad7092b843 2019-09-16 30: }}]
ad7092b843 2019-09-16 31:
ad7092b843 2019-09-16 32: tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
ad7092b843 2019-09-16 33:
ad7092b843 2019-09-16 34: tcltest::test xvfs-basic-seek "Xvfs Seek Test" -setup {
ad7092b843 2019-09-16 35: set fd [open $testFile]
ad7092b843 2019-09-16 36: } -body {
ad7092b843 2019-09-16 37: seek $fd 0 end
ad7092b843 2019-09-16 38: seek $fd -1 current
ad7092b843 2019-09-16 39:
ad7092b843 2019-09-16 40: read $fd 1
ad7092b843 2019-09-16 41: } -cleanup {
ad7092b843 2019-09-16 42: close $fd
ad7092b843 2019-09-16 43: unset fd
ad7092b843 2019-09-16 44: } -result "\n"
ad7092b843 2019-09-16 45:
ad7092b843 2019-09-16 46: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
ad7092b843 2019-09-16 47: set fd1 [open $testFile]
ad7092b843 2019-09-16 48: set fd2 [open $testFile]
ad7092b843 2019-09-16 49: } -body {
ad7092b843 2019-09-16 50: set data1 [read $fd1]
ad7092b843 2019-09-16 51: close $fd1
ad7092b843 2019-09-16 52: set data2 [read $fd2]
ad7092b843 2019-09-16 53: close $fd2
ad7092b843 2019-09-16 54:
ad7092b843 2019-09-16 55: expr {$data1 eq $data2}
ad7092b843 2019-09-16 56: } -cleanup {
ad7092b843 2019-09-16 57: unset -nocomplain fd1 fd2 data1 data2
ad7092b843 2019-09-16 58: } -match boolean -result true
ad7092b843 2019-09-16 59:
ad7092b843 2019-09-16 60: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
ad7092b843 2019-09-16 61: set fd [open $testFile]
ad7092b843 2019-09-16 62: seek $fd 0 end
ad7092b843 2019-09-16 63: set size [tell $fd]
ad7092b843 2019-09-16 64: seek $fd 0 start
ad7092b843 2019-09-16 65:
ad7092b843 2019-09-16 66: set done false
ad7092b843 2019-09-16 67: set calls 0
ad7092b843 2019-09-16 68: set output ""
ad7092b843 2019-09-16 69: } -body {
ad7092b843 2019-09-16 70: fileevent $fd readable [list apply {{fd} {
ad7092b843 2019-09-16 71: set pos [tell $fd]
ad7092b843 2019-09-16 72: set x [read $fd 1]
ad7092b843 2019-09-16 73: if {[string length $x] == 0} {
ad7092b843 2019-09-16 74: set ::done true
ad7092b843 2019-09-16 75: fileevent $fd readable ""
ad7092b843 2019-09-16 76: }
ad7092b843 2019-09-16 77:
ad7092b843 2019-09-16 78: lappend ::output $pos
ad7092b843 2019-09-16 79: incr ::calls
ad7092b843 2019-09-16 80: }} $fd]
ad7092b843 2019-09-16 81: vwait done
ad7092b843 2019-09-16 82:
ad7092b843 2019-09-16 83: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
ad7092b843 2019-09-16 84: } -cleanup {
ad7092b843 2019-09-16 85: close $fd
ad7092b843 2019-09-16 86: unset -nocomplain fd size done calls output
ad7092b843 2019-09-16 87: } -result {1 1}
ad7092b843 2019-09-16 88:
ad7092b843 2019-09-16 89: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
ad7092b843 2019-09-16 90: llength [glob_verify *]
ad7092b843 2019-09-16 91: } -result 3
ad7092b843 2019-09-16 92:
ad7092b843 2019-09-16 93: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
ad7092b843 2019-09-16 94: llength [glob_verify f*]
ad7092b843 2019-09-16 95: } -result 1
ad7092b843 2019-09-16 96:
ad7092b843 2019-09-16 97: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
ad7092b843 2019-09-16 98: llength [glob_verify x*]
ad7092b843 2019-09-16 99: } -result 0
ad7092b843 2019-09-16 100:
ad7092b843 2019-09-16 101: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
ad7092b843 2019-09-16 102: llength [glob_verify ./f*]
ad7092b843 2019-09-16 103: } -result 1
ad7092b843 2019-09-16 104:
ad7092b843 2019-09-16 105: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
ad7092b843 2019-09-16 106: llength [glob_verify -type f ./f*]
ad7092b843 2019-09-16 107: } -result 1
ad7092b843 2019-09-16 108:
ad7092b843 2019-09-16 109: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
ad7092b843 2019-09-16 110: llength [glob_verify -type d ./f*]
ad7092b843 2019-09-16 111: } -result 0
ad7092b843 2019-09-16 112:
ad7092b843 2019-09-16 113: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
ad7092b843 2019-09-16 114: llength [glob_verify lib/*]
ad7092b843 2019-09-16 115: } -result 1
ad7092b843 2019-09-16 116:
ad7092b843 2019-09-16 117: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
ad7092b843 2019-09-16 118: lindex [glob_verify lib/*] 0
ad7092b843 2019-09-16 119: } -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 120:
ad7092b843 2019-09-16 121: # Broken in Tcl 8.6 and earlier
ad7092b843 2019-09-16 122: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
ad7092b843 2019-09-16 123: llength [glob //xvfs:/example/*]
ad7092b843 2019-09-16 124: } -constraints tcl87 -result 3
ad7092b843 2019-09-16 125:
ad7092b843 2019-09-16 126: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
ad7092b843 2019-09-16 127: lindex [glob -directory [file dirname $testFile] *] 0
ad7092b843 2019-09-16 128: } -constraints tcl87 -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 129:
ad7092b843 2019-09-16 130: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 131: set startDir [pwd]
ad7092b843 2019-09-16 132: } -body {
ad7092b843 2019-09-16 133: cd $rootDir
ad7092b843 2019-09-16 134: pwd
ad7092b843 2019-09-16 135: } -cleanup {
ad7092b843 2019-09-16 136: cd $startDir
ad7092b843 2019-09-16 137: unset startDir
ad7092b843 2019-09-16 138: } -result $rootDir
ad7092b843 2019-09-16 139:
ad7092b843 2019-09-16 140: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 141: set startDir [pwd]
ad7092b843 2019-09-16 142: } -body {
ad7092b843 2019-09-16 143: cd $rootDir
ad7092b843 2019-09-16 144: cd lib
ad7092b843 2019-09-16 145: lindex [glob *] 0
ad7092b843 2019-09-16 146: } -cleanup {
ad7092b843 2019-09-16 147: cd $startDir
ad7092b843 2019-09-16 148: unset startDir
ad7092b843 2019-09-16 149: } -result "hello"
ad7092b843 2019-09-16 150:
ad7092b843 2019-09-16 151: # Currently broken
ad7092b843 2019-09-16 152: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
ad7092b843 2019-09-16 153: set startAutoPath $auto_path
ad7092b843 2019-09-16 154: lappend auto_path ${rootDir}/lib
ad7092b843 2019-09-16 155: } -body {
ad7092b843 2019-09-16 156: package require hello
ad7092b843 2019-09-16 157: set auto_path
ad7092b843 2019-09-16 158: } -cleanup {
ad7092b843 2019-09-16 159: set auto_path $startAutoPath
ad7092b843 2019-09-16 160: unset startAutoPath
ad7092b843 2019-09-16 161: } -constraints knownBug -result ""
ad7092b843 2019-09-16 162:
ad7092b843 2019-09-16 163: # Output results
ad7092b843 2019-09-16 164: if {$::tcltest::numTests(Failed) != 0} {
ad7092b843 2019-09-16 165: set format "| %20s | %20s | %20s | %20s |"
ad7092b843 2019-09-16 166: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 167: puts [format $format "Passed" "Failed" "Skipped" "Total"]
ad7092b843 2019-09-16 168: puts [format $format \
ad7092b843 2019-09-16 169: $::tcltest::numTests(Passed) \
ad7092b843 2019-09-16 170: $::tcltest::numTests(Failed) \
ad7092b843 2019-09-16 171: $::tcltest::numTests(Skipped) \
ad7092b843 2019-09-16 172: $::tcltest::numTests(Total) \
ad7092b843 2019-09-16 173: ]
ad7092b843 2019-09-16 174: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 175:
ad7092b843 2019-09-16 176: exit 1
fa71466879 2019-09-14 177: }
fa71466879 2019-09-14 178:
fa71466879 2019-09-14 179: puts "ALL TESTS PASSED"
ad7092b843 2019-09-16 180:
ad7092b843 2019-09-16 181: exit 0