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:
10f67b2ced 2019-09-16 5: tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]]
10f67b2ced 2019-09-16 6:
ad7092b843 2019-09-16 7: tcltest::configure -verbose pbse
ad7092b843 2019-09-16 8: tcltest::configure {*}$argv
ad7092b843 2019-09-16 9:
ad7092b843 2019-09-16 10: set rootDir "//xvfs:/example"
ad7092b843 2019-09-16 11: set rootDirNative [file join [pwd] example]
ad7092b843 2019-09-16 12: #set rootDir $rootDirNative
ad7092b843 2019-09-16 13: set testFile "${rootDir}/foo"
5583d77f1c 2019-09-14 14:
5583d77f1c 2019-09-14 15: proc glob_verify {args} {
ad7092b843 2019-09-16 16: set rv [glob -nocomplain -directory $::rootDir {*}$args]
ad7092b843 2019-09-16 17: set verify [glob -nocomplain -directory $::rootDirNative {*}$args]
5583d77f1c 2019-09-14 18:
5583d77f1c 2019-09-14 19: if {[llength $rv] != [llength $verify]} {
5583d77f1c 2019-09-14 20: error "VERIFY FAILED: glob ... $args ($rv versus $verify)"
5583d77f1c 2019-09-14 21: }
5583d77f1c 2019-09-14 22:
5583d77f1c 2019-09-14 23: return $rv
5583d77f1c 2019-09-14 24: }
5583d77f1c 2019-09-14 25:
ad7092b843 2019-09-16 26: tcltest::customMatch boolean [list apply {{expected actual} {
ad7092b843 2019-09-16 27: if {!!$expected == !!$actual} {
ad7092b843 2019-09-16 28: return true
ad7092b843 2019-09-16 29: } else {
ad7092b843 2019-09-16 30: return false
ad7092b843 2019-09-16 31: }
ad7092b843 2019-09-16 32: }}]
ad7092b843 2019-09-16 33:
10f67b2ced 2019-09-16 34: tcltest::test xvfs-seek-basic "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"
10f67b2ced 2019-09-16 45:
10f67b2ced 2019-09-16 46: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
10f67b2ced 2019-09-16 47: set fd [open $testFile]
10f67b2ced 2019-09-16 48: } -body {
10f67b2ced 2019-09-16 49: seek $fd 1 end
10f67b2ced 2019-09-16 50: } -cleanup {
10f67b2ced 2019-09-16 51: close $fd
10f67b2ced 2019-09-16 52: unset fd
10f67b2ced 2019-09-16 53: } -match glob -returnCodes error -result "*: invalid argument"
10f67b2ced 2019-09-16 54:
10f67b2ced 2019-09-16 55: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
10f67b2ced 2019-09-16 56: set fd [open $testFile]
10f67b2ced 2019-09-16 57: } -body {
10f67b2ced 2019-09-16 58: seek $fd -10 current
10f67b2ced 2019-09-16 59: } -cleanup {
10f67b2ced 2019-09-16 60: close $fd
10f67b2ced 2019-09-16 61: unset fd
10f67b2ced 2019-09-16 62: } -match glob -returnCodes error -result "*: invalid argument"
10f67b2ced 2019-09-16 63:
10f67b2ced 2019-09-16 64: tcltest::test xvfs-seek-read-past-eof "Xvfs Seek Then Read Past EOF Test" -setup {
10f67b2ced 2019-09-16 65: set fd [open $testFile]
10f67b2ced 2019-09-16 66: } -body {
10f67b2ced 2019-09-16 67: seek $fd 0 end
10f67b2ced 2019-09-16 68:
10f67b2ced 2019-09-16 69: read $fd 1
10f67b2ced 2019-09-16 70: read $fd 1
10f67b2ced 2019-09-16 71: } -cleanup {
10f67b2ced 2019-09-16 72: close $fd
10f67b2ced 2019-09-16 73: unset fd
10f67b2ced 2019-09-16 74: } -result ""
10f67b2ced 2019-09-16 75:
10f67b2ced 2019-09-16 76: tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -setup {
10f67b2ced 2019-09-16 77: unset -nocomplain fd
10f67b2ced 2019-09-16 78: } -body {
10f67b2ced 2019-09-16 79: set fd [open $rootDir/new-file w]
10f67b2ced 2019-09-16 80: close $fd
10f67b2ced 2019-09-16 81: } -cleanup {
10f67b2ced 2019-09-16 82: if {[info exists fd]} {
10f67b2ced 2019-09-16 83: close $fd
10f67b2ced 2019-09-16 84: unset fd
10f67b2ced 2019-09-16 85: }
10f67b2ced 2019-09-16 86: catch {
10f67b2ced 2019-09-16 87: file delete $rootDir/new-file
10f67b2ced 2019-09-16 88: }
10f67b2ced 2019-09-16 89: } -match glob -returnCodes error -result "*read*only file*system*"
ad7092b843 2019-09-16 90:
ad7092b843 2019-09-16 91: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
ad7092b843 2019-09-16 92: set fd1 [open $testFile]
ad7092b843 2019-09-16 93: set fd2 [open $testFile]
ad7092b843 2019-09-16 94: } -body {
ad7092b843 2019-09-16 95: set data1 [read $fd1]
ad7092b843 2019-09-16 96: close $fd1
ad7092b843 2019-09-16 97: set data2 [read $fd2]
ad7092b843 2019-09-16 98: close $fd2
ad7092b843 2019-09-16 99:
ad7092b843 2019-09-16 100: expr {$data1 eq $data2}
ad7092b843 2019-09-16 101: } -cleanup {
ad7092b843 2019-09-16 102: unset -nocomplain fd1 fd2 data1 data2
ad7092b843 2019-09-16 103: } -match boolean -result true
ad7092b843 2019-09-16 104:
ad7092b843 2019-09-16 105: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
ad7092b843 2019-09-16 106: set fd [open $testFile]
ad7092b843 2019-09-16 107: seek $fd 0 end
ad7092b843 2019-09-16 108: set size [tell $fd]
ad7092b843 2019-09-16 109: seek $fd 0 start
ad7092b843 2019-09-16 110:
ad7092b843 2019-09-16 111: set done false
ad7092b843 2019-09-16 112: set calls 0
ad7092b843 2019-09-16 113: set output ""
ad7092b843 2019-09-16 114: } -body {
ad7092b843 2019-09-16 115: fileevent $fd readable [list apply {{fd} {
ad7092b843 2019-09-16 116: set pos [tell $fd]
ad7092b843 2019-09-16 117: set x [read $fd 1]
ad7092b843 2019-09-16 118: if {[string length $x] == 0} {
ad7092b843 2019-09-16 119: set ::done true
ad7092b843 2019-09-16 120: fileevent $fd readable ""
ad7092b843 2019-09-16 121: }
ad7092b843 2019-09-16 122:
ad7092b843 2019-09-16 123: lappend ::output $pos
ad7092b843 2019-09-16 124: incr ::calls
ad7092b843 2019-09-16 125: }} $fd]
ad7092b843 2019-09-16 126: vwait done
ad7092b843 2019-09-16 127:
ad7092b843 2019-09-16 128: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
ad7092b843 2019-09-16 129: } -cleanup {
ad7092b843 2019-09-16 130: close $fd
10f67b2ced 2019-09-16 131: update
ad7092b843 2019-09-16 132: unset -nocomplain fd size done calls output
ad7092b843 2019-09-16 133: } -result {1 1}
10f67b2ced 2019-09-16 134:
10f67b2ced 2019-09-16 135: tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
10f67b2ced 2019-09-16 136: file exists ${rootDir}_DOES_NOT_EXIST
10f67b2ced 2019-09-16 137: } -match boolean -result false
ad7092b843 2019-09-16 138:
ad7092b843 2019-09-16 139: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
ad7092b843 2019-09-16 140: llength [glob_verify *]
ad7092b843 2019-09-16 141: } -result 3
ad7092b843 2019-09-16 142:
ad7092b843 2019-09-16 143: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
ad7092b843 2019-09-16 144: llength [glob_verify f*]
ad7092b843 2019-09-16 145: } -result 1
ad7092b843 2019-09-16 146:
ad7092b843 2019-09-16 147: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
ad7092b843 2019-09-16 148: llength [glob_verify x*]
ad7092b843 2019-09-16 149: } -result 0
ad7092b843 2019-09-16 150:
ad7092b843 2019-09-16 151: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
ad7092b843 2019-09-16 152: llength [glob_verify ./f*]
ad7092b843 2019-09-16 153: } -result 1
ad7092b843 2019-09-16 154:
ad7092b843 2019-09-16 155: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
ad7092b843 2019-09-16 156: llength [glob_verify -type f ./f*]
ad7092b843 2019-09-16 157: } -result 1
ad7092b843 2019-09-16 158:
ad7092b843 2019-09-16 159: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
ad7092b843 2019-09-16 160: llength [glob_verify -type d ./f*]
ad7092b843 2019-09-16 161: } -result 0
ad7092b843 2019-09-16 162:
ad7092b843 2019-09-16 163: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
ad7092b843 2019-09-16 164: llength [glob_verify lib/*]
ad7092b843 2019-09-16 165: } -result 1
ad7092b843 2019-09-16 166:
ad7092b843 2019-09-16 167: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
ad7092b843 2019-09-16 168: lindex [glob_verify lib/*] 0
ad7092b843 2019-09-16 169: } -match glob -result "$rootDir/*"
10f67b2ced 2019-09-16 170:
10f67b2ced 2019-09-16 171: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
10f67b2ced 2019-09-16 172: file readable $testFile
10f67b2ced 2019-09-16 173: } -match boolean -result true
10f67b2ced 2019-09-16 174:
10f67b2ced 2019-09-16 175: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
10f67b2ced 2019-09-16 176: file writable $testFile
10f67b2ced 2019-09-16 177: } -match boolean -result false
10f67b2ced 2019-09-16 178:
10f67b2ced 2019-09-16 179: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
10f67b2ced 2019-09-16 180: file executable $testFile
10f67b2ced 2019-09-16 181: } -match boolean -result false
10f67b2ced 2019-09-16 182:
10f67b2ced 2019-09-16 183: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
10f67b2ced 2019-09-16 184: file exists $rootDir/does-not-exist
10f67b2ced 2019-09-16 185: } -match boolean -result false
10f67b2ced 2019-09-16 186:
10f67b2ced 2019-09-16 187: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
10f67b2ced 2019-09-16 188: file stat $testFile fileInfo
10f67b2ced 2019-09-16 189: set fileInfo(type)
10f67b2ced 2019-09-16 190: } -cleanup {
10f67b2ced 2019-09-16 191: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 192: } -result file
10f67b2ced 2019-09-16 193:
10f67b2ced 2019-09-16 194: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
10f67b2ced 2019-09-16 195: file stat $rootDir/lib fileInfo
10f67b2ced 2019-09-16 196: set fileInfo(type)
10f67b2ced 2019-09-16 197: } -cleanup {
10f67b2ced 2019-09-16 198: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 199: } -result directory
e4bde431db 2019-09-16 200:
ad7092b843 2019-09-16 201: # Broken in Tcl 8.6 and earlier
ad7092b843 2019-09-16 202: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
ad7092b843 2019-09-16 203: llength [glob //xvfs:/example/*]
ad7092b843 2019-09-16 204: } -constraints tcl87 -result 3
ad7092b843 2019-09-16 205:
ad7092b843 2019-09-16 206: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
ad7092b843 2019-09-16 207: lindex [glob -directory [file dirname $testFile] *] 0
ad7092b843 2019-09-16 208: } -constraints tcl87 -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 209:
ad7092b843 2019-09-16 210: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 211: set startDir [pwd]
ad7092b843 2019-09-16 212: } -body {
ad7092b843 2019-09-16 213: cd $rootDir
ad7092b843 2019-09-16 214: pwd
ad7092b843 2019-09-16 215: } -cleanup {
ad7092b843 2019-09-16 216: cd $startDir
ad7092b843 2019-09-16 217: unset startDir
e4bde431db 2019-09-16 218: } -constraints tcl87 -result $rootDir
ad7092b843 2019-09-16 219:
ad7092b843 2019-09-16 220: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 221: set startDir [pwd]
ad7092b843 2019-09-16 222: } -body {
ad7092b843 2019-09-16 223: cd $rootDir
ad7092b843 2019-09-16 224: cd lib
ad7092b843 2019-09-16 225: lindex [glob *] 0
ad7092b843 2019-09-16 226: } -cleanup {
ad7092b843 2019-09-16 227: cd $startDir
ad7092b843 2019-09-16 228: unset startDir
e4bde431db 2019-09-16 229: } -constraints tcl87 -result "hello"
ad7092b843 2019-09-16 230:
ad7092b843 2019-09-16 231: # Currently broken
ad7092b843 2019-09-16 232: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
ad7092b843 2019-09-16 233: set startAutoPath $auto_path
ad7092b843 2019-09-16 234: lappend auto_path ${rootDir}/lib
ad7092b843 2019-09-16 235: } -body {
ad7092b843 2019-09-16 236: package require hello
ad7092b843 2019-09-16 237: set auto_path
ad7092b843 2019-09-16 238: } -cleanup {
ad7092b843 2019-09-16 239: set auto_path $startAutoPath
ad7092b843 2019-09-16 240: unset startAutoPath
ad7092b843 2019-09-16 241: } -constraints knownBug -result ""
ad7092b843 2019-09-16 242:
ad7092b843 2019-09-16 243: # Output results
ad7092b843 2019-09-16 244: if {$::tcltest::numTests(Failed) != 0} {
ad7092b843 2019-09-16 245: set format "| %20s | %20s | %20s | %20s |"
ad7092b843 2019-09-16 246: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 247: puts [format $format "Passed" "Failed" "Skipped" "Total"]
ad7092b843 2019-09-16 248: puts [format $format \
ad7092b843 2019-09-16 249: $::tcltest::numTests(Passed) \
ad7092b843 2019-09-16 250: $::tcltest::numTests(Failed) \
ad7092b843 2019-09-16 251: $::tcltest::numTests(Skipped) \
ad7092b843 2019-09-16 252: $::tcltest::numTests(Total) \
ad7092b843 2019-09-16 253: ]
ad7092b843 2019-09-16 254: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 255:
10f67b2ced 2019-09-16 256: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
10f67b2ced 2019-09-16 257: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
10f67b2ced 2019-09-16 258: }
ad7092b843 2019-09-16 259: exit 1
fa71466879 2019-09-14 260: }
38bed7cee0 2019-09-13 261:
38bed7cee0 2019-09-13 262: puts "ALL TESTS PASSED"
ad7092b843 2019-09-16 263:
10f67b2ced 2019-09-16 264: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
10f67b2ced 2019-09-16 265: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
10f67b2ced 2019-09-16 266: }
ad7092b843 2019-09-16 267: exit 0