Index: generic/nsf.c =================================================================== diff -u -N -r9318621f9cf5544818fbb03209814fdfc8d2156c -r16494e7f90f6b80bea8eacb3d018f1383651904b --- generic/nsf.c (.../nsf.c) (revision 9318621f9cf5544818fbb03209814fdfc8d2156c) +++ generic/nsf.c (.../nsf.c) (revision 16494e7f90f6b80bea8eacb3d018f1383651904b) @@ -19101,10 +19101,11 @@ } break; - case CurrentoptionCalledclassIdx: - Tcl_SetResult(interp, ClassName(FindCalledClass(interp, object)), TCL_VOLATILE); + case CurrentoptionCalledclassIdx: { + NsfClass *cl = FindCalledClass(interp, object); + Tcl_SetObjResult(interp, cl ? cl->object.cmdName : NsfGlobalObjs[NSF_EMPTY]); break; - + } case CurrentoptionCallingmethodIdx: case CurrentoptionCallingprocIdx: { Tcl_Obj *resultObj; Index: library/lib/test.tcl =================================================================== diff -u -N -r7045595af282428ca760d1d5f9351d561a43bb51 -r16494e7f90f6b80bea8eacb3d018f1383651904b --- library/lib/test.tcl (.../test.tcl) (revision 7045595af282428ca760d1d5f9351d561a43bb51) +++ library/lib/test.tcl (.../test.tcl) (revision 16494e7f90f6b80bea8eacb3d018f1383651904b) @@ -120,10 +120,9 @@ # # Gracefully unwind the callstack built-up to this point, by # using [return]. At the top-most callstack level, we return - # with TCL_OK which will end the script evaluation without any - # error handling noise. We simply stop. By first returning to - # the very top of the callstack, we allow NSF to cleanup - # behind itself at the various dispatch levels + # with TCL_ERROR which will end the script evaluation. By + # first returning to the very top of the callstack, we allow + # NSF to cleanup behind itself at the various dispatch levels # (ObjectDispatch, MethodDispatch(), ...). # # Using [exit -1] directly leaves us with a partially unwinded @@ -133,10 +132,10 @@ # effectively skips the cleanup blocks throughout the NSF method # dispatch chain. # + + # exit -1 + return -code error; # return -level [expr {[info level]-1}] -code error - #return -level [expr {[info level]-1}] -code ok; # exit -1 - return -code error - } if {[info exists :post]} {:call "post" ${:post}} } Index: tests/interp.test =================================================================== diff -u -N -r9318621f9cf5544818fbb03209814fdfc8d2156c -r16494e7f90f6b80bea8eacb3d018f1383651904b --- tests/interp.test (.../interp.test) (revision 9318621f9cf5544818fbb03209814fdfc8d2156c) +++ tests/interp.test (.../interp.test) (revision 16494e7f90f6b80bea8eacb3d018f1383651904b) @@ -498,17 +498,4 @@ ? {interp eval $i {nsf::object::exists ::o}} 0 interp delete $i -} - -# -# TODO: -# - [current calledclass] seems broken -> returns NULL as string value?! -# - renames to "" in destroy run into an endless loop: -# nx::Object create ::o { -# :public method destroy {} { -# ::rename [current] "" -# next -# } -# :destroy -# } -# # \ No newline at end of file +} \ No newline at end of file Index: tests/introspection.test =================================================================== diff -u -N --- tests/introspection.test (revision 0) +++ tests/introspection.test (revision 16494e7f90f6b80bea8eacb3d018f1383651904b) @@ -0,0 +1,49 @@ +# -*- Tcl -*- +package req nx::test + +# +# [::nsf::current calledclass] +# + +nx::Test case current-calledclass { + Object create o { + :public method foo {} { + return [current calledclass] + } + } + ? {o foo} "" + Class create C { + :public class method bar {} { + return [current calledclass] + } + :public method foo {} { + return [current calledclass] + } + } + ? {[C new] foo} ::C + ? {C bar} "" + + C eval { + :public method intercept {} { + return @[current calledclass]@ + } + :filter add intercept + } + ? {[C new] foo} @::C@ + + C eval { + :filter {} + :public method baz {} { + return [current calledclass] + } + } + + Class create M { + :public method baz {} { + return [list [current calledclass] [next]] + } + } + C mixin add M + + ? {[C new] baz} {::C ::C} +} \ No newline at end of file