summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2022-10-17 19:23:28 (GMT)
committerdgp <dgp@users.sourceforge.net>2022-10-17 19:23:28 (GMT)
commit51448d41677600e1a03ebfc365a2638118af2dfe (patch)
tree028acaf0a94ecdb68194b3fdcacba3497e734217
parentce85e0375acbe9d203e608d2265d7a5244c181d5 (diff)
parente245507505c8e6769c57470961dcbf80f6a93807 (diff)
downloadtcl-51448d41677600e1a03ebfc365a2638118af2dfe.zip
tcl-51448d41677600e1a03ebfc365a2638118af2dfe.tar.gz
tcl-51448d41677600e1a03ebfc365a2638118af2dfe.tar.bz2
Implementation of TIP 637.
-rw-r--r--doc/glob.n4
-rw-r--r--generic/tclFileName.c41
-rw-r--r--library/package.tcl3
-rw-r--r--tests/fCmd.test8
-rw-r--r--tests/fileName.test72
-rw-r--r--tests/winFile.test2
6 files changed, 50 insertions, 80 deletions
diff --git a/doc/glob.n b/doc/glob.n
index 8a3099e..80610f7 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -46,8 +46,8 @@ separators.
.TP
\fB\-nocomplain\fR
.
-Allows an empty list to be returned without error; without this
-switch an error is returned if the result list would be empty.
+Allows an empty list to be returned without error; This is the
+default behavior in Tcl 9.0, so this switch has no effect any more.
.TP
\fB\-path\fR \fIpathPrefix\fR
.
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 2628e41..040f0fd 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -41,7 +41,6 @@ static int TclGlob(Tcl_Interp *interp, char *pattern,
/* Flag values used by TclGlob() */
-#define TCL_GLOBMODE_NO_COMPLAIN 1
#define TCL_GLOBMODE_DIR 4
#define TCL_GLOBMODE_TAILS 8
@@ -1164,7 +1163,10 @@ Tcl_GlobObjCmd(
switch (index) {
case GLOB_NOCOMPLAIN: /* -nocomplain */
- globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
+ /*
+ * Do nothing; This is normal operations in Tcl 9.
+ * Keep accepting as a no-op option to accommodate old scripts.
+ */
break;
case GLOB_DIR: /* -dir */
if (i == (objc-1)) {
@@ -1522,41 +1524,6 @@ Tcl_GlobObjCmd(
}
}
- if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
- if (TclListObjLengthM(interp, Tcl_GetObjResult(interp),
- &length) != TCL_OK) {
- /*
- * This should never happen. Maybe we should be more dramatic.
- */
-
- result = TCL_ERROR;
- goto endOfGlob;
- }
-
- if (length == 0) {
- Tcl_Obj *errorMsg =
- Tcl_ObjPrintf("no files matched glob pattern%s \"",
- (join || (objc == 1)) ? "" : "s");
-
- if (join) {
- Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
- } else {
- const char *sep = "";
-
- for (i = 0; i < objc; i++) {
- Tcl_AppendPrintfToObj(errorMsg, "%s%s",
- sep, TclGetString(objv[i]));
- sep = " ";
- }
- }
- Tcl_AppendToObj(errorMsg, "\"", -1);
- Tcl_SetObjResult(interp, errorMsg);
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
- NULL);
- result = TCL_ERROR;
- }
- }
-
endOfGlob:
if (join || (dir == PATH_GENERAL)) {
Tcl_DStringFree(&prefix);
diff --git a/library/package.tcl b/library/package.tcl
index 5f0795f..0c4aa29 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -137,6 +137,9 @@ proc pkg_mkIndex {args} {
} on error {msg opt} {
return -options $opt $msg
}
+ if {[llength $fileList] == 0} {
+ return -code error "no files matched glob pattern \"$patternList\""
+ }
foreach file $fileList {
# For each file, figure out what commands and packages it provides.
# To do this, create a child interpreter, load the file into the
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 811beb3..93793d1 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -829,12 +829,12 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
} -result {bad option "-tf1": must be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
cleanup
-} -constraints {notRoot} -returnCodes error -body {
+} -constraints {notRoot} -body {
createfile --
createfile -force
file delete -force -force -- -- -force
glob -- -- -force
-} -result {no files matched glob patterns "-- -force"}
+} -result {}
test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-constraints {unix notRoot knownBug tildeexpansion} -body {
@@ -994,9 +994,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
testchmod 0o444 tf2
file rename tf1 [file join td1 tf3]
file rename tf2 [file join td1 tf4]
- list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
+ list [glob tf*] [lsort [glob -directory td1 t*]] \
[file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
} -constraints {notRoot testchmod} -body {
diff --git a/tests/fileName.test b/tests/fileName.test
index c4735cb..416c419 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -701,9 +701,9 @@ test filename-10.24 {Tcl_TranslateFileName} -body {
testtranslatefilename ~ouster/foo
} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
-test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
+test filename-11.1 {Tcl_GlobCmd} -body {
glob
-} -result {no files matched glob patterns ""}
+} -result {}
test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
glob -gorp
} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
@@ -717,19 +717,19 @@ test filename-11.5 {Tcl_GlobCmd} -body {
# Should not error out because of ~
catch {glob -nocomplain * ~xyqrszzz}
} -result 0
-test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
+test filename-11.6 {Tcl_GlobCmd} -body {
glob ~xyqrszzz
-} -result {no files matched glob pattern "~xyqrszzz"}
-test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
+} -result {}
+test filename-11.7 {Tcl_GlobCmd} -body {
glob -- -nocomplain
-} -result {no files matched glob pattern "-nocomplain"}
+} -result {}
test filename-11.8 {Tcl_GlobCmd} -body {
glob -nocomplain -- -nocomplain
} -result {}
test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob ~\\xyqrszzz/bar
-} -returnCodes error -result {no files matched glob pattern "~\xyqrszzz/bar"}
+} -result {}
test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob -nocomplain ~\\xyqrszzz/bar
@@ -737,22 +737,22 @@ test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
testsetplatform unix
glob ~xyqrszzz\\/\\bar
-} -returnCodes error -result {no files matched glob pattern "~xyqrszzz\/\bar"}
+} -result {}
test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup {
testsetplatform unix
set home $env(HOME)
} -body {
unset env(HOME)
glob ~/*
-} -returnCodes error -cleanup {
+} -cleanup {
set env(HOME) $home
-} -result {no files matched glob pattern "~/*"}
+} -result {}
if {[testConstraint testsetplatform]} {
testsetplatform $platform
}
test filename-11.13 {Tcl_GlobCmd} -body {
file join [lindex [glob ~] 0]
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
set oldpwd [pwd]
set oldhome $env(HOME)
catch {cd [makeDirectory tcl[pid]]}
@@ -772,10 +772,10 @@ touch globTest/.1
touch globTest/x,z1.c
test filename-11.14 {Tcl_GlobCmd} -body {
glob ~/globTest
-} -returnCodes error -result {no files matched glob pattern "~/globTest"}
+} -result {}
test filename-11.15 {Tcl_GlobCmd} -body {
glob ~\\/globTest
-} -returnCodes error -result {no files matched glob pattern "~\/globTest"}
+} -result {}
test filename-11.16 {Tcl_GlobCmd} {
glob globTest
} {globTest}
@@ -1098,42 +1098,42 @@ file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname
-test filename-12.1 {simple globbing} {unixOrWin} {
+test filename-12.1 {simple globbing} -constraints {unixOrWin} -body {
glob {}
-} {.}
+} -result {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body {
glob -types f {}
-} -returnCodes error -result {no files matched glob pattern ""}
-test filename-12.1.2 {simple globbing} {unixOrWin} {
+} -result {}
+test filename-12.1.2 {simple globbing} -constraints {unixOrWin} -body {
glob -types d {}
-} {.}
-test filename-12.1.3 {simple globbing} {unix} {
+} -result {.}
+test filename-12.1.3 {simple globbing} -constraints {unix} -body {
glob -types hidden {}
-} {.}
+} -result {.}
test filename-12.1.4 {simple globbing} -constraints {win} -body {
glob -types hidden {}
-} -returnCodes error -result {no files matched glob pattern ""}
+} -result {}
test filename-12.1.5 {simple globbing} -constraints {win} -body {
glob -types hidden c:/
-} -returnCodes error -result {no files matched glob pattern "c:/"}
-test filename-12.1.6 {simple globbing} {win} {
+} -result {}
+test filename-12.1.6 {simple globbing} -constraints {win} -body {
glob c:/
-} {c:/}
-test filename-12.3 {simple globbing} {
+} -result {c:/}
+test filename-12.3 {simple globbing} -body {
glob -nocomplain \{a1,a2\}
-} {}
+} -result {}
set globPreResult globTest/
set x1 x1.c
set y1 y1.c
-test filename-12.4 {simple globbing} {unixOrWin} {
+test filename-12.4 {simple globbing} -constraints {unixOrWin} -body {
lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
-} "$globPreResult$x1 $globPreResult$y1"
-test filename-12.5 {simple globbing} {
+} -result "$globPreResult$x1 $globPreResult$y1"
+test filename-12.5 {simple globbing} -body {
glob globTest\\/x1.c
-} "$globPreResult$x1"
-test filename-12.6 {simple globbing} {
+} -result "$globPreResult$x1"
+test filename-12.6 {simple globbing} -body {
glob globTest\\/\\x1.c
-} "$globPreResult$x1"
+} -result "$globPreResult$x1"
test filename-12.7 {globbing at filesystem root} -constraints {unix} -body {
list [glob -nocomplain /*] [glob -path / *]
} -match compareWords -result equal
@@ -1265,10 +1265,10 @@ test filename-14.20 {asterisks, question marks, and brackets} {
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
glob globTest/*/gorp
-} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
+} -result {}
test filename-14.22 {asterisks, question marks, and brackets} -body {
glob goo/* x*z foo?q
-} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
+} -result {}
test filename-14.23 {slash globbing} {unix} {
glob /
} /
@@ -1368,7 +1368,7 @@ test filename-15.5 {unix specific globbing} {unix nonPortable} {
# supported, the test was meaningless
test filename-15.7 {glob tilde} -body {
glob ~
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup {
global env
set temp $env(HOME)
@@ -1379,7 +1379,7 @@ test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -se
} -cleanup {
set env(HOME) $temp
catch {file delete -force $env(HOME)/globTest/anyname}
-} -returnCodes error -result {no files matched glob pattern "~"}
+} -result {}
# The following tests are only valid for Windows systems.
set oldDir [pwd]
diff --git a/tests/winFile.test b/tests/winFile.test
index 38f6954..231fb3f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -28,7 +28,7 @@ testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}]
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
glob ~nosuchuser
-} -returnCodes error -result {no files matched glob pattern "~nosuchuser"}
+} -result {}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
# The administrator account should always exist.
glob ~administrator