Index: generic/predefined.h =================================================================== diff -u -r904066a25731aa8264c0e307dc3026b6ca17678c -r675e28583d105313f7fbc1dad66d2696c18b19f4 --- generic/predefined.h (.../predefined.h) (revision 904066a25731aa8264c0e307dc3026b6ca17678c) +++ generic/predefined.h (.../predefined.h) (revision 675e28583d105313f7fbc1dad66d2696c18b19f4) @@ -14,6 +14,9 @@ "Class method unknown {args} {\n" "puts stderr \"use '[self] create $args', not '[self] $args'\"\n" "eval my create $args}\n" +"Object method unknown {m args} {\n" +"if {![self isnext]} {\n" +"error \"[self]: unable to dispatch method '$m'\"}}\n" "Object method init args {}\n" "Object method objectparameter {} {;}\n" "Class create ParameterType\n" @@ -73,6 +76,9 @@ "::xotcl::methodproperty ::xotcl::Class create static true\n" "::xotcl::Class method unknown {args} {\n" "eval my create $args}\n" +"::xotcl::Object method unknown {m args} {\n" +"if {![self isnext]} {\n" +"error \"[self]: unable to dispatch method '$m'\"}}\n" "::xotcl::Object method init args {}\n" "::xotcl::Object method objectparameter {} {;}\n" "::xotcl::Class create ::xotcl::ParameterType\n" Index: generic/predefined.xotcl =================================================================== diff -u -r904066a25731aa8264c0e307dc3026b6ca17678c -r675e28583d105313f7fbc1dad66d2696c18b19f4 --- generic/predefined.xotcl (.../predefined.xotcl) (revision 904066a25731aa8264c0e307dc3026b6ca17678c) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision 675e28583d105313f7fbc1dad66d2696c18b19f4) @@ -28,6 +28,11 @@ puts stderr "use '[self] create $args', not '[self] $args'" eval my create $args } + Object method unknown {m args} { + if {![self isnext]} { + error "[self]: unable to dispatch method '$m'" + } + } # "init" must exist on Object. per default it is empty. Object method init args {} @@ -175,6 +180,12 @@ eval my create $args } +::xotcl::Object method unknown {m args} { + if {![self isnext]} { + error "[self]: unable to dispatch method '$m'" + } +} + # "init" must exist on Object. per default it is empty. ::xotcl::Object method init args {} Index: generic/xotcl.c =================================================================== diff -u -r904066a25731aa8264c0e307dc3026b6ca17678c -r675e28583d105313f7fbc1dad66d2696c18b19f4 --- generic/xotcl.c (.../xotcl.c) (revision 904066a25731aa8264c0e307dc3026b6ca17678c) +++ generic/xotcl.c (.../xotcl.c) (revision 675e28583d105313f7fbc1dad66d2696c18b19f4) @@ -5729,12 +5729,14 @@ unknown = 1; } + /*fprintf(stderr, "cmd %p unknown %d result %d\n", cmd, unknown, result);*/ + if (result == TCL_OK) { /*fprintf(stderr, "after doCallProcCheck unknown == %d\n", unknown);*/ if (unknown) { Tcl_Obj *unknownObj = XOTclGlobalObjects[XOTE_UNKNOWN]; - if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { + if (/*XOTclObjectIsClass(obj) &&*/ (flags & XOTCL_CM_NO_UNKNOWN)) { return XOTclVarErrMsg(interp, objectName(obj), ": unable to dispatch method '", methodName, "'", (char *) NULL); @@ -5743,20 +5745,22 @@ * back off and try unknown; */ XOTclObject *obj = (XOTclObject*)clientData; - ALLOC_ON_STACK(Tcl_Obj*, objc+1, tov); - /* - fprintf(stderr, "calling unknown for %s %s, flgs=%02x,%02x isClass=%d %p %s\n", - objectName(obj), methodName, flags, XOTCL_CM_NO_UNKNOWN, - XOTclObjectIsClass(obj), obj, objectName(obj)); - */ + ALLOC_ON_STACK(Tcl_Obj*, objc+2, tov); + + /*fprintf(stderr, "calling unknown for %s %s, flgs=%02x,%02x isClass=%d %p %s objc %d shift %d\n", + objectName(obj), methodName, flags, XOTCL_CM_NO_UNKNOWN, + XOTclObjectIsClass(obj), obj, objectName(obj), objc, shift);*/ + tov[0] = obj->cmdName; tov[1] = unknownObj; - if (objc>1) /*shift?*/ + if (objc-shift>0) { memcpy(tov+2, objv+shift, sizeof(Tcl_Obj *)*(objc-shift)); + } /* fprintf(stderr, "?? %s unknown %s\n", objectName(obj), ObjStr(tov[2])); */ - result = DoDispatch(clientData, interp, objc+shift, tov, flags | XOTCL_CM_NO_UNKNOWN); + flags &= ~XOTCL_CM_NO_SHIFT; + result = DoDispatch(clientData, interp, objc+2-shift, tov, flags | XOTCL_CM_NO_UNKNOWN); FREE_ON_STACK(tov); } else { /* unknown failed */ @@ -10058,7 +10062,7 @@ return XOTclVarErrMsg(interp, "Cannot resolve 'self', probably called outside the context of an XOTcl Object", (char *) NULL); } - /*fprintf(stderr, "dispatch %s on %s\n",ObjStr(nobjv[0]), objectName(self));*/ + fprintf(stderr, "dispatch %s on %s\n",ObjStr(nobjv[0]), objectName(self)); return DoDispatch(self, interp, nobjc, nobjv, XOTCL_CM_NO_SHIFT); } Index: tests/testx.xotcl =================================================================== diff -u -r558ed9bfabea39f0688b9abe854f6eb7db9f0167 -r675e28583d105313f7fbc1dad66d2696c18b19f4 --- tests/testx.xotcl (.../testx.xotcl) (revision 558ed9bfabea39f0688b9abe854f6eb7db9f0167) +++ tests/testx.xotcl (.../testx.xotcl) (revision 675e28583d105313f7fbc1dad66d2696c18b19f4) @@ -3095,12 +3095,12 @@ ::errorCheck [b info procs] objproc "info procs" ::errorCheck [B info instprocs] myProc2 "info instprocs" - ::errorCheck [lsort [b info methods]] "__next abstract append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg f filter filterguard filtersearch forward hasclass incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objectparameter objproc parametercmd proc procsearch requireNamespace residualargs self set setFilter signature subst trace unset uplevel upvar volatile vwait" "b info methods" + ::errorCheck [lsort [b info methods]] "__next abstract append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg f filter filterguard filtersearch forward hasclass incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move myProc myProc2 myProcMix1 myProcMix2 noinit objectparameter objproc parametercmd proc procsearch requireNamespace residualargs self set setFilter signature subst trace unknown unset uplevel upvar volatile vwait" "b info methods" - ::errorCheck [lsort [b info methods -nocmds]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype move myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc proc self setFilter signature" "b info methods -nocmds" + ::errorCheck [lsort [b info methods -nocmds]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype move myProc myProc2 myProcMix1 myProcMix2 objectparameter objproc proc self setFilter signature unknown" "b info methods -nocmds" ::errorCheck [lsort [b info methods -noprocs]] "__next append array autoname check class cleanup configure destroy eval exists filter filterguard filtersearch forward incr info instvar invar lappend method mixin mixinguard noinit parametercmd procsearch requireNamespace residualargs set subst trace unset uplevel upvar volatile vwait" "b info methods -noprocs" - ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype move myProc myProc2 objectparameter objproc proc self setFilter signature" "b info methods -nocmds -nomixins" + ::errorCheck [lsort [b info methods -nocmds -nomixins]] "abstract contains copy defaultmethod extractConfigureArg f hasclass init isclass ismetaclass ismixin isobject istype move myProc myProc2 objectparameter objproc proc self setFilter signature unknown" "b info methods -nocmds -nomixins" ::errorCheck [b info methods -nocmds -noprocs] "" "b info methods -nocmds -noprocs" @@ -3495,9 +3495,9 @@ set ::context payrollApp - ::errorCheck [lsort [jim info methods]] "__next abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy driving-license eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unset uplevel upvar volatile vwait" "condmixin all methods" + ::errorCheck [lsort [jim info methods]] "__next abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy driving-license eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "condmixin all methods" - ::errorCheck "[lsort [jim info methods -incontext]]" "__next abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unset uplevel upvar volatile vwait" "all methods in context" + ::errorCheck "[lsort [jim info methods -incontext]]" "__next abstract age append array autoname check class cleanup configure contains copy defaultmethod destroy eval exists extractConfigureArg filter filterguard filtersearch forward hasclass id incr info init instvar invar isclass ismetaclass ismixin isobject istype lappend method mixin mixinguard move name noinit objectparameter parametercmd print proc procsearch requireNamespace residualargs salary self set signature subst trace unknown unset uplevel upvar volatile vwait" "all methods in context" ::errorCheck [my show payrollApp jim] "{payrollApp: jim info methods salary => salary} {payrollApp: jim info methods -incontext salary => salary} {payrollApp: jim info methods driv* => driving-license} {payrollApp: jim info methods -incontext driv* => }" "payrollApp jim" ::errorCheck [my show shipmentApp jim] "{shipmentApp: jim info methods salary => salary} {shipmentApp: jim info methods -incontext salary => } {shipmentApp: jim info methods driv* => driving-license} {shipmentApp: jim info methods -incontext driv* => driving-license}" "shipmentApp jim"