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