tests/glob.test

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