diff options
author | dgp <dgp@users.sourceforge.net> | 2022-10-17 19:23:28 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2022-10-17 19:23:28 (GMT) |
commit | 51448d41677600e1a03ebfc365a2638118af2dfe (patch) | |
tree | 028acaf0a94ecdb68194b3fdcacba3497e734217 | |
parent | ce85e0375acbe9d203e608d2265d7a5244c181d5 (diff) | |
parent | e245507505c8e6769c57470961dcbf80f6a93807 (diff) | |
download | tcl-51448d41677600e1a03ebfc365a2638118af2dfe.zip tcl-51448d41677600e1a03ebfc365a2638118af2dfe.tar.gz tcl-51448d41677600e1a03ebfc365a2638118af2dfe.tar.bz2 |
Implementation of TIP 637.
-rw-r--r-- | doc/glob.n | 4 | ||||
-rw-r--r-- | generic/tclFileName.c | 41 | ||||
-rw-r--r-- | library/package.tcl | 3 | ||||
-rw-r--r-- | tests/fCmd.test | 8 | ||||
-rw-r--r-- | tests/fileName.test | 72 | ||||
-rw-r--r-- | tests/winFile.test | 2 |
6 files changed, 50 insertions, 80 deletions
@@ -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 |