| 12
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
 100
 101
 102
 103
 104
 105
 106
 107
 108
 109
 110
 111
 112
 113
 114
 115
 116
 117
 118
 119
 120
 121
 122
 123
 124
 125
 126
 127
 128
 129
 130
 131
 
 | # Test the glob command
source [file dirname [info script]]/testing.tcl
needs constraint jim
needs cmd glob
# Fake the bare minimum that glob.tcl needs:
# [readdir], [file isdir] and [file exists]
local proc file {cmd args} {
	if {$cmd in {isdir exists}} {
		lassign [fslookup [lindex $args 0]] type contents
		if {$cmd eq "isdir" && $type eq "dir"} {
			return 1
		} elseif {$type ne "none"} {
			return 1
		}
		return 0
	}
	tailcall upcall file $cmd {*}$args
}
local proc readdir {{-nocomplain {}} dir} {
	lassign [fslookup $dir] type contents
	if {$type ne "dir"} {
		if {${-nocomplain} eq ""} {
			return {}
		}
		return -code error "No such file or directory"
	}
	dict keys $contents
}
local proc fslookup {path} {
	set type dir
	set dict $::FAKEFS
	foreach p [split $path /] {
		if {$p in {. {}}} {
			continue
		}
		if {![dict exists $dict $p] || $type ne "dir"} {
			return none
		}
		lassign [dict get $dict $p] type dict
	}
	list $type $dict
}
# Creates the representation of a filesystem in a dictionary - for testing
local proc makefakefs {fs} {
	set fakefs {}
	foreach {type name contents} $fs {
		switch -glob -- $type {
			f* {
				set fakefs($name) [list file $contents]
			}
			d* {
				set fakefs($name) [list dir [makefakefs $contents]]
			}
			default {
				error "Unknown fs type: $type"
			}
		}
	}
	return $fakefs
}
# Create a fake filesystem for testing the glob command
set ::FAKEFS [makefakefs {
	file abc {This is the contents of abc}
	dir def {
		file ghi {This file is inside def}
		dir jkl
	}
	dir tmp {
		file "open{brace" {}
		file "close}brace" {}
		file "open\[bracket" {}
		file "close\]bracket" {}
	}
}]
test glob-1.1 {Simple} {
	lsort [glob *]
} {abc def tmp}
test glob-1.2 {Simple} {
	lsort [glob a*]
} {abc}
test glob-1.3 {Simple} -returnCodes error -body {
	lsort [glob x*]
} -result {no files matched glob pattern "x*"}
test glob-1.4 {Simple} -returnCodes error -body {
	lsort [glob]
} -result {wrong # args: should be "glob ?options? pattern ?pattern ...?"}
test glob-1.5 {Simple} -returnCodes ok -body {
	lsort [glob -nocomplain x*]
} -result {}
test glob-2.1 {Braces} -returnCodes ok -body {
	lsort [glob "{a,d}*"]
} -result {abc def}
test glob-2.2 {Files containing braces and brackets} -returnCodes ok -body {
	lsort [glob tmp/*]
} -result {tmp/close\]bracket tmp/close\}brace {tmp/open[bracket} tmp/open\{brace}
test glob-2.3 {Glob match files open bracket} -returnCodes ok -body {
	lsort [glob {tmp/*\[*}]
} -result [list tmp/open\[bracket]
test glob-2.4 {Glob match files close bracket} -returnCodes ok -body {
	lsort [glob {tmp/*\]*}]
} -result [list tmp/close\]bracket]
test glob-2.5 {Glob match files containing braced brackets} -returnCodes ok -body {
	lsort [glob {tmp/*{\[,]}*}]
} -result [list tmp/close\]bracket tmp/open\[bracket]
test glob-3.1 {Directory option} -returnCodes ok -body {
	lsort [glob -dir tmp -tails *]
} -result [list close\]bracket close\}brace open\[bracket open\{brace]
test glob-3.2 {Directory option} -returnCodes ok -body {
	lsort [glob -dir tmp -tails *close*]
} -result [list close\]bracket close\}brace]
testreport
 |