From fa3bc4b41a79a1a27827362ae3a174b5bb85b3f2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 30 Nov 2012 16:10:20 +0000 Subject: Stop [glob] complaining about empty list result. Continue support for a no-op -nocomplain option, but don't document it. Old script support only. --- doc/glob.n | 5 ----- generic/tclFileName.c | 51 ++++++++++++++------------------------------------- generic/tclInt.h | 13 ------------- library/package.tcl | 3 +++ tests/fCmd.test | 8 ++++---- tests/fileName.test | 14 +++++++------- 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 / } / -- cgit v0.12