Index: xotcl/ChangeLog =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/ChangeLog (.../ChangeLog) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/ChangeLog (.../ChangeLog) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,6 +1,13 @@ +2004-11-18 Gustaf.Neumann@wu-wien.ac.at + * changed internal communication between end-of-filterchanin + and "unknown" to flag instead of return code XOTCL_UNKNOWN + * fixed [self callinglevel] in nested uplevel loops + (many thanks to MichaelL@frogware.com for reporting the problem) + 2004-11-14 Gustaf.Neumann@wu-wien.ac.at * fixed yet another free memory read (many thanks for Zoran for help with purify) + 2004-11-13 Gustaf.Neumann@wu-wien.ac.at * fixed entries for aolserver in configure.in (many thanks for Zoran reporting this problem) Index: xotcl/Makefile =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/Makefile (.../Makefile) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/Makefile (.../Makefile) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile,v 1.24 2004/11/14 17:36:36 neumann Exp $ +# RCS: @(#) $Id: Makefile,v 1.25 2004/11/19 01:41:32 neumann Exp $ #======================================================================== # Add additional lines to handle any additional AC_SUBST cases that @@ -120,7 +120,7 @@ PACKAGE_NAME = xotcl PACKAGE_VERSION = 1.3.3 CC = gcc -pipe -CFLAGS_DEFAULT = -O +CFLAGS_DEFAULT = -O -g CFLAGS_WARNING = -Wall -Wconversion -Wno-implicit-int CLEANFILES = *.o *.a *.so *~ core gmon.out config.* EXEEXT = Index: xotcl/doc/xo-daemon.html =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/doc/xo-daemon.html (.../xo-daemon.html) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/doc/xo-daemon.html (.../xo-daemon.html) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -76,7 +76,7 @@ Date: - [::xotcl::rcs date {$Date: 2004/11/14 17:36:36 $}] + [::xotcl::rcs date {$Date: 2004/11/19 01:41:32 $}] Index: xotcl/doc/xo-whichPkg.html =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -52,7 +52,7 @@ Date: - [::xotcl::rcs date {$Date: 2004/11/14 17:36:36 $}] + [::xotcl::rcs date {$Date: 2004/11/19 01:41:32 $}] Index: xotcl/generic/xotcl.c =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/generic/xotcl.c (.../xotcl.c) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/generic/xotcl.c (.../xotcl.c) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,4 +1,4 @@ -/* $Id: xotcl.c,v 1.29 2004/11/14 17:36:36 neumann Exp $ +/* $Id: xotcl.c,v 1.30 2004/11/19 01:41:32 neumann Exp $ * * XOTcl - Extended OTcl * @@ -1725,7 +1725,9 @@ XOTclCallStackContent * XOTclCallStackFindLastInvocation(Tcl_Interp *in, int offset) { XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; - register XOTclCallStackContent *csc = CallStackGetFrame(in); + register XOTclCallStackContent *csc = cs->top; + int topLevel = csc->currentFramePtr ? Tcl_CallFrame_level(csc->currentFramePtr) :0; + int deeper = offset; /* skip through toplevel inactive filters, do this offset times */ for (csc=cs->top; csc > cs->content; csc--) { @@ -1734,8 +1736,10 @@ continue; if (offset) offset--; - else - return csc; + else { + if (!deeper || Tcl_CallFrame_level(csc->currentFramePtr) != topLevel) + return csc; + } } /* for some reasons, we could not find invocation (topLevel, destroy) */ return NULL; @@ -4082,8 +4086,8 @@ XOTCLINLINE static int DoDispatch(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[], int flags) { register XOTclObject *obj = (XOTclObject*)cd; - int result, mixinStackPushed = 0, - filterStackPushed = 0, + int result = TCL_OK, mixinStackPushed = 0, + filterStackPushed = 0, unknown, frameType = XOTCL_CSC_TYPE_PLAIN; #ifdef OBJDELETION_TRACE Tcl_Obj *method; @@ -4101,7 +4105,6 @@ int isNext; #endif - assert(objc>0); methodName = callMethod = ObjStr(objv[1]); @@ -4207,41 +4210,54 @@ } } - if (proc && ((result = DoCallProcCheck(cp, cd, in, objc, objv, cmd, obj, cl, - callMethod, frameType, 0 /* fromNext */)) - != XOTCL_UNKNOWN)) { - if (result == TCL_ERROR) - XOTclErrInProc(in, cmdName, cl ? cl->object.cmdName : NULL, callMethod); + if (proc) { + result = DoCallProcCheck(cp, cd, in, objc, objv, cmd, obj, cl, + callMethod, frameType, 0 /* fromNext */); + if (result == TCL_ERROR) { + XOTclErrInProc(in, cmdName, cl ? cl->object.cmdName : NULL, callMethod); + } + unknown = RUNTIME_STATE(in)->unknown; + } else { + unknown = 1; + } + + if (result == TCL_OK) { + /*fprintf(stderr,"after doCallProcCheck unknown == %d\n",unknown);*/ + if (unknown) { - } else if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { - Tcl_AppendResult(in, ObjStr(objv[0]), ": unable to dispatch method '", - callMethod, "'", 0); - result = TCL_ERROR; - } else if (objv[1] != XOTclGlobalObjects[UNKNOWN]) { - /* - * back off and try unknown; - */ - XOTclObject *obj = (XOTclObject*)cd; - ALLOC_ON_STACK(Tcl_Obj*,objc+1, tov); - /* - fprintf(stderr,"calling unknown for %s %s ... flags=%02x,%02x isClass=%d %p %s\n", - ObjStr(obj->cmdName), ObjStr(objv[1]), flags, XOTCL_CM_NO_UNKNOWN, - XOTclObjectIsClass(obj), obj, ObjStr(obj->cmdName)); - */ - tov[0] = obj->cmdName; - tov[1] = XOTclGlobalObjects[UNKNOWN]; - if (objc>1) - memcpy(tov+2, objv+1, sizeof(Tcl_Obj *)*(objc-1)); - /* - fprintf(stderr,"?? %s unknown %s\n",ObjStr(obj->cmdName), ObjStr(tov[2])); - */ - result = DoDispatch(cd, in, objc+1, tov, flags | XOTCL_CM_NO_UNKNOWN); - FREE_ON_STACK(tov); - - } else { /* unknown failed */ - Tcl_AppendResult(in, ObjStr(objv[0]), ": unable to dispatch method '", - ObjStr(objv[2]), "'", 0); - result = TCL_ERROR; + if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { + Tcl_AppendResult(in, ObjStr(objv[0]), ": unable to dispatch method '", + callMethod, "'", 0); + result = TCL_ERROR; + } else if (objv[1] != XOTclGlobalObjects[UNKNOWN]) { + /* + * back off and try unknown; + */ + XOTclObject *obj = (XOTclObject*)cd; + ALLOC_ON_STACK(Tcl_Obj*,objc+1, tov); + /* + fprintf(stderr,"calling unknown for %s %s, flgs=%02x,%02x isClass=%d %p %s\n", + ObjStr(obj->cmdName), ObjStr(objv[1]), flags, XOTCL_CM_NO_UNKNOWN, + XOTclObjectIsClass(obj), obj, ObjStr(obj->cmdName)); + */ + tov[0] = obj->cmdName; + tov[1] = XOTclGlobalObjects[UNKNOWN]; + if (objc>1) + memcpy(tov+2, objv+1, sizeof(Tcl_Obj *)*(objc-1)); + /* + fprintf(stderr,"?? %s unknown %s\n",ObjStr(obj->cmdName), ObjStr(tov[2])); + */ + result = DoDispatch(cd, in, objc+1, tov, flags | XOTCL_CM_NO_UNKNOWN); + FREE_ON_STACK(tov); + + } else { /* unknown failed */ + Tcl_AppendResult(in, ObjStr(objv[0]), ": unable to dispatch method '", + ObjStr(objv[2]), "'", 0); + result = TCL_ERROR; + } + /* be sure to reset unknown flag */ + RUNTIME_STATE(in)->unknown = 0; + } } #ifdef DISPATCH_TRACE @@ -4296,7 +4312,6 @@ result = DoDispatch(cd, in, objc, objv, flags); } - assert(result != XOTCL_UNKNOWN); return result; } @@ -5372,7 +5387,8 @@ else if (csc->frameType == XOTCL_CSC_TYPE_INACTIVE_MIXIN) csc->frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; } else if (result == TCL_OK && endOfFilterChain) { - result = XOTCL_UNKNOWN; + /*fprintf(stderr,"setting unknown to 1\n");*/ + RUNTIME_STATE(in)->unknown = 1; } return result; @@ -5495,19 +5511,24 @@ default: csc = NULL; } - /*XOTclCallStackDump(in);*/ if (cs->top->currentFramePtr == ((Tcl_CallFrame *)Tcl_Interp_varFramePtr(in)) && csc && csc < cs->top && csc->currentFramePtr) { /* this was from an xotcl frame, return absolute frame number */ char buffer[LONG_AS_STRING]; int l; buffer[0] = '#'; + /* + if (Tcl_CallFrame_callerVarPtr(csc->currentFramePtr)) { + cf = Tcl_CallFrame_callerVarPtr(csc->currentFramePtr); + }*/ XOTcl_ltoa(buffer+1,(long)Tcl_CallFrame_level(csc->currentFramePtr),&l); resultObj = Tcl_NewStringObj(buffer,l+1); } else { /* If not called from an xotcl frame, return 1 as default */ resultObj = Tcl_NewIntObj(1); } + /*XOTclStackDump(in);XOTclCallStackDump(in);*/ + return resultObj; } Index: xotcl/generic/xotcl.h =================================================================== diff -u -r55c33d4f309c661c404d79a77168110864e7258a -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/generic/xotcl.h (.../xotcl.h) (revision 55c33d4f309c661c404d79a77168110864e7258a) +++ xotcl/generic/xotcl.h (.../xotcl.h) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,6 +1,6 @@ /* -*- Mode: c++ -*- * - * $Id: xotcl.h,v 1.6 2004/11/14 17:36:36 neumann Exp $ + * $Id: xotcl.h,v 1.7 2004/11/19 01:41:32 neumann Exp $ * * Extended Object Tcl (XOTcl) * @@ -52,8 +52,8 @@ /* activate/deacticate assert #define NDEBUG 1 */ +#define NDEBUG 1 - /* activate/deacticate memory tracing #define XOTCL_MEM_TRACE 1 #define XOTCL_MEM_COUNT 1 Index: xotcl/generic/xotclInt.h =================================================================== diff -u -r8c47264f39e2e6a65fc0c23d8d856a47cdf27fc4 -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/generic/xotclInt.h (.../xotclInt.h) (revision 8c47264f39e2e6a65fc0c23d8d856a47cdf27fc4) +++ xotcl/generic/xotclInt.h (.../xotclInt.h) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,5 +1,5 @@ /* -*- Mode: c++ -*- - * $Id: xotclInt.h,v 1.10 2004/11/14 01:07:17 neumann Exp $ + * $Id: xotclInt.h,v 1.11 2004/11/19 01:41:32 neumann Exp $ * Extended Object Tcl (XOTcl) * * Copyright (C) 1999-2002 Gustaf Neumann, Uwe Zdun @@ -261,7 +261,7 @@ # endif #endif -#if 0 +#if 1 #define XOTcl_FrameDecls CallFrame *oldFramePtr = 0, frame, *newFramePtr = &frame #define XOTcl_PushFrame(in,obj) \ memset(newFramePtr, 0, sizeof(CallFrame)); \ @@ -322,7 +322,6 @@ /* TCL_CONTINUE is defined as 4, from 5 on we can use app-specific return codes */ -#define XOTCL_UNKNOWN 5 #define XOTCL_CHECK_FAILED 6 /* flags for call method */ @@ -612,6 +611,7 @@ int errorCount; int callDestroy; int callIsDestroy; + int unknown; int exitHandlerDestroyRound; int returnCode; long newCounter; Index: xotcl/generic/xotclTrace.c =================================================================== diff -u -rae1eaf81cb417f648c39d1de1152d15fbdf2d36e -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/generic/xotclTrace.c (.../xotclTrace.c) (revision ae1eaf81cb417f648c39d1de1152d15fbdf2d36e) +++ xotcl/generic/xotclTrace.c (.../xotclTrace.c) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,5 +1,5 @@ /* -*- Mode: c++ -*- - * $Id: xotclTrace.c,v 1.5 2004/07/28 08:01:25 neumann Exp $ + * $Id: xotclTrace.c,v 1.6 2004/11/19 01:41:32 neumann Exp $ * * Extended Object Tcl (XOTcl) * @@ -29,16 +29,18 @@ XOTclNewObj(cmdObj); fprintf(stderr, "\tFrame=%p ", f); if (f && f->isProcCallFrame && f->procPtr && f->procPtr->cmdPtr) { + fprintf(stderr,"caller %p ",Tcl_CallFrame_callerPtr(f)); + fprintf(stderr,"callerV %p ",Tcl_CallFrame_callerVarPtr(f)); Tcl_GetCommandFullName(in, (Tcl_Command) f->procPtr->cmdPtr, cmdObj); - fprintf(stderr, " %s (%p) lvl=%d\n", ObjStr(cmdObj), f->procPtr->cmdPtr, f->level); + fprintf(stderr, "%s (%p) lvl=%d\n", ObjStr(cmdObj), f->procPtr->cmdPtr, f->level); DECR_REF_COUNT(cmdObj); } else fprintf(stderr, "- \n"); f = f->callerPtr; } fprintf (stderr, " VARFRAME:\n"); - fprintf(stderr, "\tFrame=%p ", v); + fprintf(stderr, "\tFrame=%p caller %p", v, v->callerPtr); if (v && v->isProcCallFrame && v->procPtr && v->procPtr->cmdPtr) { Tcl_GetCommandFullName(in, (Tcl_Command) v->procPtr->cmdPtr, varCmdObj); if (varCmdObj) { Index: xotcl/tests/testx.xotcl =================================================================== diff -u -r8c47264f39e2e6a65fc0c23d8d856a47cdf27fc4 -rfda7a40548bb07598ac92453064c2d844d6b12da --- xotcl/tests/testx.xotcl (.../testx.xotcl) (revision 8c47264f39e2e6a65fc0c23d8d856a47cdf27fc4) +++ xotcl/tests/testx.xotcl (.../testx.xotcl) (revision fda7a40548bb07598ac92453064c2d844d6b12da) @@ -1,4 +1,4 @@ -#$Id: testx.xotcl,v 1.19 2004/11/14 01:07:17 neumann Exp $ +#$Id: testx.xotcl,v 1.20 2004/11/19 01:41:32 neumann Exp $ package require XOTcl namespace import -force xotcl::* @@ -3390,6 +3390,56 @@ Object instfilter "" D instmixin {} + + Object instproc each {objName body} { + #puts " *** level = [info level] self callinglevel = [self callinglevel]" + uplevel [self callinglevel] [list foreach $objName [lsort [[self] info children]] $body] + } + + Class TestB + Class TestA + TestA instproc init {args} { + next + TestB [self]::b1 + TestB [self]::b2 + TestB [self]::b3 + } + + Class Test + Test instproc init {args} { + next + TestA [self]::a1 + TestA [self]::a2 + TestA [self]::a3 + } + Test instproc loop1 {} { + set i 0 + [self] each a { + incr i + #puts "$a" + } + #puts "Total = $i" + return $i + } + Test instproc loop2 {} { + set i 0 + [self] each a { + incr i + #puts "$a" + $a each b { + incr i + #puts " $b" + } + } + #puts "Total = $i" + return $i + } + + Test t + + errorCheck [t loop1] 3 "uplevel eval loop" + errorCheck [t loop2] 12 "nested uplevel eval loop" + return "PASSED [self]" }