Annotation For example/main.tcl

Lines of example/main.tcl from check-in 2139fe19a8 that are changed by the sequence of edits moving toward check-in b502b175ea:

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