Index: TODO =================================================================== diff -u -N -r76fabbee9218a014ffdbc91e8c6e5d97aec807aa -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- TODO (.../TODO) (revision 76fabbee9218a014ffdbc91e8c6e5d97aec807aa) +++ TODO (.../TODO) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -5934,6 +5934,21 @@ ======================================================================== TODO: +- /obj/ uplevel + upvar should behave different when being provided a + relative level specifier, to provide filter/ mixin transparency at + all times, and then move upwards as requested: + + /obj/ uplevel 1 set x 1 + + should be equal to + + /obj/ uplevel {uplevel 1 set x 1} + + It is rather pointless to provide for TclObjGetFrame resolution in + uplevel/upvar methods, because then this use is just unnecessary + sugar for using uplevel/ upvar commands directly. However, this + would be a change that potentially breaks exisiting client code. + - add value=isSet as a new VariableSlot method, to wrap around [info exists] and others. - DTrace: --with-dtrace vs. --enable-dtrace (as in Tcl)? generate Index: doc/Class.3 =================================================================== diff -u -N -r8f64a468d8bb53f2ba317c8c738c2d3a24243980 -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- doc/Class.3 (.../Class.3) (revision 8f64a468d8bb53f2ba317c8c738c2d3a24243980) +++ doc/Class.3 (.../Class.3) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -2,7 +2,7 @@ '\" Generated from file 'Class\&.man' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2014-2016 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3\&.0 Austria license (CC BY 3\&.0 AT)\&. '\" -.TH "nx::Class" 3 2\&.1\&.0 Class "NX API" +.TH "nx::Class" 3 2\&.3a0 Class "NX API" .\" The -*- nroff -*- definitions below are for supplemental macros used .\" in Tcl/Tk manual entries. .\" @@ -1188,7 +1188,7 @@ Finally, the initialization method \fBinit\fR is dispatched, if available for \fIinstance\fR\&. \fBinit\fR can be defined by \fIcls\fR on behalf of its instance \fIinstance\fR, e\&.g\&. to lay out a -class-specific initialisation behaviour\&. +class-specific initialization behavior\&. .CS @@ -1203,7 +1203,7 @@ .CE .IP -Alternatively, the object \fIinstance\fR may define an per-object +Alternatively, the object \fIinstance\fR may define a per-object \fBinit\fR on its own\&. A per-object \fBinit\fR can be chained to a class-level \fBinit\fR using \fBnx::next\fR, just like a regular method\&. Index: doc/Object.3 =================================================================== diff -u -N -rf52d344b772763bfd59bc41294e7a45a336b2346 -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- doc/Object.3 (.../Object.3) (revision f52d344b772763bfd59bc41294e7a45a336b2346) +++ doc/Object.3 (.../Object.3) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -1,8 +1,8 @@ '\" '\" Generated from file 'Object\&.man' by tcllib/doctools with format 'nroff' -'\" Copyright (c) 2014-16 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3\&.0 Austria license (CC BY 3\&.0 AT)\&. +'\" Copyright (c) 2014-19 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3\&.0 Austria license (CC BY 3\&.0 AT)\&. '\" -.TH "nx::Object" 3 2\&.1\&.0 Object "NX API" +.TH "nx::Object" 3 2\&.3a0 Object "NX API" .\" The -*- nroff -*- definitions below are for supplemental macros used .\" in Tcl/Tk manual entries. .\" @@ -346,6 +346,10 @@ .sp \fIobj\fR \fBunknown\fR \fIunknownMethodName\fR ?\fIarg\fR \&.\&.\&.? .sp +\fIobj\fR \fBuplevel\fR ?\fIlevel\fR? \fIarg1\fR ?\fIarg2\fR \&.\&.\&.? +.sp +\fIobj\fR \fBupvar\fR ?\fIlevel\fR? \fIotherVar1\fR \fIlocalVar1\fR ?\fIotherVar2\fR \fIlocalVar2\fR \&.\&.\&.? +.sp \fIobj\fR \fBobject variable\fR ?\fB-accessor\fR \fBpublic\fR | \fBprotected\fR | \fBprivate\fR? ?\fB-incremental\fR? ?\fB-class\fR \fIclassName\fR? ?\fB-configurable\fR \fItrueFalse\fR? ?\fB-initblock\fR \fIscript\fR? ?\fB-trace\fR \fBset\fR | \fBget\fR | \fBdefault\fR? ?\fB-nocomplain\fR? \fIspec\fR ?\fIdefaultValue\fR? .sp .BE @@ -912,8 +916,11 @@ .TP \fIobj\fR \fBinfo lookup\fR \fIsubmethod\fR ?\fIarg\fR \&.\&.\&.? A collection of submethods to retrieve structural features (e\&.g\&. -configuration options, slot objects) and behavioral -features (e\&.g\&. methods, filters) available for \fIobj\fR from the perspective of a client to \fIobj\fR\&. Features provided by \fIobj\fR itself and by the classes in its current linearisation list are considered\&. +configuration options, slot objects) and behavioral features +(e\&.g\&. methods, filters) available for \fIobj\fR from the +perspective of a client to \fIobj\fR\&. Features provided by \fIobj\fR +itself and by the classes in its current linearization list are +considered\&. .RS .TP \fIobj\fR \fBinfo lookup filter\fR \fIname\fR @@ -939,7 +946,8 @@ .TP \fIobj\fR \fBinfo lookup mixins\fR ?\fB-guards\fR? ?\fInamePattern\fR? Returns the object names of all mixin classes which are -currently active on \fIobj\fR\&. By turning on the switch \fB-guards\fR, the corresponding guard expressions, if any, are also reported as a +currently active on \fIobj\fR\&. By turning on the switch +\fB-guards\fR, the corresponding guard expressions, if any, are also reported as a three-element list for each mixin class: \fIclassName\fR -guard \fIguardExpr\fR\&. The returned mixin classes can be limited to those whose names match \fInamePattern\fR (see \fBstring match\fR)\&. @@ -955,9 +963,14 @@ managing properties, variables, and relations of \fIobj\fR\&. The returned slot objects can be limited according to any or a combination of the following criteria: First, slot objects -can be filtered based on their command names matching \fInamePattern\fR (see -\fBstring match\fR)\&. Second, \fB-type\fR allows one to select -slot objects which are instantiated from a subclass \fIclassName\fR of \fBnx::Slot\fR (default: \fBnx::Slot\fR) \&. Third, \fB-source\fR restricts slot objects returned according to their provenance in either the NX \fIsystem\fR classes or the \fIapplication\fR classes present in the linearisation list of \fIobj\fR (default: \fIall\fR)\&. +can be filtered based on their command names matching \fInamePattern\fR +(see \fBstring match\fR)\&. Second, \fB-type\fR +allows one to select slot objects which are instantiated from +a subclass \fIclassName\fR of \fBnx::Slot\fR (default: \fBnx::Slot\fR) +\&. Third, \fB-source\fR restricts slot objects returned +according to their provenance in either the NX \fIsystem\fR classes +or the \fIapplication\fR classes present in the linearization list of +\fIobj\fR (default: \fIall\fR)\&. .sp To extract details of each slot object, use the \fBinfo\fR submethods available for each slot object\&. @@ -971,7 +984,8 @@ .TP \fIobj\fR \fBinfo lookup variables\fR Returns the command names of all slot objects responsible for -managing properties and variables of \fIobj\fR, if provided by \fIobj\fR or the classes in the linearisation list of \fIobj\fR\&. +managing properties and variables of \fIobj\fR, if provided by \fIobj\fR +or the classes in the linearization list of \fIobj\fR\&. .sp This is equivalent to calling: \fIobj\fR \fBinfo lookup slots\fR -type ::nx::VariableSlot -source all ?\fInamePattern\fR?\&. .sp @@ -1101,7 +1115,7 @@ \fIobj\fR \fBinfo precedence\fR ?\fB-intrinsic\fR? ?\fIpattern\fR? Lists the classes from which \fIobj\fR inherits structural (e\&.g\&. properties) and behavioral features (e\&.g\&. methods) and methods, in -order of the linearisation scheme in NX\&. By setting the +order of the linearization scheme in NX\&. By setting the switch \fB-intrinsic\fR, only classes which participate in superclass/subclass relationships (i\&.e\&., intrinsic classes) are returned\&. If a \fIpattern\fR is provided only classes whose @@ -1384,9 +1398,105 @@ This method is called implicitly whenever an unknown method is invoked\&. \fIunknownMethodName\fR indicates the unresolvable method name, followed by the remainder of the original argument vector as a number -of \fIarg\fR of the indirected method invocation\&. +of \fIarg\fR of the calling method invocation\&. .RE .TP +\fBuplevel\fR +.RS +.TP +\fIobj\fR \fBuplevel\fR ?\fIlevel\fR? \fIarg1\fR ?\fIarg2\fR \&.\&.\&.? +Evaluate a script or a command at a different stack-frame +level\&. Behaves like Tcl's \fBuplevel\fR, with the following +important exceptions\&. +.RS +.IP \(bu +If the \fIlevel\fR specifier is omitted, \fBuplevel\fR +will skip any auxiliary frames added to the stack by active filters and mixins\&. The +resulting stack-frame level corresponds to the callinglevel +as indicated by \fBnx::current\fR\&. +.IP \(bu +If the \fIlevel\fR specifier is omitted, \fBuplevel\fR gives +preference to the innermost enclosing procedure call, i\&.e\&., a frame +corresponding to a proc, method, or apply call\&. Any frames inbetween, +incl\&. those of filters and mixins (see above), will be skipped\&. +.IP \(bu +If the \fIlevel\fR specifier is provided (relative, or +absolute), \fBuplevel\fR will move execution into the requested +stack-frame level (incl\&. those introduced by active active filters and +mixins), if valid\&. +.RE +.CS + + + % nx::Object create ::obj + ::obj + % ::obj public object method foo {varName} { + :uplevel set $varName 1; return + } + ::obj::foo + % namespace eval ::ns1 { + ::obj foo BAR + } + % namespace eval ::ns1 { + info exists BAR + } + 1 + +.CE +.RE +.IP +Note, in the example above, \fBuplevel\fR is guaranteed to +resolve to the calling context of \fBfoo\fR (ns1) despite +mixins and filters being (potentially) registered on \fBobj\fR\&. +.TP +\fBupvar\fR +.RS +.TP +\fIobj\fR \fBupvar\fR ?\fIlevel\fR? \fIotherVar1\fR \fIlocalVar1\fR ?\fIotherVar2\fR \fIlocalVar2\fR \&.\&.\&.? +Links one or more local variables to variables defined for other +scopes (namespaces, objects, call frames)\&. Behaves like Tcl's \fBupvar\fR, +with the following important exceptions\&. +.RS +.IP \(bu +If the \fIlevel\fR specifier is omitted, \fBupvar\fR +will skip any auxiliary frames added to the stack by active filters and mixins\&. The +resulting stack-frame level corresponds to the callinglevel +as indicated by \fBnx::current\fR\&. +.IP \(bu +If the \fIlevel\fR specifier is omitted, \fBupvar\fR gives +preference to the innermost enclosing procedure call, i\&.e\&., a frame +corresponding to a proc, method, or apply call\&. Any frames inbetween, +incl\&. those of filters and mixins (see above), will be skipped\&. +.IP \(bu +If the \fIlevel\fR specifier is provided (relative, or +absolute), \fBupvar\fR will link into the requested +stack-frame level (incl\&. those introduced by active active filters and +mixins), if valid\&. +.RE +.CS + + + % nx::Object create ::obj + ::obj + % ::obj public object method foo {varName} { + :upvar $varName x; set x 1; return + } + ::obj::foo + % namespace eval ::ns1 { + ::obj foo BAR + } + % namespace eval ::ns1 { + info exists BAR + } + 1 + +.CE +.RE +.IP +Note, in the example above, \fBupvar\fR is guaranteed to +resolve to the calling context of \fBfoo\fR (ns1) despite +mixins and filters being (potentially) registered on \fBobj\fR\&. +.TP \fBvariable\fR .RS .TP @@ -1510,7 +1620,7 @@ Objects are naturally recursive, with methods of an object \fB::obj\fR frequently invoking other methods in the same object \fB::obj\fR and accessing \fB::obj\fR's object variables\&. To represent these -self-references effectively in method bodies, and dependening on the +self-references effectively in method bodies, and depending on the usage scenario, NX offers two alternative notations for self-references: one based on a special-purpose syntax token ("colon prefix"), the other based on the command \fBnx::current\fR\&. @@ -1569,6 +1679,6 @@ .CE .SH COPYRIGHT .nf -Copyright (c) 2014-16 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3\&.0 Austria license (CC BY 3\&.0 AT)\&. +Copyright (c) 2014-19 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3\&.0 Austria license (CC BY 3\&.0 AT)\&. -.fi +.fi \ No newline at end of file Index: doc/Object.man =================================================================== diff -u -N -rf52d344b772763bfd59bc41294e7a45a336b2346 -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- doc/Object.man (.../Object.man) (revision f52d344b772763bfd59bc41294e7a45a336b2346) +++ doc/Object.man (.../Object.man) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -20,7 +20,7 @@ [vset CMD "obj"] [vset MODIFIER "object"] -[copyright {2014-16 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3.0 Austria license (CC BY 3.0 AT).}] +[copyright {2014-19 Stefan Sobernig , Gustaf Neumann ; available under the Creative Commons Attribution 3.0 Austria license (CC BY 3.0 AT).}] [moddesc "NX API"] [titledesc {API reference of the base class in the NX object system}] @@ -743,6 +743,108 @@ [list_end] +[cmd_def uplevel] + +[list_begin definitions] + +[call [arg obj] [method uplevel] [opt [arg level]] [arg arg1] [opt "[arg arg2] ..."]] + +Evaluate a script or a command at a different stack-frame +level. Behaves like Tcl's [cmd uplevel], with the following +important exceptions. + +[list_begin itemized] + +[item] If the [arg level] specifier is omitted, [method "uplevel"] +will skip any auxiliary frames added to the stack by active [term "filter"]s and [term "mixin"]s. The +resulting stack-frame level corresponds to the [term "callinglevel"] +as indicated by [cmd nx::current]. + +[item] If the [arg level] specifier is omitted, [method uplevel] gives +preference to the innermost enclosing procedure call, i.e., a frame +corresponding to a proc, method, or apply call. Any frames inbetween, +incl. those of filters and mixins (see above), will be skipped. + +[item] If the [arg level] specifier is provided (relative, or +absolute), [method "uplevel"] will move execution into the requested +stack-frame level (incl. those introduced by active active [term "filter"]s and +[term "mixin"]s), if valid. + +[list_end] + +[example { + % nx::Object create ::obj + ::obj + % ::obj public object method foo {varName} { + :uplevel set $varName 1; return + } + ::obj::foo + % namespace eval ::ns1 { + ::obj foo BAR + } + % namespace eval ::ns1 { + info exists BAR + } + 1 +}] + +[list_end] + +Note, in the example above, [method "uplevel"] is guaranteed to +resolve to the calling context of [method "foo"] ([term "ns1"]) despite +mixins and filters being (potentially) registered on [cmd "obj"]. + +[cmd_def upvar] + +[list_begin definitions] + +[call [arg obj] [method upvar] [opt [arg level]] [arg otherVar1] [arg localVar1] [opt "[arg otherVar2] [arg localVar2] ..."]] + +Links one or more local variables to variables defined for other +scopes (namespaces, objects, call frames). Behaves like Tcl's [cmd "upvar"], +with the following important exceptions. + +[list_begin itemized] + +[item] If the [arg level] specifier is omitted, [method "upvar"] +will skip any auxiliary frames added to the stack by active [term "filter"]s and [term "mixin"]s. The +resulting stack-frame level corresponds to the [term "callinglevel"] +as indicated by [cmd nx::current]. + +[item] If the [arg level] specifier is omitted, [method upvar] gives +preference to the innermost enclosing procedure call, i.e., a frame +corresponding to a proc, method, or apply call. Any frames inbetween, +incl. those of filters and mixins (see above), will be skipped. + +[item] If the [arg level] specifier is provided (relative, or +absolute), [method "upvar"] will link into the requested +stack-frame level (incl. those introduced by active active [term "filter"]s and +[term "mixin"]s), if valid. + +[list_end] + +[example { + % nx::Object create ::obj + ::obj + % ::obj public object method foo {varName} { + :upvar $varName x; set x 1; return + } + ::obj::foo + % namespace eval ::ns1 { + ::obj foo BAR + } + % namespace eval ::ns1 { + info exists BAR + } + 1 +}] + +[list_end] + +Note, in the example above, [method "upvar"] is guaranteed to +resolve to the calling context of [method "foo"] ([term "ns1"]) despite +mixins and filters being (potentially) registered on [cmd "obj"]. + [cmd_def variable] [list_begin definitions] Index: generic/nsf.c =================================================================== diff -u -N -r4f234291ad9583aafb5a8c9476d4c3f56838fab3 -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- generic/nsf.c (.../nsf.c) (revision 4f234291ad9583aafb5a8c9476d4c3f56838fab3) +++ generic/nsf.c (.../nsf.c) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -20693,9 +20693,14 @@ nonnull_assert(interp != NULL); switch (level) { - case CALLING_LEVEL: - NsfCallStackFindLastInvocation(interp, 1, &framePtr); + case CALLING_LEVEL: { + Tcl_CallFrame *callingFramePtr = NULL; + NsfCallStackFindCallingContext(interp, 1, &framePtr, &callingFramePtr); + if (framePtr == NULL) { + framePtr = callingFramePtr; + } break; + } case ACTIVE_LEVEL: NsfCallStackFindActiveFrame(interp, 1, &framePtr); break; @@ -20706,7 +20711,7 @@ if (framePtr != NULL) { /* - * The call was from an nsf frame, return absolute frame number. + * The call was from an NSF frame, return absolute frame number. */ char buffer[LONG_AS_STRING]; int l; @@ -20716,7 +20721,12 @@ resultObj = Tcl_NewStringObj(buffer, l+1); } else { /* - * If not called from an nsf frame, return #0 as default. + * If not called from an NSF frame, return #0 as default. + * + * TODO: With NsfCallStackFindCallingContext in place, this cannot (should + * not) be reachable. Need to check NsfCallStackFindActiveFrame. When in + * the "clear", provide for a warning here? + * */ resultObj = Tcl_NewStringObj("#0", 2); } @@ -32330,44 +32340,47 @@ } */ static int -NsfOUplevelMethod(Tcl_Interp *interp, NsfObject *UNUSED(object), int objc, Tcl_Obj *const objv[]) { - int i, result; - Tcl_CallFrame *framePtr, *savedVarFramePtr; +NsfOUplevelMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const objv[]) { + int result; + CallFrame *requestedFramePtr; + Tcl_CallFrame *framePtr = NULL, *savedVarFramePtr; nonnull_assert(interp != NULL); nonnull_assert(objv != NULL); - /* - * Find the level to use for executing the command. - */ - if (objc > 2) { - CallFrame *cf; - const char *frameInfo = ObjStr(objv[1]); + if (objc < 2) { + wrongArgs: + return NsfPrintError(interp, + "wrong # args: should be \"%s %s ?level? command ?arg ...?\"", + ObjectName(object), + NsfMethodName(objv[0])); + } - result = TclGetFrame(interp, frameInfo, &cf); - if (unlikely(result == -1)) { - return TCL_ERROR; - } - framePtr = (Tcl_CallFrame *)cf; - i = result+1; - } else { - framePtr = NULL; - i = 1; + result = TclObjGetFrame(interp, objv[1], &requestedFramePtr); + if (unlikely(result == -1)) { + return TCL_ERROR; } + objc -= result + 1; + if (objc == 0) { + goto wrongArgs; + } + objv += result + 1; - objc -= i; - objv += i; - - if (framePtr == NULL) { - NsfCallStackFindLastInvocation(interp, 1, &framePtr); + if (result == 0) { + /* 0 is returned from TclObjGetFrame when no (or, an invalid) level specifier was provided */ + Tcl_CallFrame *callingFramePtr = NULL; + NsfCallStackFindCallingContext(interp, 1, &framePtr, &callingFramePtr); if (framePtr == NULL) { - framePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp)->callerVarPtr; - if (framePtr == NULL) { - framePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); - } + /* no proc frame was found, default to parent frame */ + framePtr = callingFramePtr; } + } else { + /* use the requested frame corresponding to the (valid) level specifier */ + framePtr = (Tcl_CallFrame *)requestedFramePtr; } + assert(framePtr != NULL); + savedVarFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); Tcl_Interp_varFramePtr(interp) = (CallFrame *)framePtr; @@ -32386,10 +32399,11 @@ Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv); result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); } + if (unlikely(result == TCL_ERROR)) { Tcl_AppendObjToErrorInfo(interp, - Tcl_ObjPrintf("\n (\"uplevel\" body line %d)", - Tcl_GetErrorLine(interp))); + Tcl_ObjPrintf("\n (\"uplevel\" body line %d)", + Tcl_GetErrorLine(interp))); } /* @@ -32415,11 +32429,25 @@ nonnull_assert(interp != NULL); nonnull_assert(object != NULL); + if (objc < 3) { + return NsfPrintError(interp, + "wrong # args: should be \"%s %s " + "?level? otherVar localVar ?otherVar localVar ...?\"", + ObjectName(object), + NsfMethodName(objv[0])); + } + if (objc % 2 == 0) { + /* even number of arguments (incl. method) + * -> level specifier considered present + */ frameInfoObj = NULL; frameInfo = ObjStr(objv[1]); i = 2; } else { + /* odd number of arguments (incl. method) + * -> level specififer considered absent, compute jump level + */ frameInfoObj = ComputeLevelObj(interp, CALLING_LEVEL); INCR_REF_COUNT(frameInfoObj); frameInfo = ObjStr(frameInfoObj); @@ -32429,7 +32457,7 @@ if ((object->filterStack != NULL) || (object->mixinStack != NULL)) { CallStackUseActiveFrame(interp, &ctx); } - + for ( ; i < objc; i += 2) { result = Tcl_UpVar2(interp, frameInfo, ObjStr(objv[i]), NULL, ObjStr(objv[i+1]), 0 /*flags*/); @@ -32443,6 +32471,7 @@ } CallStackRestoreSavedFrames(interp, &ctx); return result; + } /* Index: generic/nsfInt.h =================================================================== diff -u -N -r459516f92aed8b1287b3824d7dd39f58859dea4d -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- generic/nsfInt.h (.../nsfInt.h) (revision 459516f92aed8b1287b3824d7dd39f58859dea4d) +++ generic/nsfInt.h (.../nsfInt.h) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -1396,4 +1396,7 @@ #define NsfMax(a,b) ((a) > (b) ? a : b) #define NsfMin(a,b) ((a) < (b) ? a : b) +#define NsfCallStackFindLastInvocation(interp, offset, framePtrPtr) \ + NsfCallStackFindCallingContext((interp), (offset), (framePtrPtr), NULL) + #endif /* _nsf_int_h_ */ Index: generic/nsfStack.c =================================================================== diff -u -N -rb489939c82f4fd30a0c6dc404f272d29085e087e -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- generic/nsfStack.c (.../nsfStack.c) (revision b489939c82f4fd30a0c6dc404f272d29085e087e) +++ generic/nsfStack.c (.../nsfStack.c) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -77,12 +77,14 @@ NSF_INLINE static NsfCallStackContent* CallStackGetTopFrame0(const Tcl_Interp *interp) nonnull(1) pure; -static NsfCallStackContent* NsfCallStackFindLastInvocation( +static NsfCallStackContent* NsfCallStackFindCallingContext( const Tcl_Interp *interp, int offset, - Tcl_CallFrame **framePtrPtr + Tcl_CallFrame **callingProcFramePtrPtr, + Tcl_CallFrame **callingFramePtrPtr ) nonnull(1); + static NsfCallStackContent* NsfCallStackFindActiveFrame( const Tcl_Interp *interp, int offset, @@ -613,65 +615,70 @@ /* *---------------------------------------------------------------------- + * NsfCallStackFindCallingContext -- * NsfCallStackFindLastInvocation -- * - * Find last invocation of a (scripted or non-leaf) method with a - * specified offset. + * Find the calling context (frame) with a specified offset. Find the + * frame corresponding to the calling proc or (scripted or non-leaf) + * method. * * Results: - * Call stack content or NULL. + * Call stack content (for NSF methods) or NULL. * * Side effects: * None. * *---------------------------------------------------------------------- */ static NsfCallStackContent * -NsfCallStackFindLastInvocation(const Tcl_Interp *interp, int offset, Tcl_CallFrame **framePtrPtr) { +NsfCallStackFindCallingContext(const Tcl_Interp *interp, + int offset, + Tcl_CallFrame **callingProcFramePtrPtr, + Tcl_CallFrame **callingFramePtrPtr) { register Tcl_CallFrame *varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); int lvl = Tcl_CallFrame_level(varFramePtr); - + nonnull_assert(interp != NULL); for (; likely(varFramePtr != NULL); varFramePtr = Tcl_CallFrame_callerVarPtr(varFramePtr)) { - - if (((unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) { - NsfCallStackContent *cscPtr = (NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr); - + register unsigned int flags = (unsigned int)Tcl_CallFrame_isProcCallFrame(varFramePtr); + + if (flags != 0u) { /* - * A NSF method frame. + * A proc frame */ - if ((cscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE)) - || (cscPtr->frameType & NSF_CSC_TYPE_INACTIVE)) { - continue; + NsfCallStackContent *cscPtr = + (flags & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) ? + ((NsfCallStackContent *)Tcl_CallFrame_clientData(varFramePtr)) : NULL; + + if (cscPtr != NULL) { + /* + * An NSF method frame. + */ + if ((cscPtr->flags & (NSF_CSC_CALL_IS_NEXT|NSF_CSC_CALL_IS_ENSEMBLE)) + || (cscPtr->frameType & NSF_CSC_TYPE_INACTIVE)) { + continue; + } } - + if (offset != 0) { offset--; } else if (Tcl_CallFrame_level(varFramePtr) < lvl) { - if (framePtrPtr != NULL) { - *framePtrPtr = varFramePtr; + if (callingProcFramePtrPtr != NULL) { + *callingProcFramePtrPtr = varFramePtr; } return cscPtr; } - } else if (Tcl_CallFrame_isProcCallFrame(varFramePtr)) { - - /* - * A Tcl proc frame. - */ - if (offset != 0) { - offset--; - } else if (Tcl_CallFrame_level(varFramePtr) < lvl) { - if (framePtrPtr != NULL) { - *framePtrPtr = varFramePtr; - } - return NULL; - } + + } else if (callingFramePtrPtr != NULL && + *callingFramePtrPtr == NULL && + Tcl_CallFrame_level(varFramePtr) < lvl) { + *callingFramePtrPtr = varFramePtr; } } - if (framePtrPtr != NULL) { - *framePtrPtr = NULL; + if (callingProcFramePtrPtr != NULL) { + *callingProcFramePtrPtr = NULL; } return NULL; } Index: tests/methods.test =================================================================== diff -u -N -ra65f2c7d3f02c9da0f878f59fa4dd5fb6008bade -rbaee0c34119f4b237787204b8c3e64bc04c05782 --- tests/methods.test (.../methods.test) (revision a65f2c7d3f02c9da0f878f59fa4dd5fb6008bade) +++ tests/methods.test (.../methods.test) (revision baee0c34119f4b237787204b8c3e64bc04c05782) @@ -1607,6 +1607,352 @@ AbstractFile filters delete filterCall +nx::test case callinglevels { + + nx::Object create objekt + objekt public object method foo {} { + current callinglevel + } + + ? {uplevel #0 {objekt foo}} "#0" + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "#2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "#1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "#1" + namespace delete ::ns1 + + objekt public object method intercept args { + list [current method] {*}[next] + } + objekt object filters set intercept + + ? {uplevel #0 {objekt foo}} "intercept #0" + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "intercept #2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "intercept #1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "intercept #1" + namespace delete ::ns1 + + objekt object mixins add [nx::Class new { + :public method foo {args} { + list [current method] {*}[next] + } + }] + + ? {uplevel #0 {objekt foo}} "intercept foo #0" + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "intercept foo #2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "intercept foo #1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "intercept foo #1" + namespace delete ::ns1 + +} + +nx::test case uplevel { + nx::Object create objekt + objekt public object method foo {} { + :uplevel {return -level 0 #[info level]} + } + ? {uplevel #0 {objekt foo}} "#0" + + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "#2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "#1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "#1" + namespace delete ::ns1 + + objekt public object method intercept args { + if {[current calledmethod] eq "foo"} { + list [current method] {*}[next] + } else { + next + } + } + objekt object filters set intercept + + ? {uplevel #0 {objekt foo}} "intercept #0" + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "intercept #2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "intercept #1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "intercept #1" + namespace delete ::ns1 + + objekt object mixins add [nx::Class new { + :public method foo {args} { + list [current method] {*}[next] + } + }] + + ? {uplevel #0 {objekt foo}} "intercept foo #0" + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }} "intercept foo #2" + namespace delete ::ns1 + + ? {uplevel #0 {apply {{} {objekt foo}}}} "intercept foo #1" + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "intercept foo #1" + namespace delete ::ns1 + + set filters [objekt object filters clear] + set mixins [objekt object mixins clear] + unset -nocomplain ::_ + + objekt public object method foo {} { + :uplevel {set FOO 1} + } + + ? {uplevel #0 { + lappend _ [info exists FOO]; + objekt foo; + lappend _ [info exists FOO][unset FOO]} + } "0 1" + + unset -nocomplain ::_ + + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + lappend _ [info exists FOO]; + objekt foo; + lappend _ [info exists FOO][unset FOO]; + } + } + }} "0 1" + namespace delete ::ns1 + + ? {uplevel #0 { + namespace eval ::ns1 { + apply {{} { + lappend _ [info exists FOO]; + namespace eval ns2 { + objekt foo; + } + lappend _ [info exists FOO][unset FOO]; + }} + } + }} "0 1" + namespace delete ::ns1 + + objekt object filters set $filters + objekt object mixins set $mixins + + ? {uplevel #0 { + lappend _ [info exists FOO]; + objekt foo; + lappend _ [info exists FOO][unset FOO]} + } "0 1" + + unset -nocomplain ::_ + + ? {uplevel #0 { + namespace eval ::ns1 { + namespace eval ns2 { + lappend _ [info exists FOO]; + objekt foo; + lappend _ [info exists FOO][unset FOO]; + } + } + }} "0 1" + namespace delete ::ns1 + + ? {uplevel #0 { + namespace eval ::ns1 { + apply {{} { + lappend _ [info exists FOO]; + namespace eval ns2 { + objekt foo; + } + lappend _ [info exists FOO][unset FOO]; + }} + } + }} "0 1" + namespace delete ::ns1 + +} + +nx::test case uplevel-method-signature { + + nx::Object create objekt + objekt public object method foo {} { + concat \ + [:uplevel return -level 0 "#\[info level\]"] \ + [uplevel [current callinglevel] return -level 0 "#\[info level\]"] + } + + ? {uplevel #0 { apply {{} { + namespace eval ::ns1 { + namespace eval ns2 { + objekt foo + } + } + }}}} "#1 #1" + + objekt public object method foo {} { + :uplevel + } + + ? {uplevel #0 {objekt foo}} {wrong # args: should be "::objekt uplevel ?level? command ?arg ...?"} + + objekt public object method foo {} { + :uplevel 1 + } + + ? {uplevel #0 {objekt foo}} {wrong # args: should be "::objekt uplevel ?level? command ?arg ...?"} + + objekt public object method foo {} { + :uplevel #1 + } + + ? {uplevel #0 {objekt foo}} {wrong # args: should be "::objekt uplevel ?level? command ?arg ...?"} + + objekt public object method foo {} { + :uplevel 1 {return -level 0 #[info level]} + } + + ? {uplevel #0 {objekt foo}} "#0" + + objekt public object method foo {} { + :uplevel 1 return -level 0 "#\[info level\]" + } + + ? {uplevel #0 {objekt foo}} "#0" + + objekt public object method foo {} { + :uplevel #0 {return -level 0 #[info level]} + } + + ? {uplevel #0 {objekt foo}} "#0" + + objekt public object method foo {} { + :uplevel #0 return -level 0 "#\[info level\]" + } + + ? {uplevel #0 {objekt foo}} "#0" +} + +nx::test case upvar-method-signature { + + Object create objekt + objekt public object method foo {} { + :upvar #1; + } + + ? {uplevel #0 {objekt foo}} \ + {wrong # args: should be "::objekt upvar ?level? otherVar localVar ?otherVar localVar ...?"} + + objekt public object method foo {} { + :upvar 1; + } + + ? {uplevel #0 {objekt foo}} \ + {wrong # args: should be "::objekt upvar ?level? otherVar localVar ?otherVar localVar ...?"} + + objekt public object method foo {} { + :upvar; + } + + ? {uplevel #0 {objekt foo}} \ + {wrong # args: should be "::objekt upvar ?level? otherVar localVar ?otherVar localVar ...?"} + + objekt public object method foo {} { + :upvar x z; + set z 5 + } + + ? {uplevel #0 {objekt foo; set x}} 5 + + objekt public object method foo {} { + :upvar #5 x z; + } + + ? {uplevel #0 {objekt foo}} \ + {bad level "#5"} + + objekt public object method foo {} { + :upvar #5 x z y; + set x 1 + } + + ? {uplevel #0 {apply {{} {objekt foo; info exists "#5"}}}} 1 +} + + + # Local variables: # mode: tcl # tcl-indent-level: 2