Index: generic/xotcl.c =================================================================== diff -u -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 -r4bed7e95551d4d44fa8348c9f18e22dae85423fe --- generic/xotcl.c (.../xotcl.c) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) +++ generic/xotcl.c (.../xotcl.c) (revision 4bed7e95551d4d44fa8348c9f18e22dae85423fe) @@ -3489,7 +3489,7 @@ for (m = startCl->opt->isClassMixinOf; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ - assert(Tcl_Command_cmdEpoch(m->cmdPtr) == NULL); + assert(Tcl_Command_cmdEpoch(m->cmdPtr) == 0); cl = XOTclGetClassFromCmdPtr(m->cmdPtr); assert(cl); @@ -3512,7 +3512,7 @@ for (m = startCl->opt->isObjectMixinOf; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ - assert(Tcl_Command_cmdEpoch(m->cmdPtr) == NULL); + assert(Tcl_Command_cmdEpoch(m->cmdPtr) == 0); object = XOTclGetObjectFromCmdPtr(m->cmdPtr); assert(object); @@ -3574,7 +3574,7 @@ for (m = startCl->opt->isClassMixinOf; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ - assert(Tcl_Command_cmdEpoch(m->cmdPtr) == NULL); + assert(Tcl_Command_cmdEpoch(m->cmdPtr) == 0); cl = XOTclGetClassFromCmdPtr(m->cmdPtr); assert(cl); @@ -3613,7 +3613,7 @@ for (m = startCl->opt->classmixins; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ - assert(Tcl_Command_cmdEpoch(m->cmdPtr) == NULL); + assert(Tcl_Command_cmdEpoch(m->cmdPtr) == 0); cl = XOTclGetClassFromCmdPtr(m->cmdPtr); assert(cl); @@ -3882,11 +3882,11 @@ XOTclClass *cls; int result = TCL_OK; - assert(obj); - assert(obj->mixinStack); + assert(object); + assert(object->mixinStack); /* ensure that the mixin order is not invalid, otherwise compute order */ - assert(obj->flags & XOTCL_MIXIN_ORDER_VALID); + assert(object->flags & XOTCL_MIXIN_ORDER_VALID); /*MixinComputeDefined(interp, obj);*/ cmdList = seekCurrent(object->mixinStack->currentCmdPtr, object->mixinOrder); RUNTIME_STATE(interp)->cmdPtr = cmdList ? cmdList->cmdPtr : NULL; @@ -5432,7 +5432,7 @@ #endif assert(object); - assert(!object->teardown); + assert(object->teardown); #if defined(TCL85STACK_TRACE) fprintf(stderr, "+++ ProcMethodDispatch %s, cscPtr %p, frametype %d, teardown %p\n", @@ -5633,7 +5633,7 @@ #endif assert(object); - assert(!object->teardown); + assert(object->teardown); #if defined(TCL85STACK_TRACE) fprintf(stderr, "+++ CmdMethodDispatchCheck %s, obj %p %s, cscPtr %p, teardown %p\n", @@ -5728,7 +5728,7 @@ int result; - assert (!obj->teardown); + assert (object->teardown); /*fprintf(stderr, "MethodDispatch method '%s' cmd %p cp=%p objc=%d\n", methodName, cmd, cp, objc);*/ if (proc == TclObjInterpProc) { @@ -6204,7 +6204,9 @@ static int convertToInteger(Tcl_Interp *interp, Tcl_Obj *objPtr, XOTclParam CONST *pPtr, ClientData *clientData, Tcl_Obj **outObjPtr) { int result, i; + result = Tcl_GetIntFromObj(interp, objPtr, &i); + if (result == TCL_OK) { *clientData = (ClientData)INT2PTR(i); *outObjPtr = objPtr; @@ -7047,7 +7049,7 @@ XOTclObject *childObject, *tmpObject; Tcl_HashTable slotTable; - assert(obj); + assert(object); Tcl_InitHashTable(&slotTable, TCL_STRING_KEYS); MEM_COUNT_ALLOC("Tcl_InitHashTable", slotTable); @@ -7643,6 +7645,7 @@ static void CleanupInitObject(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl, Tcl_Namespace *namespacePtr, int softrecreate) { + #ifdef OBJDELETION_TRACE fprintf(stderr, "+++ CleanupInitObject\n"); #endif @@ -7744,10 +7747,6 @@ DECR_REF_COUNT(object->cmdName); XOTclCleanupObject(object); -#if !defined(NDEBUG) - if (object != (XOTclObject*)RUNTIME_STATE(interp)->theClass) - checkAllInstances(interp, RUNTIME_STATE(interp)->theClass, 0); -#endif } /* @@ -8091,7 +8090,7 @@ Tcl_Interp *interp; Tcl_Namespace *saved; - PRINTOBJ("PrimitiveCDestroy", obj); + PRINTOBJ("PrimitiveCDestroy", object); /* * check and latch against recurrent calls with obj->teardown @@ -8106,11 +8105,11 @@ if (Tcl_InterpDeleted(interp)) return; /* - * call and latch user destroy with obj->id if we haven't + * call and latch user destroy with object->id if we haven't */ - /*fprintf(stderr, "PrimitiveCDestroy %s flags %.6x\n", objectName(obj), obj->flags);*/ + /*fprintf(stderr, "PrimitiveCDestroy %s flags %.6x\n", objectName(object), object->flags);*/ - object->teardown = 0; + object->teardown = NULL; CleanupDestroyClass(interp, cl, 0, 0); /* @@ -8175,7 +8174,7 @@ /* fprintf(stderr, " +++ CLS alloc: %s\n", nameString); */ - assert(isAbsolutePathnameString); + assert(isAbsolutePath(nameString)); length = strlen(nameString); /* fprintf(stderr, "Class alloc %p '%s'\n", cl, nameString); @@ -8206,7 +8205,7 @@ XOTCLINLINE static int changeClass(Tcl_Interp *interp, XOTclObject *object, XOTclClass *cl) { - assert(obj); + assert(object); /*fprintf(stderr, "changing %s to class %s ismeta %d\n", objectName(obj), @@ -8805,8 +8804,9 @@ if (cd->paramsPtr && objc == 2) { Tcl_Obj *outObjPtr; - int result, flags; + int result, flags = 0; ClientData checkedData; + result = ArgumentCheck(interp, objv[1], cd->paramsPtr, &flags, &checkedData, &outObjPtr); if (result == TCL_OK) { @@ -9452,8 +9452,7 @@ * registration. etc. If we would use this namespace, we would * resolve non-fully-qualified names against ::xotcl). */ - for (framePtr = activeProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp), - FRAME_IS_XOTCL_OBJECT|FRAME_IS_XOTCL_CMETHOD); + for (framePtr = activeProcFrame((Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp)); framePtr; framePtr = Tcl_CallFrame_callerVarPtr(framePtr)) { nsPtr = Tcl_CallFrame_nsPtr(framePtr); @@ -12390,10 +12389,12 @@ if (cl) { result = XOTclAddClassMethod(interp, (XOTcl_Class *)cl, methodName, - (Tcl_ObjCmdProc*)XOTclSetterMethod, (ClientData)setterClientData, setterCmdDeleteProc, 0); + (Tcl_ObjCmdProc*)XOTclSetterMethod, + (ClientData)setterClientData, setterCmdDeleteProc, 0); } else { result = XOTclAddObjectMethod(interp, (XOTcl_Object *)object, methodName, - (Tcl_ObjCmdProc*)XOTclSetterMethod, (ClientData)setterClientData, setterCmdDeleteProc, 0); + (Tcl_ObjCmdProc*)XOTclSetterMethod, + (ClientData)setterClientData, setterCmdDeleteProc, 0); } if (result == TCL_OK) { result = ListMethodName(interp, object, cl == NULL, methodName); @@ -14125,11 +14126,11 @@ /*fprintf(stderr, "checkallinstances %d cl=%p '%s'\n", lvl, cl, className(cl));*/ for (hPtr = Tcl_FirstHashEntry(&cl->instances, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { - XOTclObject *interpst = (XOTclObject*) Tcl_GetHashKey(&cl->instances, hPtr); + XOTclObject *inst = (XOTclObject*) Tcl_GetHashKey(&cl->instances, hPtr); assert(inst); assert(inst->refCount>0); assert(inst->cmdName->refCount>0); - if (XOTclObjectIsClass(inst) && (XOTclClass*)inst != RUNTIME_STATE(interp)->theClass) { + if (XOTclObjectIsClass(inst)) { checkAllInstances(interp, (XOTclClass*) inst, lvl+1); } } Index: generic/xotcl.h =================================================================== diff -u -r2880a345930ceabfec83d491f26b8254099c8991 -r4bed7e95551d4d44fa8348c9f18e22dae85423fe --- generic/xotcl.h (.../xotcl.h) (revision 2880a345930ceabfec83d491f26b8254099c8991) +++ generic/xotcl.h (.../xotcl.h) (revision 4bed7e95551d4d44fa8348c9f18e22dae85423fe) @@ -53,8 +53,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: generic/xotclStack85.c =================================================================== diff -u -rf3a84ed90cf24565e3bae87abfe8185acc0e9cc4 -r4bed7e95551d4d44fa8348c9f18e22dae85423fe --- generic/xotclStack85.c (.../xotclStack85.c) (revision f3a84ed90cf24565e3bae87abfe8185acc0e9cc4) +++ generic/xotclStack85.c (.../xotclStack85.c) (revision 4bed7e95551d4d44fa8348c9f18e22dae85423fe) @@ -116,7 +116,7 @@ */ static Tcl_CallFrame * -activeProcFrame(Tcl_CallFrame *framePtr, int skipFrames) { +activeProcFrame(Tcl_CallFrame *framePtr) { for (; framePtr; framePtr = Tcl_CallFrame_callerPtr(framePtr)) { register int flag = Tcl_CallFrame_isProcCallFrame(framePtr); @@ -125,7 +125,7 @@ if (!(((XOTclCallStackContent *)Tcl_CallFrame_clientData(framePtr))->frameType & XOTCL_CSC_TYPE_INACTIVE)) break; } else { - if (flag & skipFrames) continue; + if (flag & (FRAME_IS_XOTCL_CMETHOD|FRAME_IS_XOTCL_OBJECT)) continue; if (flag == 0 || flag & FRAME_IS_PROC) break; } } @@ -258,8 +258,7 @@ tcl85showStack(interp); # endif /* Get the first active non object frame */ - framePtr = activeProcFrame(inFramePtr, - FRAME_IS_XOTCL_CMETHOD|FRAME_IS_XOTCL_OBJECT); + framePtr = activeProcFrame(inFramePtr); /*fprintf(stderr,"... use frameptr %p \n", framePtr);*/ Index: tests/parameters.xotcl =================================================================== diff -u -re991034eda7c58e579d40878c82116765d72e00b -r4bed7e95551d4d44fa8348c9f18e22dae85423fe --- tests/parameters.xotcl (.../parameters.xotcl) (revision e991034eda7c58e579d40878c82116765d72e00b) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 4bed7e95551d4d44fa8348c9f18e22dae85423fe) @@ -712,7 +712,6 @@ C create c1 -mixin M Object create o - #puts stderr ===== Class create ParamTest -parameter { o:object c:class @@ -734,7 +733,6 @@ return $(oparam) } - #puts stderr =====2 ? {::parameterFromSlot ParamTest o} "o:object,slot=::ParamTest::slot::o" ? {::parameterFromSlot ParamTest c} "c:class,slot=::ParamTest::slot::c" ? {::parameterFromSlot ParamTest c1} "c1:class,type=::MC,slot=::ParamTest::slot::c1" @@ -744,7 +742,6 @@ ? {::parameterFromSlot ParamTest x} "x:object,multivalued,slot=::ParamTest::slot::x o" ? {::parameterFromSlot ParamTest u} "u:upper,slot=::ParamTest::slot::u" ? {::parameterFromSlot ParamTest us} "us:upper,multivalued,slot=::ParamTest::slot::us" - #puts stderr =====3 ? {ParamTest create p -o o} ::p ? {ParamTest create p -o xxx} \ @@ -783,26 +780,15 @@ } ? {ParamTest create p -us {A B}} ::p ? {p us add C end} "A B C" - - # TODO: naming "type" not perfect. - # maybe "type" => "hastype" - # => effects as well ::xotcl::is - # - # TODO (optimization): optimizer can improve parameter checking: - # (a) simple approach: make scripted setter methods on domain - # (b) maybe nicer: provide arguments to c-setter to - # pass parameter definition - # - # TODO: error messages for failed conversions are not consistent - # should happen, when all kind of parameters finally settled - # + ? {p o o} \ "o" \ "value is an object" + ? {p o xxx} \ {expected object but got "xxx" for parameter o} \ "value is not an object" - + ParamTest slots { ::xotcl::Attribute create os -type object -multivalued true } @@ -928,9 +914,10 @@ ? {o info method definition o} "::o setter o:object" ? {o info method parameter o} "o:object" ? {o info method args o} "o" - + ? {o a 2} 2 ? {o a hugo} {expected integer but got "hugo" for parameter a} + ? {o ints {10 100 1000}} {10 100 1000} ? {o ints hugo} {invalid value in "hugo": expected integer but got "hugo" for parameter ints} ? {o o o} o