Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-284 Excluding Merge-Ins
This is equivalent to a diff from 7bcb41aa5e to 210c48ba31
2019-05-28
| ||
21:42 | Merge 8.6 check-in: f70e8b4830 user: jan.nijtmans tags: core-8-branch | |
2019-05-26
| ||
21:03 | tests for [invoke] and [namespace invoke] Leaf check-in: 210c48ba31 user: dkf tags: tip-284 | |
15:36 | Added docs check-in: 42e7c8ef38 user: dkf tags: tip-284 | |
12:11 | Import of old TIP 284 patch, and update for current Tcl check-in: 1832e6f878 user: dkf tags: tip-284 | |
07:19 | merge 8.7 check-in: 494534d018 user: dkf tags: tip-480 | |
2019-05-25
| ||
08:17 | Merge 8.7 check-in: dd82009b2c user: dkf tags: trunk | |
08:06 | TIP 383: [coroinject] and [coroprobe] check-in: 7bcb41aa5e user: dkf tags: core-8-branch | |
08:01 | Add to error info when passing an error out of [coroprobe] Closed-Leaf check-in: de44589e23 user: dkf tags: tip-383 | |
07:46 | Implement TIP 431: [file tempdir] check-in: 974c5d161d user: dkf tags: core-8-branch | |
Added doc/invoke.n.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1997 Sun Microsystems, Inc. '\" Copyright (c) 2019 Donal K Fellows. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH invoke n 8.7 Tcl "Tcl Built-In Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME invoke \- Execute a command in a different stack frame .SH SYNOPSIS \fBinvoke \fIlevel command \fR?\fIarg ...\fR? .BE .SH DESCRIPTION .PP The \fBinvoke\fR command concatenates \fIcommand\fR with all of the \fIarg\fR arguments as if they had been passed to \fBlist\fR; it then evaluates the result in the variable context indicated by \fIlevel\fR. \fBInvoke\fR returns the result of that evaluation. .PP If \fIlevel\fR is an integer then it gives a distance (up the procedure calling stack) to move before executing the command. If \fIlevel\fR consists of \fB#\fR followed by a integer then the level gives an absolute level. .PP For example, suppose that procedure \fBa\fR was invoked from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR. Suppose that \fBc\fR invokes the \fBinvoke\fR command. If \fIlevel\fR is \fB1\fR or \fB#2\fR, then the command will be executed in the variable context of \fBb\fR. If \fIlevel\fR is \fB2\fR or \fB#1\fR then the command will be executed in the variable context of \fBa\fR. If \fIlevel\fR is \fB3\fR or \fB#0\fR then the command will be executed at top-level (only global variables will be visible). .PP The \fBinvoke\fR command causes the invoking procedure to disappear from the procedure calling stack while the command is being executed. In the above example, suppose \fBc\fR invokes the command .PP .CS \fBinvoke\fR 1 set x "some arbitrary string" .CE .PP where \fBd\fR is another Tcl procedure. The \fBset\fR command will modify the variable \fBx\fR in \fBb\fR's context, at level 3, as if called from \fBb\fR: the procedure \fBc\fR does not appear to be on the call stack when the \fBset\fR is executing. The \fBinfo level\fR command may be used to obtain the level of the current procedure. .PP \fBInvoke\fR makes it possible to implement new control constructs as Tcl procedures, and is useful in situations where the caller of \fBinvoke\fR is in control of the arguments (unlike with \fBuplevel\fR which is more suitable for calling a script provided by the caller of the procedure). .PP The \fBnamespace eval\fR and \fBapply\fR commands and TclOO methods offer other ways (besides procedure calls) that the Tcl naming context can change. They add a call frame to the stack to represent the namespace context. This means each \fBnamespace eval\fR command counts as another call level for \fBinvoke\fR and \fBupvar\fR commands. For example, \fBinfo level 1\fR will return a list describing a command that is either the outermost procedure call or the outermost \fBnamespace eval\fR command. Also, \fBinvoke #0\fR evaluates a command at top-level in the outermost namespace (the global namespace). .SH EXAMPLE As stated above, the \fBinvoke\fR command is useful for creating new control constructs. This example shows how (ignoring \fBupvar\fRed variables and arrays) it can be used to create a \fIlambda\fR command that creates a lambda term (using \fBapply\fR) that can be in the same namespace context as the caller of \fBlambda\fR with a copy (effectively read-only) of the local variables in the stack frame it was called from, for effectively lexically-scoped variables: .PP .CS proc \fIlambda\fR {args body} { set locals [\fBinvoke\fR 1 info locals] set arguments [list {*}$locals {*}$args] set ns [\fBinvoke\fR 1 namespace current] set values [lmap var $locals {\fBinvoke\fR 1 set $var}] return [list apply [list $arguments $body $ns] {*}$values] } \fI# Demonstrating it in use\fR namespace eval foo { variable b {} proc bar {x y} { set z [expr {$x + $y}] return [\fIlambda\fR a { variable b lappend b $a return $x,$y,$z,$a,[join $b "|"] }] } } set with23 [foo::bar 2 3] puts [{*}$with23 "demo"] \fI# ==> 2,3,5,demo,demo\fR puts [{*}$with23 "again"] \fI# ==> 2,3,5,again,demo|again\fR set with45 [foo::bar 4 5] puts [{*}$with45 "more"] \fI# ==> 4,5,9,more,demo|again|more\fR puts [{*}$with23 "again"] \fI# ==> 2,3,5,again,demo|again|more|again\fR .CE .SH "SEE ALSO" apply(n), namespace(n), uplevel(n), upvar(n) .SH KEYWORDS context, level, namespace, stack frame, variable .\" Local Variables: .\" mode: nroff .\" End: |
Changes to doc/namespace.n.
︙ | ︙ | |||
201 202 203 204 205 206 207 208 209 210 211 212 213 214 | that is, only requested commands that are currently defined in the exporting namespace are imported. In other words, you can import only the commands that are in a namespace at the time when the \fBnamespace import\fR command is executed. If another command is defined and exported in this namespace later on, it will not be imported. .RE .TP \fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR? . Executes a script in the context of the specified \fInamespace\fR. This command is not expected to be used directly by programmers; calls to it are generated implicitly when applications use \fBnamespace code\fR commands to create callback scripts | > > > > > > > > > | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 | that is, only requested commands that are currently defined in the exporting namespace are imported. In other words, you can import only the commands that are in a namespace at the time when the \fBnamespace import\fR command is executed. If another command is defined and exported in this namespace later on, it will not be imported. .RE .TP \fBnamespace invoke\fR \fInamespace cmd\fR ?\fIarg ...\fR? .VS "TIP 284" Invokes the command called \fIcmd\fR, as resolved from namespace \fInamespace\fR, with the supplied arguments; the command is invoked in the scope of the caller of \fBnamespace invoke\fR, so there are no intervening stack frames. If \fInamespace\fR does not exist, the command returns an error. .VE "TIP 284" .TP \fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR? . Executes a script in the context of the specified \fInamespace\fR. This command is not expected to be used directly by programmers; calls to it are generated implicitly when applications use \fBnamespace code\fR commands to create callback scripts |
︙ | ︙ |
Changes to doc/uplevel.n.
︙ | ︙ | |||
91 92 93 94 95 96 97 | if {![\fBuplevel\fR 1 $conditionCmd]} { break } } } .CE .SH "SEE ALSO" | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 | if {![\fBuplevel\fR 1 $conditionCmd]} { break } } } .CE .SH "SEE ALSO" apply(n), invoke(n), namespace(n), upvar(n) .SH KEYWORDS context, level, namespace, stack frame, variable .\" Local Variables: .\" mode: nroff .\" End: |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
255 256 257 258 259 260 261 262 263 264 265 266 267 268 | {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, | > | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 | {"expr", Tcl_ExprObjCmd, TclCompileExprCmd, TclNRExprObjCmd, CMD_IS_SAFE}, {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, {"invoke", Tcl_InvokeObjCmd, NULL, TclNRInvokeObjCmd, CMD_IS_SAFE}, {"join", Tcl_JoinObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 | MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; | > | 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 | MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvokeObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd; |
︙ | ︙ | |||
3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 | Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); | > > > | 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 | Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_IncrObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_InvokeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_JoinObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LappendObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); |
︙ | ︙ |
Changes to generic/tclNamesp.c.
︙ | ︙ | |||
109 110 111 112 113 114 115 116 117 118 119 120 121 122 | static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void NamespaceFree(Namespace *nsPtr); static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceInscopeCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NRNamespaceInscopeCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp, | > > > > | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | static int NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void NamespaceFree(Namespace *nsPtr); static int NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceInvokeCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NRNamespaceInvokeCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceInscopeCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NRNamespaceInscopeCmd(ClientData dummy, Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]); static int NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static int NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp, |
︙ | ︙ | |||
181 182 183 184 185 186 187 188 189 190 191 192 193 194 | {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0}, {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0}, {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, | > | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | {"delete", NamespaceDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"ensemble", TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0}, {"eval", NamespaceEvalCmd, NULL, NRNamespaceEvalCmd, NULL, 0}, {"exists", NamespaceExistsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"export", NamespaceExportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"invoke", NamespaceInvokeCmd, TclCompileBasicMin2ArgCmd, NRNamespaceInvokeCmd, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, {"tail", NamespaceTailCmd, TclCompileNamespaceTailCmd, NULL, NULL, 0}, {"unknown", NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, |
︙ | ︙ | |||
3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 | result = Tcl_Import(interp, NULL, pattern, allowOverwrite); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceInscopeCmd -- * * Invoked to implement the "namespace inscope" command that executes a | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 3776 3777 3778 3779 3780 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 3845 3846 3847 3848 3849 3850 3851 3852 3853 3854 3855 3856 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 | result = Tcl_Import(interp, NULL, pattern, allowOverwrite); if (result != TCL_OK) { return result; } } return TCL_OK; } /* *---------------------------------------------------------------------- * * NamespaceInvokeCmd -- * * Invoked to implement the "namespace invoke" command that invokes a * command in a predefined namespace. Handles the syntax: * * namespace invoke ns cmd ?arg1? ?arg2? ... * * This invokes the command cmd, as resolved from namespace ns, with the * supplied arguments. It is similar to: * * namespace eval ns [list cmd ?arg1? ?arg2? ...] * * up to the fact that it executes in the caller's context: it does *not* * push a new CallFrame. * * Results: * Returns TCL_OK if the namespace is found and the command is executed * successfully. Returns TCL_ERROR if anything goes wrong. * * Side effects: * Returns the result of the command in the interpreter's result object. * If anything goes wrong, this function returns an error message as the * result. * *---------------------------------------------------------------------- */ static int NamespaceInvokeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Namespace *namespacePtr; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg...?"); return TCL_ERROR; } /* * Try to resolve the namespace reference, caching the result in the * namespace object along the way. If the namespace is not found, return * an error. */ result = TclGetNamespaceFromObj(interp, objv[1], &namespacePtr); if (result != TCL_OK) { return result; } if (namespacePtr == NULL) { Tcl_AppendResult(interp, "unknown namespace \"", Tcl_GetString(objv[1]), "\"", NULL); return TCL_ERROR; } /* * Invoke the command in the requested namespace */ iPtr->lookupNsPtr = (Namespace *) namespacePtr; return Tcl_EvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE); } static int NRNamespaceInvokeCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; Tcl_Namespace *namespacePtr; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg...?"); return TCL_ERROR; } /* * Try to resolve the namespace reference, caching the result in the * namespace object along the way. If the namespace is not found, return * an error. */ result = TclGetNamespaceFromObj(interp, objv[1], &namespacePtr); if (result != TCL_OK) { return result; } if (namespacePtr == NULL) { Tcl_AppendResult(interp, "unknown namespace \"", Tcl_GetString(objv[1]), "\"", NULL); return TCL_ERROR; } /* * Invoke the command in the requested namespace */ iPtr->lookupNsPtr = (Namespace *) namespacePtr; return TclNREvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE, NULL); } /* *---------------------------------------------------------------------- * * NamespaceInscopeCmd -- * * Invoked to implement the "namespace inscope" command that executes a |
︙ | ︙ |
Changes to generic/tclProc.c.
︙ | ︙ | |||
714 715 716 717 718 719 720 | int TclGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ const char *name, /* String describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { | | | | | | | | | | 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 | int TclGetFrame( Tcl_Interp *interp, /* Interpreter in which to find frame. */ const char *name, /* String describing frame. */ CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if * global frame indicated). */ { int result; Tcl_Obj obj; obj.bytes = (char *) name; obj.length = strlen(name); obj.typePtr = NULL; result = TclObjGetFrame(interp, &obj, framePtrPtr); TclFreeIntRep(&obj); return result; } /* *---------------------------------------------------------------------- * * TclObjGetFrame -- * |
︙ | ︙ | |||
861 862 863 864 865 866 867 868 869 870 | static int Uplevel_Callback( ClientData data[], Tcl_Interp *interp, int result) { CallFrame *savedVarFramePtr = data[0]; if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( | > > | | 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 | static int Uplevel_Callback( ClientData data[], Tcl_Interp *interp, int result) { CallFrame *savedVarFramePtr = data[0]; const char *msgPiece = data[1]; if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%s\" body line %d)", msgPiece, Tcl_GetErrorLine(interp))); } /* * Restore the variable frame, and return. */ ((Interp *)interp)->varFramePtr = savedVarFramePtr; |
︙ | ︙ | |||
950 951 952 953 954 955 956 | * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc, objv); } | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 | * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ objPtr = Tcl_ConcatObj(objc, objv); } TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, "uplevel", NULL, NULL); return TclNREvalObjEx(interp, objPtr, 0, invoker, word); } /* *---------------------------------------------------------------------- * * Tcl_InvokeObjCmd -- * * This object function is invoked to process the "invoke" Tcl command. * See the user documentation for details on what it does. * * Results: * A standard Tcl object result value. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ /* ARGSUSED */ int Tcl_InvokeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return Tcl_NRCallObjProc(interp, TclNRInvokeObjCmd, dummy, objc, objv); } int TclNRInvokeObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; int result; CallFrame *savedVarFramePtr, *framePtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "level command ?arg ...?"); return TCL_ERROR; } /* * Find the level to use for executing the command. */ result = TclObjGetFrame(interp, objv[1], &framePtr); if (result == -1) { return TCL_ERROR; } else if (result == 0) { /* * Must have a level, and whatever we've got, that's what we haven't * got. */ const char *name = TclGetString(objv[1]); Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL); return TCL_ERROR; } /* * Modify the interpreter state to execute in the given frame. */ savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = framePtr; /* * Execute the residual arguments as a command. */ TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, "invoke", NULL, NULL); return TclNREvalObjv(interp, objc - 2, objv + 2, TCL_EVAL_INVOKE, NULL); } /* *---------------------------------------------------------------------- * * TclFindProc -- * * Given the name of a procedure, return a pointer to the record |
︙ | ︙ |
Changes to tests/namespace.test.
︙ | ︙ | |||
3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 | proc p1 {} { return 16fe1b5807 } } : p1 } 16fe1b5807 # cleanup catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} namespace delete {*}[namespace children :: test_ns_*] ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 3348 3349 3350 3351 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 | proc p1 {} { return 16fe1b5807 } } : p1 } 16fe1b5807 namespace eval ::namespace-57 { test namespace-57.1 {namespace invoke} -returnCodes error -body { namespace invoke } -result {wrong # args: should be "namespace invoke name cmd ?arg...?"} test namespace-57.2 {namespace invoke} -returnCodes error -body { namespace invoke no_such_namespace namespace current } -result {namespace "no_such_namespace" not found in "::namespace-57"} test namespace-57.3 {namespace invoke} -returnCodes error -body { namespace invoke :: definitely_no_such_command } -result {invalid command name "definitely_no_such_command"} test namespace-57.4 {namespace invoke doesn't push a namespace} -body { namespace invoke :: namespace current } -result ::namespace-57 test namespace-57.5 {namespace invoke resolves in the given ns} -setup { namespace eval ns {} } -body { proc target {} {return "in origin"} proc ns::target {} {return "in target"} namespace invoke ns target } -cleanup { rename target {} namespace delete ns } -result {in target} test namespace-57.6 {namespace invoke resolves in the given ns} -setup { namespace eval ns {} } -body { namespace eval ns::tcl {} namespace invoke ns tcl::prefix match {a bcd e} b } -cleanup { namespace delete ns } -result bcd test namespace-57.7 {namespace invoke resolves in the given ns} -setup { namespace eval ns {} } -body { namespace eval ns::tcl {proc prefix args {return ok}} namespace invoke ns tcl::prefix match {a bcd e} b } -cleanup { namespace delete ns } -result ok test namespace-57.8 {namespace invoke resolves in the given ns} -setup { namespace eval ns {} namespace eval ns2 { proc foo {} {return "this is in ns2"} } } -body { namespace eval ns { namespace path ::namespace-57::ns2 } namespace invoke ns foo } -cleanup { namespace delete ns } -result {this is in ns2} test namespace-57.9 {namespace invoke preserves word boundaries} -setup { namespace eval ns { proc count args {list [llength $args] $args} } } -body { namespace invoke ns count a {b c} gorp } -cleanup { namespace delete ns } -result {3 {a {b c} gorp}} test namespace-57.10 {namespace invoke is NRE-aware} -setup { namespace eval ns {} } -body { proc ns::count args { yield $args return [llength $args] } coroutine c apply {args { yield namespace invoke ns count {*}$args } ::namespace-57} a {b c} gorp list [c] [c] } -cleanup { namespace delete ns } -result {{a {b c} gorp} 3} } # cleanup catch {rename cmd1 {}} catch {unset l} catch {unset msg} catch {unset trigger} namespace delete {*}[namespace children :: test_ns_*] ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: |
Changes to tests/uplevel.test.
|
| | | 1 2 3 4 5 6 7 8 | # Commands covered: uplevel, invoke # # This file contains a collection of tests for one or more of the Tcl built-in # commands. Sourcing this file into Tcl runs the tests and generates output # for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994 Sun Microsystems, Inc. |
︙ | ︙ | |||
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 | } foo moo } -cleanup { rename foo {} rename moo {} } -result {3 3 3} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 | } foo moo } -cleanup { rename foo {} rename moo {} } -result {3 3 3} test invoke-1.1 {invoke command usage} -returnCodes error -body { invoke } -result {wrong # args: should be "invoke level command ?arg ...?"} test invoke-1.2 {invoke command usage} -returnCodes error -body { invoke 0 } -result {wrong # args: should be "invoke level command ?arg ...?"} test invoke-1.3 {invoke command usage} -returnCodes error -body { invoke list a b c } -result {bad level "list"} test invoke-1.4 {invoke command usage} -returnCodes error -body { invoke 50000 list a b c } -result {bad level "50000"} test invoke-1.5 {invoke preserves word boundaries} -body { invoke 0 list "a b" c } -result {{a b} c} test invoke-1.6 {invoke walks the stack} -body { apply {x { apply {x { apply {x { apply {{x levels} { lmap l $levels {string cat $l -> [invoke $l set x]} }} jkl {3 2 1 0 #1 #2 #3 #4} }} ghi }} def }} abc } -result {3->abc 2->def 1->ghi 0->jkl #1->abc #2->def #3->ghi #4->jkl} test invoke-1.7 {invoke is NRE-aware} -body { coroutine c apply {{} { set x [yield] list [apply {x { invoke 1 eval {set x [yield $x]} return $x }} $x,$x] $x }} list [c 135] [c 246] } -result {135 {135,135 246}} # cleanup ::tcltest::cleanupTests return # Local Variables: # mode: tcl # fill-column: 78 # End: |