summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2012-11-30 16:10:20 (GMT)
committerdgp <dgp@users.sourceforge.net>2012-11-30 16:10:20 (GMT)
commitfa3bc4b41a79a1a27827362ae3a174b5bb85b3f2 (patch)
tree8bcfa6fea1ccdf1c10edbcd55a70269fa893739e
parent7e7cc4ff29c7c60467e3c3c61c861c2df30c5e78 (diff)
downloadtcl-fa3bc4b41a79a1a27827362ae3a174b5bb85b3f2.zip
tcl-fa3bc4b41a79a1a27827362ae3a174b5bb85b3f2.tar.gz
tcl-fa3bc4b41a79a1a27827362ae3a174b5bb85b3f2.tar.bz2
Stop [glob] complaining about empty list result. Continue support for
a no-op -nocomplain option, but don't document it. Old script support only.
-rw-r--r--doc/glob.n5
-rw-r--r--generic/tclFileName.c51
-rw-r--r--generic/tclInt.h13
-rw-r--r--library/package.tcl3
-rw-r--r--tests/fCmd.test8
-rw-r--r--tests/fileName.test14
6 files changed, 28 insertions, 66 deletions
diff --git a/doc/glob.n b/doc/glob.n
index 7b71189..11cd952 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -44,11 +44,6 @@ The remaining pattern arguments, after option processing, are treated
as a single pattern obtained by joining the arguments with directory
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.
-.TP
\fB\-path\fR \fIpathPrefix\fR
.
Search for files with the given \fIpathPrefix\fR where the rest of the name
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 5d4702b..a519f0e 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -37,6 +37,15 @@ static Tcl_Obj * SplitUnixPath(const char *path);
static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
const char *separators, Tcl_Obj *pathPtr, int flags,
char *pattern, Tcl_GlobTypeData *types);
+static int TclGlob(Tcl_Interp *interp, char *pattern,
+ Tcl_Obj *pathPrefix, int globFlags,
+ Tcl_GlobTypeData *types);
+
+/* Flag values used by TclGlob() */
+
+#define TCL_GLOBMODE_JOIN 2
+#define TCL_GLOBMODE_DIR 4
+#define TCL_GLOBMODE_TAILS 8
/*
* When there is no support for getting the block size of a file in a stat()
@@ -1270,7 +1279,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)) {
@@ -1620,41 +1632,6 @@ Tcl_GlobObjCmd(
}
}
- if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
- if (Tcl_ListObjLength(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, Tcl_GetString(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);
@@ -1705,7 +1682,7 @@ Tcl_GlobObjCmd(
*/
/* ARGSUSED */
-int
+static int
TclGlob(
Tcl_Interp *interp, /* Interpreter for returning error message or
* appending list of matching file names. */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d548a16..8110248 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2592,16 +2592,6 @@ typedef struct TclFileAttrProcs {
typedef struct TclFile_ *TclFile;
-/*
- * The "globParameters" argument of the function TclGlob is an or'ed
- * combination of the following values:
- */
-
-#define TCL_GLOBMODE_NO_COMPLAIN 1
-#define TCL_GLOBMODE_JOIN 2
-#define TCL_GLOBMODE_DIR 4
-#define TCL_GLOBMODE_TAILS 8
-
typedef enum Tcl_PathPart {
TCL_PATH_DIRNAME,
TCL_PATH_TAIL,
@@ -2982,9 +2972,6 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp,
int *binaryPtr);
MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
-MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
- Tcl_Obj *unquotedPrefix, int globFlags,
- Tcl_GlobTypeData *types);
MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
diff --git a/library/package.tcl b/library/package.tcl
index c30431c..5b99a69 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 325b374..9fae2c5 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -745,12 +745,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} -body {
@@ -938,9 +938,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
testchmod 444 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 51f00d1..2dac0df 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -696,9 +696,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 --}
@@ -714,9 +714,9 @@ test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {
test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
glob ~xyqrszzz
} -result {user "xyqrszzz" doesn't exist}
-test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
+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 {}
@@ -1085,7 +1085,7 @@ test filename-12.1 {simple globbing} {unixOrPc} {
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
glob -types f {}
-} -returnCodes error -result {no files matched glob pattern ""}
+} -result {}
test filename-12.1.2 {simple globbing} {unixOrPc} {
glob -types d {}
} {.}
@@ -1247,10 +1247,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 /
} /