From 9907054f8324beadc0c55b21bf95cb1a16bd8402 Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Fri, 28 Nov 2014 13:18:49 +1000
Subject: [PATCH] glob: bug fixes and Tcl compatibility
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

Fix the case where the pattern/filename contains a space
Respect the —tails option, but generate an error if -types is given.
Change the error message on no match to be Tcl-compatible

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 glob.tcl        | 32 ++++++++++++++++++++------------
 tests/glob.test |  6 +++---
 2 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/glob.tcl b/glob.tcl
index ea27fde..be341f4 100644
--- a/glob.tcl
+++ b/glob.tcl
@@ -11,7 +11,7 @@ package require readdir
 proc glob.globdir {dir pattern} {
 	if {[file exists $dir/$pattern]} {
 		# Simple case
-		return $pattern
+		return [list $pattern]
 	}
 
 	set result {}
@@ -35,6 +35,7 @@ proc glob.globdir {dir pattern} {
 # alternatives inside the given pattern, prepending the unprocessed
 # part of the pattern. Does _not_ handle escaped braces or commas.
 proc glob.explode {pattern} {
+	set orig $pattern
 	set oldexp {}
 	set newexp {""}
 
@@ -73,7 +74,7 @@ proc glob.explode {pattern} {
 	foreach old $oldexp {
 		lappend newexp $old$suf
 	}
-	linsert $newexp 0 $rest
+	list $rest {*}$newexp
 }
 
 # Core glob implementation. Returns a list of files/directories inside
@@ -120,6 +121,8 @@ proc glob.glob {base pattern} {
 proc glob {args} {
 	set nocomplain 0
 	set base ""
+	set tails 0
+	set complain ""
 
 	set n 0
 	foreach arg $args {
@@ -137,17 +140,16 @@ proc glob {args} {
 			-n* {
 				set nocomplain 1
 			}
-			-t* {
-				# Ignored for Tcl compatibility
-			}
-
-			-* {
-				return -code error "bad option \"$switch\": must be -directory, -nocomplain, -tails, or --"
+			-ta* {
+				set tails 1
 			}
 			-- {
 				incr n
 				break
 			}
+			-* {
+				return -code error "bad option \"$arg\": must be -directory, -nocomplain, -tails, or --"
+			}
 			*  {
 				break
 			}
@@ -165,10 +167,10 @@ proc glob {args} {
 
 	set result {}
 	foreach pattern $args {
-		set pattern [string map {
+		set escpattern [string map {
 			\\\\ \x01 \\\{ \x02 \\\} \x03 \\, \x04
 		} $pattern]
-		set patexps [lassign [glob.explode $pattern] rest]
+		set patexps [lassign [glob.explode $escpattern] rest]
 		if {$rest ne ""} {
 			return -code error "unmatched close brace in glob pattern"
 		}
@@ -177,13 +179,19 @@ proc glob {args} {
 				\x01 \\\\ \x02 \{ \x03 \} \x04 ,
 			} $patexp]
 			foreach {realname name} [glob.glob $base $patexp] {
-				lappend result $name
+				incr n
+				if {$tails} {
+					lappend result $name
+				} else {
+					lappend result [file join $base $name]
+				}
 			}
 		}
 	}
 
 	if {!$nocomplain && [llength $result] == 0} {
-		return -code error "no files matched glob patterns"
+		set s $(([llength $args] > 1) ? "s" : "")
+		return -code error "no files matched glob pattern$s \"[join $args]\""
 	}
 
 	return $result
diff --git a/tests/glob.test b/tests/glob.test
index 9bbdcd8..86c0dc8 100644
--- a/tests/glob.test
+++ b/tests/glob.test
@@ -90,7 +90,7 @@ test glob-1.2 {Simple} {
 
 test glob-1.3 {Simple} -returnCodes error -body {
 	lsort [glob x*]
-} -result {no files matched glob patterns}
+} -result {no files matched glob pattern "x*"}
 
 test glob-1.4 {Simple} -returnCodes error -body {
 	lsort [glob]
@@ -121,11 +121,11 @@ test glob-2.5 {Glob match files containing braced brackets} -returnCodes ok -bod
 } -result [list tmp/close\]bracket tmp/open\[bracket]
 
 test glob-3.1 {Directory option} -returnCodes ok -body {
-	lsort [glob -dir tmp *]
+	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 *close*]
+	lsort [glob -dir tmp -tails *close*]
 } -result [list close\]bracket close\}brace]
 
 testreport
-- 
2.11.4.GIT