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:
e786b9e07b 2019-09-16 76: tcltest::test xvfs-basic-open-neg "Xvfs Open Non-Existant File Test" -body {
e786b9e07b 2019-09-16 77: unset -nocomplain fd
e786b9e07b 2019-09-16 78: set fd [open $rootDir/does-not-exist]
e786b9e07b 2019-09-16 79: } -cleanup {
e786b9e07b 2019-09-16 80: if {[info exists fd]} {
e786b9e07b 2019-09-16 81: close $fd
e786b9e07b 2019-09-16 82: unset fd
e786b9e07b 2019-09-16 83: }
e786b9e07b 2019-09-16 84: } -returnCodes error -result "no such file or directory"
e786b9e07b 2019-09-16 85:
e786b9e07b 2019-09-16 86: tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -body {
10f67b2ced 2019-09-16 87: unset -nocomplain fd
10f67b2ced 2019-09-16 88: set fd [open $rootDir/new-file w]
10f67b2ced 2019-09-16 89: } -cleanup {
10f67b2ced 2019-09-16 90: if {[info exists fd]} {
10f67b2ced 2019-09-16 91: close $fd
10f67b2ced 2019-09-16 92: unset fd
10f67b2ced 2019-09-16 93: }
10f67b2ced 2019-09-16 94: catch {
10f67b2ced 2019-09-16 95: file delete $rootDir/new-file
10f67b2ced 2019-09-16 96: }
10f67b2ced 2019-09-16 97: } -match glob -returnCodes error -result "*read*only file*system*"
e786b9e07b 2019-09-16 98:
e786b9e07b 2019-09-16 99: tcltest::test xvfs-basic-open-directory "Xvfs Open Directory Test" -body {
e786b9e07b 2019-09-16 100: unset -nocomplain fd
e786b9e07b 2019-09-16 101: set fd [open $rootDir/lib]
e786b9e07b 2019-09-16 102: set fd
e786b9e07b 2019-09-16 103: } -cleanup {
e786b9e07b 2019-09-16 104: if {[info exists fd]} {
e786b9e07b 2019-09-16 105: close $fd
e786b9e07b 2019-09-16 106: unset fd
e786b9e07b 2019-09-16 107: }
e786b9e07b 2019-09-16 108: } -match glob -returnCodes error -result "*illegal operation on a directory"
ad7092b843 2019-09-16 109:
ad7092b843 2019-09-16 110: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
ad7092b843 2019-09-16 111: set fd1 [open $testFile]
ad7092b843 2019-09-16 112: set fd2 [open $testFile]
ad7092b843 2019-09-16 113: } -body {
ad7092b843 2019-09-16 114: set data1 [read $fd1]
ad7092b843 2019-09-16 115: close $fd1
ad7092b843 2019-09-16 116: set data2 [read $fd2]
ad7092b843 2019-09-16 117: close $fd2
ad7092b843 2019-09-16 118:
ad7092b843 2019-09-16 119: expr {$data1 eq $data2}
ad7092b843 2019-09-16 120: } -cleanup {
ad7092b843 2019-09-16 121: unset -nocomplain fd1 fd2 data1 data2
ad7092b843 2019-09-16 122: } -match boolean -result true
ad7092b843 2019-09-16 123:
ad7092b843 2019-09-16 124: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
ad7092b843 2019-09-16 125: set fd [open $testFile]
ad7092b843 2019-09-16 126: seek $fd 0 end
ad7092b843 2019-09-16 127: set size [tell $fd]
ad7092b843 2019-09-16 128: seek $fd 0 start
ad7092b843 2019-09-16 129:
ad7092b843 2019-09-16 130: set done false
ad7092b843 2019-09-16 131: set calls 0
ad7092b843 2019-09-16 132: set output ""
ad7092b843 2019-09-16 133: } -body {
ad7092b843 2019-09-16 134: fileevent $fd readable [list apply {{fd} {
ad7092b843 2019-09-16 135: set pos [tell $fd]
ad7092b843 2019-09-16 136: set x [read $fd 1]
ad7092b843 2019-09-16 137: if {[string length $x] == 0} {
ad7092b843 2019-09-16 138: set ::done true
ad7092b843 2019-09-16 139: fileevent $fd readable ""
ad7092b843 2019-09-16 140: }
ad7092b843 2019-09-16 141:
ad7092b843 2019-09-16 142: lappend ::output $pos
ad7092b843 2019-09-16 143: incr ::calls
ad7092b843 2019-09-16 144: }} $fd]
ad7092b843 2019-09-16 145: vwait done
ad7092b843 2019-09-16 146:
ad7092b843 2019-09-16 147: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
ad7092b843 2019-09-16 148: } -cleanup {
ad7092b843 2019-09-16 149: close $fd
10f67b2ced 2019-09-16 150: update
ad7092b843 2019-09-16 151: unset -nocomplain fd size done calls output
ad7092b843 2019-09-16 152: } -result {1 1}
10f67b2ced 2019-09-16 153:
10f67b2ced 2019-09-16 154: tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
10f67b2ced 2019-09-16 155: file exists ${rootDir}_DOES_NOT_EXIST
10f67b2ced 2019-09-16 156: } -match boolean -result false
ad7092b843 2019-09-16 157:
ad7092b843 2019-09-16 158: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
ad7092b843 2019-09-16 159: llength [glob_verify *]
ad7092b843 2019-09-16 160: } -result 3
10f67b2ced 2019-09-16 161:
3d002d6892 2019-09-16 162: tcltest::test xvfs-glob-files-any "Xvfs Glob Match Any File Test" -body {
3d002d6892 2019-09-16 163: llength [glob_verify -type f *]
3d002d6892 2019-09-16 164: } -result 2
3d002d6892 2019-09-16 165:
3d002d6892 2019-09-16 166: tcltest::test xvfs-glob-dir-any "Xvfs Glob On a File Test" -body {
3d002d6892 2019-09-16 167: glob -nocomplain -directory $testFile *
3d002d6892 2019-09-16 168: } -returnCodes error -result "not a directory"
3d002d6892 2019-09-16 169:
ad7092b843 2019-09-16 170: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
ad7092b843 2019-09-16 171: llength [glob_verify f*]
ad7092b843 2019-09-16 172: } -result 1
ad7092b843 2019-09-16 173:
ad7092b843 2019-09-16 174: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
ad7092b843 2019-09-16 175: llength [glob_verify x*]
ad7092b843 2019-09-16 176: } -result 0
ad7092b843 2019-09-16 177:
ad7092b843 2019-09-16 178: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
ad7092b843 2019-09-16 179: llength [glob_verify ./f*]
ad7092b843 2019-09-16 180: } -result 1
ad7092b843 2019-09-16 181:
ad7092b843 2019-09-16 182: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
ad7092b843 2019-09-16 183: llength [glob_verify -type f ./f*]
ad7092b843 2019-09-16 184: } -result 1
ad7092b843 2019-09-16 185:
ad7092b843 2019-09-16 186: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
ad7092b843 2019-09-16 187: llength [glob_verify -type d ./f*]
ad7092b843 2019-09-16 188: } -result 0
ad7092b843 2019-09-16 189:
ad7092b843 2019-09-16 190: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
ad7092b843 2019-09-16 191: llength [glob_verify lib/*]
ad7092b843 2019-09-16 192: } -result 1
ad7092b843 2019-09-16 193:
ad7092b843 2019-09-16 194: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
ad7092b843 2019-09-16 195: lindex [glob_verify lib/*] 0
ad7092b843 2019-09-16 196: } -match glob -result "$rootDir/*"
10f67b2ced 2019-09-16 197:
3d002d6892 2019-09-16 198: tcltest::test xvfs-glob-no-dir "Xvfs Glob Non-Existant Directory Test" -body {
3d002d6892 2019-09-16 199: glob_verify libx/*
3d002d6892 2019-09-16 200: } -returnCodes error -result "no such file or directory"
3d002d6892 2019-09-16 201:
3d002d6892 2019-09-16 202: tcltest::test xvfs-glob-pipes "Xvfs Glob Pipes Test " -body {
3d002d6892 2019-09-16 203: glob_verify -types {p b c s l} lib/*
3d002d6892 2019-09-16 204: } -result ""
3d002d6892 2019-09-16 205:
3d002d6892 2019-09-16 206: tcltest::test xvfs-glob-writable "Xvfs Glob Writable Test " -body {
3d002d6892 2019-09-16 207: glob -nocomplain -directory $rootDir -types w *
3d002d6892 2019-09-16 208: } -result ""
3d002d6892 2019-09-16 209:
3d002d6892 2019-09-16 210: tcltest::test xvfs-glob-hidden "Xvfs Glob Hidden Test " -body {
3d002d6892 2019-09-16 211: glob -nocomplain -directory $rootDir -types hidden *
3d002d6892 2019-09-16 212: } -result ""
3d002d6892 2019-09-16 213:
3d002d6892 2019-09-16 214: tcltest::test xvfs-glob-executable "Xvfs Glob Executable Test " -body {
3d002d6892 2019-09-16 215: glob -nocomplain -directory $rootDir -types x *
3d002d6892 2019-09-16 216: } -result $rootDir/lib
3d002d6892 2019-09-16 217:
10f67b2ced 2019-09-16 218: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
10f67b2ced 2019-09-16 219: file readable $testFile
10f67b2ced 2019-09-16 220: } -match boolean -result true
10f67b2ced 2019-09-16 221:
10f67b2ced 2019-09-16 222: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
10f67b2ced 2019-09-16 223: file writable $testFile
10f67b2ced 2019-09-16 224: } -match boolean -result false
10f67b2ced 2019-09-16 225:
10f67b2ced 2019-09-16 226: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
10f67b2ced 2019-09-16 227: file executable $testFile
3d002d6892 2019-09-16 228: } -match boolean -result false
3d002d6892 2019-09-16 229:
3d002d6892 2019-09-16 230: tcltest::test xvfs-access-similar-neg "Xvfs acccess Similar Negative Test" -body {
3d002d6892 2019-09-16 231: file executable ${rootDir}_DOES_NOT_EXIST
e786b9e07b 2019-09-16 232: } -match boolean -result false
e786b9e07b 2019-09-16 233:
10f67b2ced 2019-09-16 234: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
10f67b2ced 2019-09-16 235: file exists $rootDir/does-not-exist
10f67b2ced 2019-09-16 236: } -match boolean -result false
10f67b2ced 2019-09-16 237:
10f67b2ced 2019-09-16 238: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
10f67b2ced 2019-09-16 239: file stat $testFile fileInfo
10f67b2ced 2019-09-16 240: set fileInfo(type)
10f67b2ced 2019-09-16 241: } -cleanup {
10f67b2ced 2019-09-16 242: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 243: } -result file
e786b9e07b 2019-09-16 244:
e786b9e07b 2019-09-16 245: tcltest::test xvfs-stat-basic-file-neg "Xvfs stat Basic File Negative Test" -body {
e786b9e07b 2019-09-16 246: file stat $rootDir/does-not-exist fileInfo
e786b9e07b 2019-09-16 247: } -cleanup {
e786b9e07b 2019-09-16 248: unset -nocomplain fileInfo
e786b9e07b 2019-09-16 249: } -match glob -returnCodes error -result "*no such file or directory"
10f67b2ced 2019-09-16 250:
10f67b2ced 2019-09-16 251: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
10f67b2ced 2019-09-16 252: file stat $rootDir/lib fileInfo
10f67b2ced 2019-09-16 253: set fileInfo(type)
10f67b2ced 2019-09-16 254: } -cleanup {
10f67b2ced 2019-09-16 255: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 256: } -result directory
e4bde431db 2019-09-16 257:
ad7092b843 2019-09-16 258: # Broken in Tcl 8.6 and earlier
ad7092b843 2019-09-16 259: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
ad7092b843 2019-09-16 260: llength [glob //xvfs:/example/*]
ad7092b843 2019-09-16 261: } -constraints tcl87 -result 3
ad7092b843 2019-09-16 262:
ad7092b843 2019-09-16 263: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
ad7092b843 2019-09-16 264: lindex [glob -directory [file dirname $testFile] *] 0
ad7092b843 2019-09-16 265: } -constraints tcl87 -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 266:
ad7092b843 2019-09-16 267: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 268: set startDir [pwd]
ad7092b843 2019-09-16 269: } -body {
ad7092b843 2019-09-16 270: cd $rootDir
ad7092b843 2019-09-16 271: pwd
ad7092b843 2019-09-16 272: } -cleanup {
ad7092b843 2019-09-16 273: cd $startDir
ad7092b843 2019-09-16 274: unset startDir
e4bde431db 2019-09-16 275: } -constraints tcl87 -result $rootDir
ad7092b843 2019-09-16 276:
ad7092b843 2019-09-16 277: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 278: set startDir [pwd]
ad7092b843 2019-09-16 279: } -body {
ad7092b843 2019-09-16 280: cd $rootDir
ad7092b843 2019-09-16 281: cd lib
ad7092b843 2019-09-16 282: lindex [glob *] 0
ad7092b843 2019-09-16 283: } -cleanup {
ad7092b843 2019-09-16 284: cd $startDir
ad7092b843 2019-09-16 285: unset startDir
e4bde431db 2019-09-16 286: } -constraints tcl87 -result "hello"
ad7092b843 2019-09-16 287:
ad7092b843 2019-09-16 288: # Currently broken
ad7092b843 2019-09-16 289: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
ad7092b843 2019-09-16 290: set startAutoPath $auto_path
ad7092b843 2019-09-16 291: lappend auto_path ${rootDir}/lib
ad7092b843 2019-09-16 292: } -body {
ad7092b843 2019-09-16 293: package require hello
ad7092b843 2019-09-16 294: set auto_path
ad7092b843 2019-09-16 295: } -cleanup {
ad7092b843 2019-09-16 296: set auto_path $startAutoPath
ad7092b843 2019-09-16 297: unset startAutoPath
ad7092b843 2019-09-16 298: } -constraints knownBug -result ""
ad7092b843 2019-09-16 299:
ad7092b843 2019-09-16 300: # Output results
ad7092b843 2019-09-16 301: if {$::tcltest::numTests(Failed) != 0} {
ad7092b843 2019-09-16 302: set format "| %20s | %20s | %20s | %20s |"
ad7092b843 2019-09-16 303: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 304: puts [format $format "Passed" "Failed" "Skipped" "Total"]
ad7092b843 2019-09-16 305: puts [format $format \
ad7092b843 2019-09-16 306: $::tcltest::numTests(Passed) \
ad7092b843 2019-09-16 307: $::tcltest::numTests(Failed) \
ad7092b843 2019-09-16 308: $::tcltest::numTests(Skipped) \
ad7092b843 2019-09-16 309: $::tcltest::numTests(Total) \
ad7092b843 2019-09-16 310: ]
ad7092b843 2019-09-16 311: puts [string repeat - [string length [format $format - - - -]]]
ad7092b843 2019-09-16 312:
10f67b2ced 2019-09-16 313: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
10f67b2ced 2019-09-16 314: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
10f67b2ced 2019-09-16 315: }
ad7092b843 2019-09-16 316: exit 1
fa71466879 2019-09-14 317: }
38bed7cee0 2019-09-13 318:
38bed7cee0 2019-09-13 319: puts "ALL TESTS PASSED"
ad7092b843 2019-09-16 320:
10f67b2ced 2019-09-16 321: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
10f67b2ced 2019-09-16 322: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
10f67b2ced 2019-09-16 323: }
ad7092b843 2019-09-16 324: exit 0