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:
57c553f477 2019-09-18 10: if {![info exists ::env(XVFS_ROOT_MOUNTPOINT)]} {
2139fe19a8 2019-09-18 11: set xvfsRootMountpoint "//xvfs:/"
57c553f477 2019-09-18 12: } else {
57c553f477 2019-09-18 13: set xvfsRootMountpoint $::env(XVFS_ROOT_MOUNTPOINT)
57c553f477 2019-09-18 14: }
57c553f477 2019-09-18 15:
2139fe19a8 2019-09-18 16: set rootDir "${xvfsRootMountpoint}example"
ad7092b843 2019-09-16 17: set rootDirNative [file join [pwd] example]
ad7092b843 2019-09-16 18: #set rootDir $rootDirNative
ad7092b843 2019-09-16 19: set testFile "${rootDir}/foo"
ad7092b843 2019-09-16 20:
ad7092b843 2019-09-16 21: proc glob_verify {args} {
ad7092b843 2019-09-16 22: set rv [glob -nocomplain -directory $::rootDir {*}$args]
ad7092b843 2019-09-16 23: set verify [glob -nocomplain -directory $::rootDirNative {*}$args]
5583d77f1c 2019-09-14 24:
5583d77f1c 2019-09-14 25: if {[llength $rv] != [llength $verify]} {
5583d77f1c 2019-09-14 26: error "VERIFY FAILED: glob ... $args ($rv versus $verify)"
5583d77f1c 2019-09-14 27: }
5583d77f1c 2019-09-14 28:
5583d77f1c 2019-09-14 29: return $rv
e6735bc1dd 2019-09-17 30: }
e6735bc1dd 2019-09-17 31:
e6735bc1dd 2019-09-17 32: proc test_summary {} {
e6735bc1dd 2019-09-17 33: set format "| %7s | %7s | %7s | %7s |"
e6735bc1dd 2019-09-17 34: set emptyRow [format $format "" "" "" ""]
e6735bc1dd 2019-09-17 35: set emptyRowLength [string length $emptyRow]
e6735bc1dd 2019-09-17 36: lappend output "/[string repeat - [expr {$emptyRowLength - 2}]]\\"
e6735bc1dd 2019-09-17 37: lappend output [format $format "Passed" "Failed" "Skipped" "Total"]
e6735bc1dd 2019-09-17 38: lappend output [regsub -all -- " " [regsub -all -- " \\| " $emptyRow " + "] "-"]
e6735bc1dd 2019-09-17 39: lappend output [format $format \
e6735bc1dd 2019-09-17 40: $::tcltest::numTests(Passed) \
e6735bc1dd 2019-09-17 41: $::tcltest::numTests(Failed) \
e6735bc1dd 2019-09-17 42: $::tcltest::numTests(Skipped) \
e6735bc1dd 2019-09-17 43: $::tcltest::numTests(Total) \
e6735bc1dd 2019-09-17 44: ]
e6735bc1dd 2019-09-17 45: lappend output "\\[string repeat - [expr {$emptyRowLength - 2}]]/"
e6735bc1dd 2019-09-17 46:
e6735bc1dd 2019-09-17 47: return [join $output "\n"]
10f67b2ced 2019-09-16 48: }
10f67b2ced 2019-09-16 49:
ad7092b843 2019-09-16 50: tcltest::customMatch boolean [list apply {{expected actual} {
ad7092b843 2019-09-16 51: if {!!$expected == !!$actual} {
ad7092b843 2019-09-16 52: return true
ad7092b843 2019-09-16 53: } else {
ad7092b843 2019-09-16 54: return false
ad7092b843 2019-09-16 55: }
ad7092b843 2019-09-16 56: }}]
ad7092b843 2019-09-16 57:
10f67b2ced 2019-09-16 58: tcltest::test xvfs-seek-basic "Xvfs Seek Test" -setup {
ad7092b843 2019-09-16 59: set fd [open $testFile]
ad7092b843 2019-09-16 60: } -body {
ad7092b843 2019-09-16 61: seek $fd 0 end
ad7092b843 2019-09-16 62: seek $fd -1 current
ad7092b843 2019-09-16 63:
ad7092b843 2019-09-16 64: read $fd 1
ad7092b843 2019-09-16 65: } -cleanup {
ad7092b843 2019-09-16 66: close $fd
ad7092b843 2019-09-16 67: unset fd
ad7092b843 2019-09-16 68: } -result "\n"
10f67b2ced 2019-09-16 69:
10f67b2ced 2019-09-16 70: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
10f67b2ced 2019-09-16 71: set fd [open $testFile]
10f67b2ced 2019-09-16 72: } -body {
10f67b2ced 2019-09-16 73: seek $fd 1 end
10f67b2ced 2019-09-16 74: } -cleanup {
10f67b2ced 2019-09-16 75: close $fd
10f67b2ced 2019-09-16 76: unset fd
10f67b2ced 2019-09-16 77: } -match glob -returnCodes error -result "*: invalid argument"
10f67b2ced 2019-09-16 78:
10f67b2ced 2019-09-16 79: tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup {
10f67b2ced 2019-09-16 80: set fd [open $testFile]
10f67b2ced 2019-09-16 81: } -body {
10f67b2ced 2019-09-16 82: seek $fd -10 current
10f67b2ced 2019-09-16 83: } -cleanup {
10f67b2ced 2019-09-16 84: close $fd
10f67b2ced 2019-09-16 85: unset fd
10f67b2ced 2019-09-16 86: } -match glob -returnCodes error -result "*: invalid argument"
10f67b2ced 2019-09-16 87:
10f67b2ced 2019-09-16 88: tcltest::test xvfs-seek-read-past-eof "Xvfs Seek Then Read Past EOF Test" -setup {
10f67b2ced 2019-09-16 89: set fd [open $testFile]
10f67b2ced 2019-09-16 90: } -body {
10f67b2ced 2019-09-16 91: seek $fd 0 end
10f67b2ced 2019-09-16 92:
10f67b2ced 2019-09-16 93: read $fd 1
10f67b2ced 2019-09-16 94: read $fd 1
10f67b2ced 2019-09-16 95: } -cleanup {
10f67b2ced 2019-09-16 96: close $fd
10f67b2ced 2019-09-16 97: unset fd
10f67b2ced 2019-09-16 98: } -result ""
10f67b2ced 2019-09-16 99:
e786b9e07b 2019-09-16 100: tcltest::test xvfs-basic-open-neg "Xvfs Open Non-Existant File Test" -body {
e786b9e07b 2019-09-16 101: unset -nocomplain fd
e786b9e07b 2019-09-16 102: set fd [open $rootDir/does-not-exist]
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: } -returnCodes error -result "no such file or directory"
e786b9e07b 2019-09-16 109:
e786b9e07b 2019-09-16 110: tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -body {
10f67b2ced 2019-09-16 111: unset -nocomplain fd
10f67b2ced 2019-09-16 112: set fd [open $rootDir/new-file w]
10f67b2ced 2019-09-16 113: } -cleanup {
10f67b2ced 2019-09-16 114: if {[info exists fd]} {
10f67b2ced 2019-09-16 115: close $fd
10f67b2ced 2019-09-16 116: unset fd
10f67b2ced 2019-09-16 117: }
10f67b2ced 2019-09-16 118: catch {
10f67b2ced 2019-09-16 119: file delete $rootDir/new-file
10f67b2ced 2019-09-16 120: }
10f67b2ced 2019-09-16 121: } -match glob -returnCodes error -result "*read*only file*system*"
e786b9e07b 2019-09-16 122:
e786b9e07b 2019-09-16 123: tcltest::test xvfs-basic-open-directory "Xvfs Open Directory Test" -body {
e786b9e07b 2019-09-16 124: unset -nocomplain fd
e786b9e07b 2019-09-16 125: set fd [open $rootDir/lib]
e786b9e07b 2019-09-16 126: set fd
e786b9e07b 2019-09-16 127: } -cleanup {
e786b9e07b 2019-09-16 128: if {[info exists fd]} {
e786b9e07b 2019-09-16 129: close $fd
e786b9e07b 2019-09-16 130: unset fd
e786b9e07b 2019-09-16 131: }
e786b9e07b 2019-09-16 132: } -match glob -returnCodes error -result "*illegal operation on a directory"
ad7092b843 2019-09-16 133:
ad7092b843 2019-09-16 134: tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup {
ad7092b843 2019-09-16 135: set fd1 [open $testFile]
ad7092b843 2019-09-16 136: set fd2 [open $testFile]
ad7092b843 2019-09-16 137: } -body {
ad7092b843 2019-09-16 138: set data1 [read $fd1]
ad7092b843 2019-09-16 139: close $fd1
ad7092b843 2019-09-16 140: set data2 [read $fd2]
ad7092b843 2019-09-16 141: close $fd2
ad7092b843 2019-09-16 142:
ad7092b843 2019-09-16 143: expr {$data1 eq $data2}
ad7092b843 2019-09-16 144: } -cleanup {
ad7092b843 2019-09-16 145: unset -nocomplain fd1 fd2 data1 data2
ad7092b843 2019-09-16 146: } -match boolean -result true
ad7092b843 2019-09-16 147:
ad7092b843 2019-09-16 148: tcltest::test xvfs-events "Xvfs Fileevent Test" -setup {
ad7092b843 2019-09-16 149: set fd [open $testFile]
ad7092b843 2019-09-16 150: seek $fd 0 end
ad7092b843 2019-09-16 151: set size [tell $fd]
ad7092b843 2019-09-16 152: seek $fd 0 start
ad7092b843 2019-09-16 153:
ad7092b843 2019-09-16 154: set done false
ad7092b843 2019-09-16 155: set calls 0
ad7092b843 2019-09-16 156: set output ""
ad7092b843 2019-09-16 157: } -body {
ad7092b843 2019-09-16 158: fileevent $fd readable [list apply {{fd} {
ad7092b843 2019-09-16 159: set pos [tell $fd]
ad7092b843 2019-09-16 160: set x [read $fd 1]
ad7092b843 2019-09-16 161: if {[string length $x] == 0} {
ad7092b843 2019-09-16 162: set ::done true
ad7092b843 2019-09-16 163: fileevent $fd readable ""
ad7092b843 2019-09-16 164: }
ad7092b843 2019-09-16 165:
ad7092b843 2019-09-16 166: lappend ::output $pos
ad7092b843 2019-09-16 167: incr ::calls
ad7092b843 2019-09-16 168: }} $fd]
ad7092b843 2019-09-16 169: vwait done
ad7092b843 2019-09-16 170:
ad7092b843 2019-09-16 171: list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}]
ad7092b843 2019-09-16 172: } -cleanup {
ad7092b843 2019-09-16 173: close $fd
10f67b2ced 2019-09-16 174: update
ad7092b843 2019-09-16 175: unset -nocomplain fd size done calls output
ad7092b843 2019-09-16 176: } -result {1 1}
10f67b2ced 2019-09-16 177:
10f67b2ced 2019-09-16 178: tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body {
10f67b2ced 2019-09-16 179: file exists ${rootDir}_DOES_NOT_EXIST
10f67b2ced 2019-09-16 180: } -match boolean -result false
ad7092b843 2019-09-16 181:
ad7092b843 2019-09-16 182: tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body {
ad7092b843 2019-09-16 183: llength [glob_verify *]
ad7092b843 2019-09-16 184: } -result 3
10f67b2ced 2019-09-16 185:
3d002d6892 2019-09-16 186: tcltest::test xvfs-glob-files-any "Xvfs Glob Match Any File Test" -body {
3d002d6892 2019-09-16 187: llength [glob_verify -type f *]
3d002d6892 2019-09-16 188: } -result 2
3d002d6892 2019-09-16 189:
3d002d6892 2019-09-16 190: tcltest::test xvfs-glob-dir-any "Xvfs Glob On a File Test" -body {
3d002d6892 2019-09-16 191: glob -nocomplain -directory $testFile *
3d002d6892 2019-09-16 192: } -returnCodes error -result "not a directory"
3d002d6892 2019-09-16 193:
ad7092b843 2019-09-16 194: tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body {
ad7092b843 2019-09-16 195: llength [glob_verify f*]
ad7092b843 2019-09-16 196: } -result 1
ad7092b843 2019-09-16 197:
ad7092b843 2019-09-16 198: tcltest::test xvfs-glob-basic-limited-neg "Xvfs Glob Match Limited Negative Test" -body {
ad7092b843 2019-09-16 199: llength [glob_verify x*]
ad7092b843 2019-09-16 200: } -result 0
ad7092b843 2019-09-16 201:
ad7092b843 2019-09-16 202: tcltest::test xvfs-glob-basic-limited-prefixed "Xvfs Glob Match Limited But With Directory Prefix Test" -body {
ad7092b843 2019-09-16 203: llength [glob_verify ./f*]
ad7092b843 2019-09-16 204: } -result 1
ad7092b843 2019-09-16 205:
ad7092b843 2019-09-16 206: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed "Xvfs Glob Match Limited Path and Type Positive Test" -body {
ad7092b843 2019-09-16 207: llength [glob_verify -type f ./f*]
ad7092b843 2019-09-16 208: } -result 1
ad7092b843 2019-09-16 209:
ad7092b843 2019-09-16 210: tcltest::test xvfs-glob-basic-limited-and-typed-prefixed-neg "Xvfs Glob Match Limited Path and Type Negative Test" -body {
ad7092b843 2019-09-16 211: llength [glob_verify -type d ./f*]
ad7092b843 2019-09-16 212: } -result 0
ad7092b843 2019-09-16 213:
ad7092b843 2019-09-16 214: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body {
ad7092b843 2019-09-16 215: llength [glob_verify lib/*]
ad7092b843 2019-09-16 216: } -result 1
ad7092b843 2019-09-16 217:
ad7092b843 2019-09-16 218: tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body {
ad7092b843 2019-09-16 219: lindex [glob_verify lib/*] 0
ad7092b843 2019-09-16 220: } -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 221:
3d002d6892 2019-09-16 222: tcltest::test xvfs-glob-no-dir "Xvfs Glob Non-Existant Directory Test" -body {
3d002d6892 2019-09-16 223: glob_verify libx/*
3d002d6892 2019-09-16 224: } -returnCodes error -result "no such file or directory"
3d002d6892 2019-09-16 225:
3d002d6892 2019-09-16 226: tcltest::test xvfs-glob-pipes "Xvfs Glob Pipes Test " -body {
3d002d6892 2019-09-16 227: glob_verify -types {p b c s l} lib/*
3d002d6892 2019-09-16 228: } -result ""
3d002d6892 2019-09-16 229:
3d002d6892 2019-09-16 230: tcltest::test xvfs-glob-writable "Xvfs Glob Writable Test " -body {
3d002d6892 2019-09-16 231: glob -nocomplain -directory $rootDir -types w *
3d002d6892 2019-09-16 232: } -result ""
3d002d6892 2019-09-16 233:
3d002d6892 2019-09-16 234: tcltest::test xvfs-glob-hidden "Xvfs Glob Hidden Test " -body {
3d002d6892 2019-09-16 235: glob -nocomplain -directory $rootDir -types hidden *
3d002d6892 2019-09-16 236: } -result ""
3d002d6892 2019-09-16 237:
3d002d6892 2019-09-16 238: tcltest::test xvfs-glob-executable "Xvfs Glob Executable Test " -body {
3d002d6892 2019-09-16 239: glob -nocomplain -directory $rootDir -types x *
3d002d6892 2019-09-16 240: } -result $rootDir/lib
3d002d6892 2019-09-16 241:
10f67b2ced 2019-09-16 242: tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body {
10f67b2ced 2019-09-16 243: file readable $testFile
10f67b2ced 2019-09-16 244: } -match boolean -result true
10f67b2ced 2019-09-16 245:
10f67b2ced 2019-09-16 246: tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body {
10f67b2ced 2019-09-16 247: file writable $testFile
10f67b2ced 2019-09-16 248: } -match boolean -result false
10f67b2ced 2019-09-16 249:
10f67b2ced 2019-09-16 250: tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body {
10f67b2ced 2019-09-16 251: file executable $testFile
3d002d6892 2019-09-16 252: } -match boolean -result false
3d002d6892 2019-09-16 253:
3d002d6892 2019-09-16 254: tcltest::test xvfs-access-similar-neg "Xvfs acccess Similar Negative Test" -body {
3d002d6892 2019-09-16 255: file executable ${rootDir}_DOES_NOT_EXIST
10f67b2ced 2019-09-16 256: } -match boolean -result false
10f67b2ced 2019-09-16 257:
10f67b2ced 2019-09-16 258: tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body {
10f67b2ced 2019-09-16 259: file exists $rootDir/does-not-exist
10f67b2ced 2019-09-16 260: } -match boolean -result false
10f67b2ced 2019-09-16 261:
10f67b2ced 2019-09-16 262: tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body {
10f67b2ced 2019-09-16 263: file stat $testFile fileInfo
10f67b2ced 2019-09-16 264: set fileInfo(type)
10f67b2ced 2019-09-16 265: } -cleanup {
10f67b2ced 2019-09-16 266: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 267: } -result file
10f67b2ced 2019-09-16 268:
e786b9e07b 2019-09-16 269: tcltest::test xvfs-stat-basic-file-neg "Xvfs stat Basic File Negative Test" -body {
e786b9e07b 2019-09-16 270: file stat $rootDir/does-not-exist fileInfo
e786b9e07b 2019-09-16 271: } -cleanup {
e786b9e07b 2019-09-16 272: unset -nocomplain fileInfo
e786b9e07b 2019-09-16 273: } -match glob -returnCodes error -result "*no such file or directory"
e786b9e07b 2019-09-16 274:
10f67b2ced 2019-09-16 275: tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body {
10f67b2ced 2019-09-16 276: file stat $rootDir/lib fileInfo
10f67b2ced 2019-09-16 277: set fileInfo(type)
10f67b2ced 2019-09-16 278: } -cleanup {
10f67b2ced 2019-09-16 279: unset -nocomplain fileInfo
10f67b2ced 2019-09-16 280: } -result directory
10f67b2ced 2019-09-16 281:
ad7092b843 2019-09-16 282: # Broken in Tcl 8.6 and earlier
ad7092b843 2019-09-16 283: tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body {
57c553f477 2019-09-18 284: llength [glob ${rootDir}/*]
ad7092b843 2019-09-16 285: } -constraints tcl87 -result 3
ad7092b843 2019-09-16 286:
ad7092b843 2019-09-16 287: tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body {
ad7092b843 2019-09-16 288: lindex [glob -directory [file dirname $testFile] *] 0
ad7092b843 2019-09-16 289: } -constraints tcl87 -match glob -result "$rootDir/*"
ad7092b843 2019-09-16 290:
ad7092b843 2019-09-16 291: tcltest::test xvfs-cwd-1 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 292: set startDir [pwd]
ad7092b843 2019-09-16 293: } -body {
ad7092b843 2019-09-16 294: cd $rootDir
ad7092b843 2019-09-16 295: pwd
ad7092b843 2019-09-16 296: } -cleanup {
ad7092b843 2019-09-16 297: cd $startDir
ad7092b843 2019-09-16 298: unset startDir
e4bde431db 2019-09-16 299: } -constraints tcl87 -result $rootDir
ad7092b843 2019-09-16 300:
ad7092b843 2019-09-16 301: tcltest::test xvfs-cwd-2 "Xvfs Can Be cwd" -setup {
ad7092b843 2019-09-16 302: set startDir [pwd]
ad7092b843 2019-09-16 303: } -body {
ad7092b843 2019-09-16 304: cd $rootDir
ad7092b843 2019-09-16 305: cd lib
ad7092b843 2019-09-16 306: lindex [glob *] 0
ad7092b843 2019-09-16 307: } -cleanup {
ad7092b843 2019-09-16 308: cd $startDir
ad7092b843 2019-09-16 309: unset startDir
e4bde431db 2019-09-16 310: } -constraints tcl87 -result "hello"
ad7092b843 2019-09-16 311:
ad7092b843 2019-09-16 312: # Currently broken
ad7092b843 2019-09-16 313: tcltest::test xvfs-package "Xvfs Can Be Package Directory" -setup {
ad7092b843 2019-09-16 314: set startAutoPath $auto_path
ad7092b843 2019-09-16 315: lappend auto_path ${rootDir}/lib
ad7092b843 2019-09-16 316: } -body {
ad7092b843 2019-09-16 317: package require hello
ad7092b843 2019-09-16 318: set auto_path
ad7092b843 2019-09-16 319: } -cleanup {
ad7092b843 2019-09-16 320: set auto_path $startAutoPath
ad7092b843 2019-09-16 321: unset startAutoPath
ad7092b843 2019-09-16 322: } -constraints knownBug -result ""
ad7092b843 2019-09-16 323:
ad7092b843 2019-09-16 324: # Output results
ad7092b843 2019-09-16 325: if {$::tcltest::numTests(Failed) != 0} {
e6735bc1dd 2019-09-17 326: puts [test_summary]
10f67b2ced 2019-09-16 327: if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} {
10f67b2ced 2019-09-16 328: exit $::env(XVFS_TEST_EXIT_ON_FAILURE)
10f67b2ced 2019-09-16 329: }
ad7092b843 2019-09-16 330: exit 1
ad7092b843 2019-09-16 331: }
ad7092b843 2019-09-16 332:
e6735bc1dd 2019-09-17 333: puts [test_summary]
5583d77f1c 2019-09-14 334: puts "ALL TESTS PASSED"
ad7092b843 2019-09-16 335:
10f67b2ced 2019-09-16 336: if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} {
10f67b2ced 2019-09-16 337: exit $::env(XVFS_TEST_EXIT_ON_SUCCESS)
10f67b2ced 2019-09-16 338: }
ad7092b843 2019-09-16 339: exit 0