Index: generic/xotcl.c =================================================================== diff -u -re991034eda7c58e579d40878c82116765d72e00b -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 --- generic/xotcl.c (.../xotcl.c) (revision e991034eda7c58e579d40878c82116765d72e00b) +++ generic/xotcl.c (.../xotcl.c) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) @@ -7553,7 +7553,7 @@ char *resultMsg = NULL; /*fprintf(stderr, "XOTclUnsetTrace %s flags %.4x %.4x\n", name, flags, - flags & TCL_INTERP_DESTROYED); */ + flags & TCL_INTERP_DESTROYED); */ if ((flags & TCL_INTERP_DESTROYED) == 0) { if (GetObjectFromObj(interp, obj, &object) == TCL_OK) { @@ -9452,7 +9452,8 @@ * registration. etc. If we would use this namespace, we would * resolve non-fully-qualified names against ::xotcl). */ - for (framePtr = nonXotclObjectProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp)); + for (framePtr = activeProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), + FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD); framePtr; framePtr = Tcl_CallFrame_callerVarPtr(framePtr)) { nsPtr = Tcl_CallFrame_nsPtr(framePtr); @@ -13171,7 +13172,9 @@ if (Tcl_SetVar2(interp, vn, NULL, fullName, 0)) { XOTclObjectOpt *opt = XOTclRequireObjectOpt(object); - /*fprintf(stderr, "### setting trace for %s on frame %p\n", fullName, Tcl_Interp_varFramePtr(interp));*/ + /*fprintf(stderr, "### setting trace for %s on frame %p\n", fullName, + Tcl_Interp_varFramePtr(interp)); + tcl85showStack(interp);*/ result = Tcl_TraceVar(interp, vn, TCL_TRACE_UNSETS, (Tcl_VarTraceProc*)XOTclUnsetTrace, (ClientData)objPtr); Index: generic/xotclStack85.c =================================================================== diff -u -re991034eda7c58e579d40878c82116765d72e00b -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 --- generic/xotclStack85.c (.../xotclStack85.c) (revision e991034eda7c58e579d40878c82116765d72e00b) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) @@ -90,7 +90,6 @@ Tcl_PopCallFrame(interp); } - #define XOTcl_PushFrameCsc(interp,cscPtr) XOTcl_PushFrameCsc2(interp, cscPtr, framePtr) #define XOTcl_PopFrameCsc(interp) XOTcl_PopFrameCsc2(interp, framePtr) @@ -102,10 +101,7 @@ Tcl_CallFrame_nsPtr(varFramePtr));*/ Tcl_PushCallFrame(interp, framePtr, Tcl_CallFrame_nsPtr(varFramePtr), -#if KEEP_VARS_IN_CMETHOD_FRAME -1| -#endif - FRAME_IS_XOTCL_CMETHOD); + 1|FRAME_IS_XOTCL_CMETHOD); XOTcl_PushFrameSetCd(framePtr, cscPtr); } @@ -116,12 +112,11 @@ } /* - * query operations. - * + * stack query operations */ static Tcl_CallFrame * -nonXotclObjectProcFrame(Tcl_CallFrame *framePtr) { +activeProcFrame(Tcl_CallFrame *framePtr, int skipFrames) { for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { register int flag = Tcl_CallFrame_isProcCallFrame(framePtr); @@ -130,8 +125,7 @@ if (!(((XOTclCallStackContent *)Tcl_CallFrame_clientData(framePtr))->frameType & XOTCL_CSC_TYPE_INACTIVE)) break; } else { - if (flag & FRAME_IS_XOTCL_OBJECT) continue; - /*if ((flag & (FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD)) == 0) break;*/ + if (flag & skipFrames) continue; if (flag == 0 || flag & FRAME_IS_PROC) break; } } @@ -255,50 +249,22 @@ static void CallStackUseActiveFrames(Tcl_Interp *interp, callFrameContext *ctx) { - Tcl_CallFrame *inFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), - *varFramePtr, *activeFramePtr, *framePtr; + Tcl_CallFrame + *inFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), + *framePtr; - XOTclCallStackFindActiveFrame(interp, 0, &activeFramePtr); - /*tcl85showStack(interp);*/ + /*XOTclCallStackFindActiveFrame(interp, 0, &activeFramePtr);*/ # if defined(TCL85STACK_TRACE) tcl85showStack(interp); # endif - /* Get the first active non object frame (or object frame with proc */ - varFramePtr = nonXotclObjectProcFrame(inFramePtr); + /* Get the first active non object frame */ + framePtr = activeProcFrame(inFramePtr, + FRAME_IS_XOTCL_CMETHOD|FRAME_IS_XOTCL_OBJECT); - /*fprintf(stderr,"CallStackUseActiveFrames inframe %p varFrame %p activeFrame %p lvl %d\n", - inFramePtr,varFramePtr,activeFramePtr, Tcl_CallFrame_level(inFramePtr));*/ + /*fprintf(stderr,"... use frameptr %p \n", framePtr);*/ - if (activeFramePtr == varFramePtr || activeFramePtr == inFramePtr) { - /* top frame is a active frame */ - framePtr = varFramePtr; - - } else if (activeFramePtr == NULL) { - /* There is no XOTcl callframe active; use the caller of inframe */ - /*fprintf(stderr,"activeFramePtr == NULL\n");*/ - - if ((Tcl_CallFrame_isProcCallFrame(inFramePtr) & FRAME_IS_XOTCL_METHOD) == 0) { - framePtr = varFramePtr; - } else { - framePtr = Tcl_CallFrame_callerPtr(inFramePtr); - } - - } else { - /* The active framePtr is an entry deeper in the stack. When XOTcl - is interleaved with Tcl, we return the Tcl frame */ - - /*fprintf(stderr,"active == deeper, use Tcl frame\n"); */ - for (framePtr = varFramePtr; framePtr && framePtr != activeFramePtr; - framePtr = Tcl_CallFrame_callerPtr(framePtr)) { - if ((Tcl_CallFrame_isProcCallFrame(framePtr) & (FRAME_IS_XOTCL_METHOD|FRAME_IS_XOTCL_CMETHOD)) == 0) { - break; - } - } - } - if (inFramePtr == framePtr) { /* call frame pointers are fine */ - /*fprintf(stderr, "... no need to save frames\n");*/ ctx->framesSaved = 0; } else { ctx->varFramePtr = inFramePtr; Index: tests/forwardtest.xotcl =================================================================== diff -u -re5b7b9261b0de87bf7a45ff7416ecd967037fa0b -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 --- tests/forwardtest.xotcl (.../forwardtest.xotcl) (revision e5b7b9261b0de87bf7a45ff7416ecd967037fa0b) +++ tests/forwardtest.xotcl (.../forwardtest.xotcl) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) @@ -234,8 +234,8 @@ ############################################### # option earlybinding ############################################### -Test case earlyinging -obj forward s -earlybinding ::set %proc +Test case earlybinding +obj forward s -earlybinding ::set ::X ? {obj s 100} 100 ? {obj s} 100 Index: tests/testx.xotcl =================================================================== diff -u -rc942f4e117d2aa3c8594702e0476a3f73a4147df -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 --- tests/testx.xotcl (.../testx.xotcl) (revision c942f4e117d2aa3c8594702e0476a3f73a4147df) +++ tests/testx.xotcl (.../testx.xotcl) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) @@ -3,7 +3,10 @@ proc ::errorCheck {got expected msg} { if {$got != $expected} { - puts stderr "[self] FAILED: $msg\nGot: $got\nExpected: $expected" + if {[catch self self]} { + set self "NO CURRENT OBJECT" + } + puts stderr "$self FAILED: $msg\nGot: $got\nExpected: $expected" foreach g $got e $expected { set result [expr {$g == $e}] if {[string length $g]>60} { @@ -4285,25 +4288,27 @@ Class instmixin {} C instmixin {} set c0 [llength [C info instances]] - set o [C new -volatile]; errorCheck [Object isobject $o] 1 "x, check object" + set o1 [C new -volatile]; errorCheck [Object isobject $o1] 1 "x, check object" Class instmixin ::xotcl::_creator - set o [C new -volatile]; errorCheck [Object isobject $o] 1 "x, check object" + set o2 [C new -volatile]; errorCheck [Object isobject $o2] 1 "x, check object" C instmixin ::xotcl::I - set o [C new -volatile]; errorCheck [Object isobject $o] 1 "x, check object" + set o3 [C new -volatile]; errorCheck [Object isobject $o3] 1 "x, check object" set c1 [llength [C info instances]] errorCheck [expr {$c1 - $c0 != 3}] 0 "exit x, three more objects" + #puts stderr "WE HAVE $o1 $o2 $o3" } x +puts stderr C-instances=[C info instances] errorCheck [expr {[llength [C info instances]] > 0}] 0 "top, all volatile object gone" proc x1 {} { set c0 [llength [C info instances]] - set o [C new -volatile]; errorCheck [Object isobject $o] 1 "x1, check object" + set o1 [C new -volatile]; errorCheck [Object isobject $o1] 1 "x1, check object $o1" x - set o [C new -volatile]; errorCheck [Object isobject $o] 1 "x1, check object" + set o2 [C new -volatile]; errorCheck [Object isobject $o2] 1 "x1, check object $o2" set c1 [llength [C info instances]] - errorCheck [expr {$c1 - $c0 != 2}] 0 "exit x1, two more objects" + errorCheck [expr {$c1 - $c0 != 2}] 0 "exit x1, two more objects - $c1 ($o1,$o2), [C info instances]" } x1 Index: tests/varresolutiontest.xotcl =================================================================== diff -u -re991034eda7c58e579d40878c82116765d72e00b -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 --- tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision e991034eda7c58e579d40878c82116765d72e00b) +++ tests/varresolutiontest.xotcl (.../varresolutiontest.xotcl) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) @@ -88,8 +88,8 @@ set g 1 } set ::o::Y 5 -#? {info vars ::x} "" -? {info vars ::x} "::x" +? {info vars ::x} "" +#? {info vars ::x} "::x" ? {info exists ::z} 1 ? {set ::z} 3 @@ -396,8 +396,8 @@ ? {o exists x} 1 ? {o exists xxx} 0 -#? {info exists ::xxx} 0 -? {info exists ::xxx} 1 +? {info exists ::xxx} 0 +#? {info exists ::xxx} 1 unset -nocomplain ::xxx # eval does an objcope, all vars are instance variables; can access preexisting global vars @@ -424,8 +424,8 @@ ? {o exists b} 1 ? {o exists bbb} 0 -#? {info vars ::bbb} "" -? {info vars ::bbb} ::bbb +? {info vars ::bbb} "" +#? {info vars ::bbb} ::bbb unset -nocomplain ::bbb # softeval2 never sets instance variables @@ -593,20 +593,20 @@ set G 1 -# ? {foo-via-initcmd} 1-0-0-0-0-0-G=0,p=0 -# ? {foo nonleaf-eval} 1-0-0-0-0-0-G=0,p=0 + ? {foo-via-initcmd} 1-0-0-0-0-0-G=0,p=0 + ? {foo nonleaf-eval} 1-0-0-0-0-0-G=0,p=0 + ? {foo objscoped-eval} 1-1-0-0-0-0-G=0,p=0 + ? {foo plain-eval} 0-0-0-1-0-0-G=0,p=1 + ? {foo-tcl eval} 0-0-0-1-0-0-G=0,p=1 + ? {foo-tcl ns-eval} 0-0-0-0-0-1-G=1,p=0 + +# ? {foo-via-initcmd} 1-0-0-0-0-1-G=1,p=0 +# ? {foo nonleaf-eval} 1-0-0-0-0-1-G=1,p=0 # ? {foo objscoped-eval} 1-1-0-0-0-0-G=0,p=0 # ? {foo plain-eval} 0-0-0-1-0-0-G=0,p=1 # ? {foo-tcl eval} 0-0-0-1-0-0-G=0,p=1 # ? {foo-tcl ns-eval} 0-0-0-0-0-1-G=1,p=0 -? {foo-via-initcmd} 1-0-0-0-0-1-G=1,p=0 -? {foo nonleaf-eval} 1-0-0-0-0-1-G=1,p=0 -? {foo objscoped-eval} 1-1-0-0-0-0-G=0,p=0 -? {foo plain-eval} 0-0-0-1-0-0-G=0,p=1 -? {foo-tcl eval} 0-0-0-1-0-0-G=0,p=1 -? {foo-tcl ns-eval} 0-0-0-0-0-1-G=1,p=0 - ################################################## # dotCmd tests ##################################################