diff options
| -rw-r--r-- | doc/info.n | 5 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 39 | ||||
| -rw-r--r-- | generic/tclPkgConfig.c | 2 | ||||
| -rw-r--r-- | tests/config.test | 2 | ||||
| -rw-r--r-- | tests/info.test | 8 |
5 files changed, 49 insertions, 7 deletions
@@ -353,6 +353,11 @@ the global namespace if \fIpattern\fR starts with \fB::\fR) to match within; the matching pattern is taken to be the part after the last namespace separator. .TP +\fBinfo runtime\fR +. +Returns the string "core". It can be used to distingush the Tcl "core" +runtime from other runtimes like TH1 or Eagle. +.TP \fBinfo script\fR ?\fIfilename\fR? . If a Tcl script file is currently being evaluated (i.e. there is a diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 739dca9..e5378f0 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -142,6 +142,8 @@ static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int InfoRuntimeCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, @@ -181,6 +183,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"runtime", InfoRuntimeCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, @@ -2004,6 +2007,42 @@ InfoProcsCmd( /* *---------------------------------------------------------------------- * + * InfoRuntimeCmd -- + * + * Called to implement the "info runtime" command that returns the + * runtime. For the Tcl Core implementation, it always returns "core". + * Handles the following syntax: + * + * info runtime + * + * Results: + * Returns TCL_OK. + * + * Side effects: + * Returns a result ("core") in the interpreter's result object. + * + *---------------------------------------------------------------------- + */ + +static int +InfoRuntimeCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewStringObj("core", -1)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * InfoScriptCmd -- * * Called to implement the "info script" command that returns the script diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c index 4b86af3..466d535 100644 --- a/generic/tclPkgConfig.c +++ b/generic/tclPkgConfig.c @@ -114,8 +114,6 @@ static Tcl_Config const cfg[] = { {"includedir,install", CFG_INSTALL_INCDIR}, {"docdir,install", CFG_INSTALL_DOCDIR}, - {"origin", "core"}, - /* Last entry, closes the array */ {NULL, NULL} }; diff --git a/tests/config.test b/tests/config.test index 4432e73..d14837e 100644 --- a/tests/config.test +++ b/tests/config.test @@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} { test pkgconfig-1.1 {query keys} { lsort [::tcl::pkgconfig list] -} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized origin profiled scriptdir,install scriptdir,runtime threaded} +} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded} test pkgconfig-1.2 {query keys multiple times} { string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list] } 0 diff --git a/tests/info.test b/tests/info.test index 3057dd2..0025de0 100644 --- a/tests/info.test +++ b/tests/info.test @@ -678,16 +678,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body { } -result {wrong # args: should be "info subcommand ?arg ...?"} test info-21.2 {miscellaneous error conditions} -returnCodes error -body { info gorp -} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, runtime, script, sharedlibextension, tclversion, or vars} test info-21.3 {miscellaneous error conditions} -returnCodes error -body { info c -} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, runtime, script, sharedlibextension, tclversion, or vars} test info-21.4 {miscellaneous error conditions} -returnCodes error -body { info l -} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, runtime, script, sharedlibextension, tclversion, or vars} test info-21.5 {miscellaneous error conditions} -returnCodes error -body { info s -} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars} +} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, runtime, script, sharedlibextension, tclversion, or vars} ## # ### ### ### ######### ######### ######### |