Index: ChangeLog =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- ChangeLog (.../ChangeLog) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ ChangeLog (.../ChangeLog) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -62,12 +62,39 @@ Meta C -superclass O -parameter {a {b -default ""} {c -default 1}} C c1 ;# c1 has no no default value for "a", before it had one ====== + +2009-07-07 + + - based introspection for procs/instprocs on new argument definition + structures + + - allowing type checkers also for positional arguments + (for now only, when nonpos args are given as well; we have + to think about using these either for all procs/instprocs, + or only, when e.g. type checkers are used; we have to + make more benchmarking to get a better foundation) + + - registered the following type checkers for procs/instprocs: + switch, integer, boolean, object, class + + Example + o proc bar {-enable:switch o:object c:class} { + return "o=$o c=$c" + } + + - generated interface for ::xotcl::configure; now 97 interfaces are + generated; shortcoming for bool/int converter stubs: optional + 0-vaues are not recognized, so use tclobj for the time being + + - extended regression test + + - from 15356 generic/xotcl.c => 13097 + 2009-07-06 - parse non-pos-args for procs/instprocs into new argument definition structure - using new parseObjv for calling procs and instproc when nonpos-args are used (invocation time went from 9.08ms to 5.95ms) - - TODO: complete implementation for regression test, base introspection/copy etc. - on new structures + - TODO: base introspection/copy etc. on new structures 2009-07-04 - removed compatibility for versions before Tcl 8.4 (was not tested anyhow) Index: generic/gentclAPI.decls =================================================================== diff -u -r321a21cbb0beec854bfc651e167c32ded2707a3a -recc8a110c338877202b900868da32eb8dcd561ad --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision 321a21cbb0beec854bfc651e167c32ded2707a3a) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -24,6 +24,10 @@ {-argName "-protected"} {-argName "cmdName" -required 1 -type tclobj} } +xotclCmd configure XOTclConfigureCmd { + {-argName "configureoption" -required 1 -type "filter|softrecreate"} + {-argName "value" -required 0 -type tclobj} +} xotclCmd methodproperty XOTclMethodPropertyCmd { {-argName "object" -required 1 -type object} {-argName "methodName" -required 1} Index: generic/gentclAPI.tcl =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ generic/gentclAPI.tcl (.../gentclAPI.tcl) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -43,6 +43,7 @@ } switch -glob $type { "NULL" {set converter String} + "boolean" {set converter Boolean} "class" {set converter Class} "object" {set converter Object} "tclobj" {set converter Tclobj} @@ -112,6 +113,7 @@ set calledArg $varName switch -glob $(-type) { "" {set type "char *"} + "boolean" {set type "int "} "class" {set type "XOTclClass *"} "object" {set type "XOTclObject *"} "tclobj" {set type "Tcl_Obj *"} @@ -192,7 +194,7 @@ static int $d(stub)(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { $intro - if (parseObjv(interp, objc, objv, 1, &(method_definitions[$d(idx)].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[$d(idx)].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { $cDefs @@ -213,7 +215,7 @@ argDefinition ifd[10]; } methodDefinition; -static int parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int start, +static int parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Obj *procName, argDefinition CONST *ifdPtr, parseContext *pc); static int getMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj, Index: generic/tclAPI.h =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- generic/tclAPI.h (.../tclAPI.h) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ generic/tclAPI.h (.../tclAPI.h) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -1,4 +1,10 @@ +static int convertToConfigureoption(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + static CONST char *opts[] = {"filter", "softrecreate", NULL}; + return Tcl_GetIndexFromObj(interp, objPtr, opts, "configureoption", 0, (int *)clientData); +} +enum configureoptionIdx {configureoptionFilterIdx, configureoptionSoftrecreateIdx}; + static int convertToMethodproperty(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { static CONST char *opts[] = {"protected", "public", "slotobj", NULL}; return Tcl_GetIndexFromObj(interp, objPtr, opts, "methodproperty", 0, (int *)clientData); @@ -19,7 +25,7 @@ argDefinition ifd[10]; } methodDefinition; -static int parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int start, +static int parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Obj *procName, argDefinition CONST *ifdPtr, parseContext *pc); static int getMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj, @@ -127,6 +133,7 @@ static int XOTclOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclOVwaitMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclConfigureCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclMethodPropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclMyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); @@ -224,6 +231,7 @@ static int XOTclOVolatileMethod(Tcl_Interp *interp, XOTclObject *obj); static int XOTclOVwaitMethod(Tcl_Interp *interp, XOTclObject *obj, char *varname); static int XOTclAliasCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withObjscope, int withPer_object, int withProtected, Tcl_Obj *cmdName); +static int XOTclConfigureCmd(Tcl_Interp *interp, int configureoption, Tcl_Obj *value); static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withPer_object, int methodproperty, Tcl_Obj *value); static int XOTclMyCmd(Tcl_Interp *interp, int withLocal, Tcl_Obj *method, int nobjc, Tcl_Obj *CONST nobjv[]); static int XOTclRelationCmd(Tcl_Interp *interp, XOTclObject *object, int relationtype, Tcl_Obj *value); @@ -322,6 +330,7 @@ XOTclOVolatileMethodIdx, XOTclOVwaitMethodIdx, XOTclAliasCmdIdx, + XOTclConfigureCmdIdx, XOTclMethodPropertyCmdIdx, XOTclMyCmdIdx, XOTclRelationCmdIdx, @@ -333,7 +342,7 @@ XOTclCheckBooleanArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCheckBooleanArgsIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCheckBooleanArgsIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -348,7 +357,7 @@ XOTclCheckRequiredArgsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCheckRequiredArgsIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCheckRequiredArgsIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -364,7 +373,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCAllocMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCAllocMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -379,7 +388,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCCreateMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCCreateMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -394,7 +403,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCDeallocMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCDeallocMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *object = (Tcl_Obj *)pc.clientData[0]; @@ -409,7 +418,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstFilterGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstFilterGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *filter = (char *)pc.clientData[0]; @@ -425,7 +434,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *method = (Tcl_Obj *)pc.clientData[0]; @@ -447,7 +456,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstMixinGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstMixinGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *mixin = (char *)pc.clientData[0]; @@ -463,7 +472,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -478,7 +487,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstProcMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstProcMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *name = (Tcl_Obj *)pc.clientData[0]; @@ -497,7 +506,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInstProcMethodCIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInstProcMethodCIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *name = (Tcl_Obj *)pc.clientData[0]; @@ -516,7 +525,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCInvariantsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCInvariantsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *invariantlist = (Tcl_Obj *)pc.clientData[0]; @@ -531,7 +540,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCNewMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCNewMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *withChildof = (XOTclObject *)pc.clientData[0]; @@ -546,7 +555,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCRecreateMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCRecreateMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *name = (Tcl_Obj *)pc.clientData[0]; @@ -561,7 +570,7 @@ parseContext pc; XOTclClass *cl = XOTclObjectToClass(clientData); if (!cl) return XOTclObjErrType(interp, objv[0], "Class"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclCUnknownMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclCUnknownMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -575,7 +584,7 @@ XOTclClassInfoHeritageMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoHeritageMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoHeritageMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -590,7 +599,7 @@ XOTclClassInfoInstancesMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstancesMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstancesMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -620,7 +629,7 @@ XOTclClassInfoInstargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstargsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstargsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -635,7 +644,7 @@ XOTclClassInfoInstbodyMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstbodyMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstbodyMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -650,7 +659,7 @@ XOTclClassInfoInstcommandsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstcommandsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstcommandsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -665,7 +674,7 @@ XOTclClassInfoInstdefaultMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstdefaultMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstdefaultMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -682,7 +691,7 @@ XOTclClassInfoInstfilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstfilterMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstfilterMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -698,7 +707,7 @@ XOTclClassInfoInstfilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstfilterguardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstfilterguardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -713,7 +722,7 @@ XOTclClassInfoInstforwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstforwardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstforwardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -729,7 +738,7 @@ XOTclClassInfoInstinvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstinvarMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstinvarMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -743,7 +752,7 @@ XOTclClassInfoInstmixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstmixinMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstmixinMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -774,7 +783,7 @@ XOTclClassInfoInstmixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstmixinguardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstmixinguardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -789,7 +798,7 @@ XOTclClassInfoInstmixinofMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstmixinofMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstmixinofMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -819,7 +828,7 @@ XOTclClassInfoInstnonposargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstnonposargsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstnonposargsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -834,7 +843,7 @@ XOTclClassInfoInstparametercmdMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstparametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstparametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -849,7 +858,7 @@ XOTclClassInfoInstpostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstpostMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstpostMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -864,7 +873,7 @@ XOTclClassInfoInstpreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstpreMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstpreMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -879,7 +888,7 @@ XOTclClassInfoInstprocsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoInstprocsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoInstprocsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -894,7 +903,7 @@ XOTclClassInfoMixinofMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoMixinofMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoMixinofMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -924,7 +933,7 @@ XOTclClassInfoParameterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoParameterMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoParameterMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -938,7 +947,7 @@ XOTclClassInfoSlotsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoSlotsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoSlotsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -952,7 +961,7 @@ XOTclClassInfoSubclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoSubclassMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoSubclassMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -982,7 +991,7 @@ XOTclClassInfoSuperclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclClassInfoSuperclassMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclClassInfoSuperclassMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclClass *class = (XOTclClass *)pc.clientData[0]; @@ -998,7 +1007,7 @@ XOTclObjInfoArgsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoArgsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoArgsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1013,7 +1022,7 @@ XOTclObjInfoBodyMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoBodyMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoBodyMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1028,7 +1037,7 @@ XOTclObjInfoCheckMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoCheckMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoCheckMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1042,7 +1051,7 @@ XOTclObjInfoChildrenMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoChildrenMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoChildrenMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1057,7 +1066,7 @@ XOTclObjInfoClassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoClassMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoClassMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1071,7 +1080,7 @@ XOTclObjInfoCommandsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoCommandsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoCommandsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1086,7 +1095,7 @@ XOTclObjInfoDefaultMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoDefaultMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoDefaultMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1103,7 +1112,7 @@ XOTclObjInfoFilterMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoFilterMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoFilterMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1120,7 +1129,7 @@ XOTclObjInfoFilterguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoFilterguardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoFilterguardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1135,7 +1144,7 @@ XOTclObjInfoForwardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1151,7 +1160,7 @@ XOTclObjInfoHasnamespaceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoHasnamespaceMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoHasnamespaceMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1165,7 +1174,7 @@ XOTclObjInfoInvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoInvarMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoInvarMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1179,7 +1188,7 @@ XOTclObjInfoMethodsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoMethodsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoMethodsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1198,7 +1207,7 @@ XOTclObjInfoMixinMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoMixinMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoMixinMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1229,7 +1238,7 @@ XOTclObjInfoMixinguardMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoMixinguardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoMixinguardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1244,7 +1253,7 @@ XOTclObjInfoNonposargsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoNonposargsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoNonposargsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1259,7 +1268,7 @@ XOTclObjInfoParametercmdMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1274,7 +1283,7 @@ XOTclObjInfoParentMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoParentMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoParentMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1288,7 +1297,7 @@ XOTclObjInfoPostMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoPostMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoPostMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1303,7 +1312,7 @@ XOTclObjInfoPreMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoPreMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoPreMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1318,7 +1327,7 @@ XOTclObjInfoPrecedenceMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoPrecedenceMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoPrecedenceMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1334,7 +1343,7 @@ XOTclObjInfoProcsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoProcsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoProcsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1349,7 +1358,7 @@ XOTclObjInfoSlotObjectsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoSlotObjectsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoSlotObjectsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1364,7 +1373,7 @@ XOTclObjInfoVarsMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclObjInfoVarsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclObjInfoVarsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1380,7 +1389,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOAutonameMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOAutonameMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { int withInstance = (int )pc.clientData[0]; @@ -1397,7 +1406,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOCheckMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOCheckMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *flag = (Tcl_Obj *)pc.clientData[0]; @@ -1412,7 +1421,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOCleanupMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOCleanupMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1427,7 +1436,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOConfigureMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOConfigureMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1442,7 +1451,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclODestroyMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclODestroyMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1457,7 +1466,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOExistsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOExistsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *var = (char *)pc.clientData[0]; @@ -1472,7 +1481,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOFilterGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOFilterGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *filter = (char *)pc.clientData[0]; @@ -1488,7 +1497,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOFilterSearchMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOFilterSearchMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *filter = (char *)pc.clientData[0]; @@ -1503,7 +1512,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOForwardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *method = (Tcl_Obj *)pc.clientData[0]; @@ -1525,7 +1534,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOInstVarMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOInstVarMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1540,7 +1549,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOInvariantsMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOInvariantsMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *invariantlist = (Tcl_Obj *)pc.clientData[0]; @@ -1555,7 +1564,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOIsClassMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOIsClassMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; @@ -1570,7 +1579,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOIsMetaClassMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOIsMetaClassMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *metaclass = (Tcl_Obj *)pc.clientData[0]; @@ -1585,7 +1594,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOIsMixinMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOIsMixinMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; @@ -1600,7 +1609,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOIsObjectMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOIsObjectMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *object = (Tcl_Obj *)pc.clientData[0]; @@ -1615,7 +1624,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOIsTypeMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOIsTypeMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *class = (Tcl_Obj *)pc.clientData[0]; @@ -1630,7 +1639,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOMixinGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOMixinGuardMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *mixin = (char *)pc.clientData[0]; @@ -1646,7 +1655,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclONextMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclONextMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1661,7 +1670,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclONoinitMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclONoinitMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1676,7 +1685,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOParametercmdMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -1691,7 +1700,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOProcMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOProcMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *name = (Tcl_Obj *)pc.clientData[0]; @@ -1710,7 +1719,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOProcSearchMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOProcSearchMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *name = (char *)pc.clientData[0]; @@ -1725,7 +1734,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclORequireNamespaceMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclORequireNamespaceMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1740,7 +1749,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOSetMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOSetMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { Tcl_Obj *var = (Tcl_Obj *)pc.clientData[0]; @@ -1756,7 +1765,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOSetvaluesMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOSetvaluesMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1771,7 +1780,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOUplevelMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOUplevelMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1786,7 +1795,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOUpvarMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOUpvarMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1801,7 +1810,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOVolatileMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOVolatileMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { @@ -1816,7 +1825,7 @@ parseContext pc; XOTclObject *obj = (XOTclObject *)clientData; if (!obj) return XOTclObjErrType(interp, objv[0], "Object"); - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclOVwaitMethodIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclOVwaitMethodIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { char *varname = (char *)pc.clientData[0]; @@ -1830,7 +1839,7 @@ XOTclAliasCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclAliasCmdIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclAliasCmdIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1846,10 +1855,25 @@ } static int +XOTclConfigureCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclConfigureCmdIdx].ifd[0]), &pc) != TCL_OK) { + return TCL_ERROR; + } else { + int configureoption = (int )pc.clientData[0]; + Tcl_Obj *value = (Tcl_Obj *)pc.clientData[1]; + + return XOTclConfigureCmd(interp, configureoption, value); + + } +} + +static int XOTclMethodPropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclMethodPropertyCmdIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclMethodPropertyCmdIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1867,7 +1891,7 @@ XOTclMyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclMyCmdIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclMyCmdIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { int withLocal = (int )pc.clientData[0]; @@ -1882,7 +1906,7 @@ XOTclRelationCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclRelationCmdIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclRelationCmdIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -1898,7 +1922,7 @@ XOTclSetInstvarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; - if (parseObjv(interp, objc, objv, 1, &(method_definitions[XOTclSetInstvarCmdIdx].ifd[0]), &pc) != TCL_OK) { + if (parseObjv(interp, objc, objv, objv[0], &(method_definitions[XOTclSetInstvarCmdIdx].ifd[0]), &pc) != TCL_OK) { return TCL_ERROR; } else { XOTclObject *object = (XOTclObject *)pc.clientData[0]; @@ -2295,6 +2319,10 @@ {"-protected", 0, 0, convertToString}, {"cmdName", 1, 0, convertToTclobj}} }, +{"::xotcl::configure", XOTclConfigureCmdStub, { + {"filter|softrecreate", 1, 0, convertToConfigureoption}, + {"value", 0, 0, convertToTclobj}} +}, {"::xotcl::methodproperty", XOTclMethodPropertyCmdStub, { {"object", 1, 0, convertToObject}, {"methodName", 1, 0, convertToString}, Index: generic/xotcl.c =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- generic/xotcl.c (.../xotcl.c) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ generic/xotcl.c (.../xotcl.c) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -11,7 +11,7 @@ * * (b) University of Essen * Specification of Software Systems - * Altendorferstrasse 97-101 + * Altendorferstrasse 97-101 * D-45143 Essen, Germany * * Permission to use, copy, modify, distribute, and sell this @@ -167,7 +167,7 @@ Tcl_Obj *CONST objv[]); static int XOTclObjscopedMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); -static int XOTclSetterMethod(ClientData clientData, Tcl_Interp *interp, int objc, +static int XOTclSetterMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int callDestroyMethod(ClientData clientData, Tcl_Interp *interp, XOTclObject *obj, int flags); @@ -229,7 +229,7 @@ union { Tcl_Obj *objPtr; TclVarHashTable85 *tablePtr; - struct Var85 *linkPtr; + struct Var85 *linkPtr; } value; } Var85; @@ -259,20 +259,20 @@ typedef struct CallFrame85 { Namespace *nsPtr; int isProcCallFrame; - int objc; + int objc; Tcl_Obj *CONST *objv; struct CallFrame *callerPtr; struct CallFrame *callerVarPtr; int level; Proc *procPtr; TclVarHashTable *varTablePtr; int numCompiledLocals; - Var85 *compiledLocals; + Var85 *compiledLocals; ClientData clientData; void *localCachePtr; } CallFrame85; -/* +/* * These are global variables, but thread-safe, since they * are only set during initialzation and they are never changed, * and the variables are single words. @@ -390,9 +390,9 @@ #define TclIsCompiledLocalArgument(compiledLocalPtr) \ - ((compiledLocalPtr)->flags & VAR_ARGUMENT) + ((compiledLocalPtr)->flags & VAR_ARGUMENT) #define TclIsCompiledLocalTemporary(compiledLocalPtr) \ - ((compiledLocalPtr)->flags & VAR_TEMPORARY) + ((compiledLocalPtr)->flags & VAR_TEMPORARY) #if defined(PRE85) && !FORWARD_COMPATIBLE # define VarHashGetValue(hPtr) (Var *)Tcl_GetHashValue(hPtr) @@ -410,7 +410,7 @@ */ static Var *NewVar84() { register Var *varPtr; - + varPtr = (Var *) ckalloc(sizeof(Var)); varPtr->value.objPtr = NULL; varPtr->name = NULL; @@ -428,7 +428,7 @@ char *newName = ObjStr(key); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tablePtr, newName, newPtr); Var *varPtr; - + if (newPtr && *newPtr) { varPtr = NewVar84(); Tcl_SetHashValue(hPtr, varPtr); @@ -441,7 +441,7 @@ return varPtr; } -static void +static void InitVarHashTable84(TclVarHashTable *tablePtr, Namespace *nsPtr) { /* fprintf(stderr,"InitVarHashTable84\n"); */ Tcl_InitHashTable((tablePtr), TCL_STRING_KEYS); @@ -469,11 +469,11 @@ } } static Var * -LookupVarFromTable84(TclVarHashTable *varTable, CONST char *simpleName, +LookupVarFromTable84(TclVarHashTable *varTable, CONST char *simpleName, XOTclObject *obj) { Var *varPtr = NULL; Tcl_HashEntry *entryPtr; - + if (varTable) { entryPtr = XOTcl_FindHashEntry(varTable, simpleName); if (entryPtr) { @@ -509,16 +509,16 @@ #if defined(PRE85) -/* +/* * for backward compatibility */ #define VarHashTable(t) t #define TclVarHashTable Tcl_HashTable static Var * -XOTclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, - int flags, const char *msg, int createPart1, int createPart2, +XOTclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, + int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) { return TclLookupVar(interp, ObjStr(part1Ptr), part2, flags, msg, @@ -530,7 +530,7 @@ #else -/* +/* * definitions for tcl 8.5 */ @@ -547,7 +547,7 @@ XOTCLINLINE static Tcl_Namespace * ObjFindNamespace(Tcl_Interp *interp, Tcl_Obj *objPtr) { Tcl_Namespace *nsPtr; - + if (TclGetNamespaceFromObj(interp, objPtr, &nsPtr) == TCL_OK) { return nsPtr; } else { @@ -571,7 +571,7 @@ } static XOTCLINLINE Var * -LookupVarFromTable85(TclVarHashTable *tablePtr, CONST char *simpleName, +LookupVarFromTable85(TclVarHashTable *tablePtr, CONST char *simpleName, XOTclObject *obj) { Var *varPtr = NULL; if (tablePtr) { @@ -604,7 +604,7 @@ if (objc>2) memcpy(tov+2, objv, sizeof(Tcl_Obj *)*(objc-2)); - + /*fprintf(stderr, "%%%% callMethod cmdname=%s, method=%s, objc=%d\n", ObjStr(tov[0]), ObjStr(tov[1]), objc); {int i; fprintf(stderr, "\t CALL: %s ", ObjStr(method));for(i=0; itypePtr; @@ -1038,7 +1038,7 @@ } } } - + o = XOTclpGetObject(interp, ObjStr(objPtr)); if (o) { *obj = o; @@ -1170,9 +1170,9 @@ /*fprintf(stderr, "GetXOTclClassFromObj %s base %p\n", objName, base);*/ - /* todo: is this better than the lookup below? + /* todo: is this better than the lookup below? maybe, we forget our XOTclObjConvertObject, and just convert to - a tcl command with the "right clientData" + a tcl command with the "right clientData" */ cmd = Tcl_GetCommandFromObj(interp, objPtr); if (cmd) { @@ -1482,7 +1482,7 @@ register Tcl_HashEntry *entryPtr; if ((entryPtr = XOTcl_FindHashEntry(Tcl_Namespace_cmdTable(nsPtr), methodName))) { return (Tcl_Command) Tcl_GetHashValue(entryPtr); - } + } /*fprintf(stderr, "find %s in %p returns %p\n", methodName, cmdTable, cmd);*/ return NULL; } @@ -1628,9 +1628,9 @@ TclVarHashTable *varTable = Tcl_Namespace_varTable(nsPtr); Tcl_HashTable *varHashTable = VarHashTable(varTable); Tcl_HashTable *objHashTable = VarHashTable(obj->varTable); - + *varHashTable = *objHashTable; /* copy the table */ - + if (objHashTable->buckets == objHashTable->staticBuckets) { varHashTable->buckets = varHashTable->staticBuckets; } @@ -1650,7 +1650,7 @@ #endif hPtr->tablePtr = varHashTable; } - + ckfree((char *) obj->varTable); obj->varTable = NULL; } @@ -1668,16 +1668,16 @@ Tcl_Obj *key; Tcl_CallFrame *varFramePtr; Var *newVar; - + /* Case 1: The variable is to be resolved in global scope, proceed in * resolver chain (i.e. return TCL_CONTINUE) * - * Note: For now, I am not aware of this case to become effective, - * it is a mere safeguard measure. + * Note: For now, I am not aware of this case to become effective, + * it is a mere safeguard measure. * * TODO: Can it be omitted safely? */ - + if (flags & TCL_GLOBAL_ONLY) { /*fprintf(stderr, "global-scoped var detected '%s' in NS '%s'\n", name, \ varFramePtr->nsPtr->fullName);*/ @@ -1704,25 +1704,25 @@ ); */ if (varFramePtr && Tcl_CallFrame_isProcCallFrame(varFramePtr)) { - /*fprintf(stderr, "proc-scoped var detected '%s' in NS '%s'\n", name, + /*fprintf(stderr, "proc-scoped var detected '%s' in NS '%s'\n", name, varFramePtr->nsPtr->fullName);*/ return TCL_CONTINUE; } - + /* * Check for absolutely/relatively qualified variable names, i.e. - * make sure that the variable name does not contain any namespace qualifiers. + * make sure that the variable name does not contain any namespace qualifiers. * Proceed with a TCL_CONTINUE, otherwise. */ if ((*name == ':' && *(name+1) == ':') || NSTail(name) != name) { return TCL_CONTINUE; } - + /* Case 3: Does the variable exist in the per-object namespace? */ *varPtr = (Tcl_Var)LookupVarFromTable(Tcl_Namespace_varTable(ns),name,NULL); - if(*varPtr == NULL) { + if(*varPtr == NULL) { /* We failed to find the variable so far, therefore we create it * here in the namespace. Note that the cases (1), (2) and (3) * TCL_CONTINUE care for variable creation if necessary. @@ -1797,15 +1797,15 @@ Tcl_ForgetImport(interp, ns, "*"); /* don't destroy namespace imported objects */ - for (hPtr = Tcl_FirstHashEntry(cmdTable, &hSrch); hPtr; + for (hPtr = Tcl_FirstHashEntry(cmdTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr); if (!Tcl_Command_cmdEpoch(cmd)) { char *oname = Tcl_GetHashKey(cmdTable, hPtr); Tcl_DString name; XOTclObject *obj; /* fprintf(stderr, " ... child %s\n", oname); */ - + ALLOC_NAME_NS(&name, ns->fullName, oname); obj = XOTclpGetObject(interp, Tcl_DStringValue(&name)); @@ -1822,7 +1822,7 @@ } else { if (obj->teardown && obj->id && !(obj->flags & XOTCL_DESTROY_CALLED)) { - + if (callDestroyMethod((ClientData)obj, interp, obj, 0) != TCL_OK) { /* destroy method failed, but we have to remove the command anyway. */ @@ -1895,7 +1895,7 @@ cmd = (Tcl_Command) Tcl_GetHashValue(hPtr); /* objects should not be deleted here to preseve children deletion order*/ if (!XOTclGetObjectFromCmdPtr(cmd)) { - /*fprintf(stderr,"NSCleanupNamespace deleting %s %p\n", + /*fprintf(stderr,"NSCleanupNamespace deleting %s %p\n", Tcl_Command_nsPtr(cmd)->fullName, cmd);*/ XOTcl_DeleteCommandFromToken(interp, cmd); } @@ -2081,7 +2081,7 @@ /*fprintf(stderr, "XOTclpGetObject name = '%s'\n",name);*/ cmd = NSFindCommand(interp, name, NULL); - + /* if (cmd) { fprintf(stderr,"+++ XOTclGetObject from %s -> objProc=%p, dispatch=%p\n", @@ -2113,8 +2113,8 @@ } Tcl_Command -XOTclAddObjectMethod(Tcl_Interp *interp, XOTcl_Object *object, CONST char *methodName, - Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp, +XOTclAddObjectMethod(Tcl_Interp *interp, XOTcl_Object *object, CONST char *methodName, + Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp, int flags) { XOTclObject *obj = (XOTclObject *)object; Tcl_DString newCmdName, *dsPtr = &newCmdName; @@ -2132,7 +2132,7 @@ } Tcl_Command -XOTclAddPMethod(Tcl_Interp *interp, XOTcl_Object *object, CONST char *methodName, +XOTclAddPMethod(Tcl_Interp *interp, XOTcl_Object *object, CONST char *methodName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp) { int flags = 0; if (clientData == (ClientData) XOTCL_NONLEAF_METHOD) { @@ -2147,7 +2147,7 @@ Tcl_Command XOTclAddInstanceMethod(Tcl_Interp *interp, XOTcl_Class *class, CONST char *methodName, - Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp, + Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp, int flags) { XOTclClass *cl = (XOTclClass*) class; Tcl_DString newCmdName, *dsPtr = &newCmdName; @@ -2162,7 +2162,7 @@ } Tcl_Command -XOTclAddIMethod(Tcl_Interp *interp, XOTcl_Class *class, CONST char *methodName, +XOTclAddIMethod(Tcl_Interp *interp, XOTcl_Class *class, CONST char *methodName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *dp) { int flags = 0; if (clientData == (ClientData) XOTCL_NONLEAF_METHOD) { @@ -2223,15 +2223,15 @@ long autoname_counter; /* should probably do an overflow check here */ Tcl_GetLongFromObj(interp, valueObject,&autoname_counter); - autoname_counter++; + autoname_counter++; if (Tcl_IsShared(valueObject)) { valueObject = Tcl_DuplicateObj(valueObject); } Tcl_SetLongObj(valueObject, autoname_counter); } - Tcl_ObjSetVar2(interp, XOTclGlobalObjects[XOTE_AUTONAMES], name, + Tcl_ObjSetVar2(interp, XOTclGlobalObjects[XOTE_AUTONAMES], name, valueObject, flgs); - + if (resetOpt) { if (valueObject) { /* we have an entry */ Tcl_UnsetVar2(interp, XOTclGlobalStrings[XOTE_AUTONAMES], ObjStr(name), flgs); @@ -2903,7 +2903,7 @@ Tcl_HashEntry *hPtr; if (aStore) { - for (hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch); hPtr; + for (hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch); hPtr; hPtr = Tcl_FirstHashEntry(&aStore->procs, &hSrch)) { /* * AssertionRemoveProc calls Tcl_DeleteHashEntry(hPtr), thus @@ -2930,10 +2930,10 @@ INCR_REF_COUNT(condition); result = XOTcl_ExprObjCmd(NULL, interp, 2, ov); DECR_REF_COUNT(condition); - + if (result == TCL_OK) { result = Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),&success); - + if (result == TCL_OK && success == 0) result = XOTCL_CHECK_FAILED; } @@ -3021,7 +3021,7 @@ ObjStr(checkFailed->content), "} in proc '", GetSelfProc(interp), "'", (char *) NULL); } - + Tcl_SetObjResult(interp, savedObjResult); DECR_REF_COUNT(savedObjResult); return TCL_OK; @@ -3304,7 +3304,7 @@ * apply AppendMatchingElement to CmdList */ static int -AppendMatchingElementsFromCmdList(Tcl_Interp *interp, XOTclCmdList *cmdl, +AppendMatchingElementsFromCmdList(Tcl_Interp *interp, XOTclCmdList *cmdl, char *pattern, XOTclObject *matchObject) { int rc = 0; for ( ; cmdl; cmdl = cmdl->nextPtr) { @@ -3321,19 +3321,19 @@ } /* - * apply AppendMatchingElement to + * apply AppendMatchingElement to */ static int -AppendMatchingElementsFromClasses(Tcl_Interp *interp, XOTclClasses *cls, +AppendMatchingElementsFromClasses(Tcl_Interp *interp, XOTclClasses *cls, char *pattern, XOTclObject *matchObject) { int rc = 0; for ( ; cls; cls = cls->nextPtr) { XOTclObject *obj = (XOTclObject *)cls->cl; if (obj) { if (matchObject && obj == matchObject) { - /* we have a matchObject and it is identical to obj, - just return true and don't continue search + /* we have a matchObject and it is identical to obj, + just return true and don't continue search */ return 1; break; @@ -3376,7 +3376,7 @@ * helper function for getAllClassMixinsOf to add classes to the * result set, flagging test for matchObject as result */ - + static int addToResultSet(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclObject *obj, int *new, int appendResult, char *pattern, XOTclObject *matchObject) { @@ -3421,10 +3421,10 @@ } /* - * recursively get all per object mixins from an class and its subclasses/isClassMixinOf + * recursively get all per object mixins from an class and its subclasses/isClassMixinOf * into an initialized object ptr hashtable (TCL_ONE_WORD_KEYS) */ - + static int getAllObjectMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl, int isMixin, @@ -3434,8 +3434,8 @@ /*fprintf(stderr, "startCl = %s, opt %p, isMixin %d, pattern '%s', matchObject %p\n", className(startCl),startCl->opt, isMixin, pattern, matchObject);*/ - - /* + + /* * check all subclasses of startCl for mixins */ for (sc = startCl->sub; sc; sc = sc->nextPtr) { @@ -3462,14 +3462,14 @@ if (rc) {return rc;} } } - - /* - * check, if startCl has associated per-object mixins + + /* + * check, if startCl has associated per-object mixins */ if (startCl->opt) { XOTclCmdList *m; XOTclObject *obj; - + for (m = startCl->opt->isObjectMixinOf; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ @@ -3489,7 +3489,7 @@ * recursively get all isClassMixinOf of a class into an initialized * object ptr hashtable (TCL_ONE_WORD_KEYS) */ - + static int getAllClassMixinsOf(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *startCl, int isMixin, @@ -3503,14 +3503,14 @@ ObjStr(startCl->object.cmdName),startCl->opt, isMixin); */ - /* - * the startCl is a per class mixin, add it to the result set + /* + * the startCl is a per class mixin, add it to the result set */ if (isMixin) { rc = addToResultSet(interp, destTable, &startCl->object, &new, appendResult, pattern, matchObject); if (rc == 1) {return rc;} - /* + /* * check all subclasses of startCl for mixins */ for (sc = startCl->sub; sc; sc = sc->nextPtr) { @@ -3519,12 +3519,12 @@ } } - /* - * check, if startCl is a per-class mixin of some other classes + /* + * check, if startCl is a per-class mixin of some other classes */ if (startCl->opt) { XOTclCmdList *m; - + for (m = startCl->opt->isClassMixinOf; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ @@ -3562,7 +3562,7 @@ */ if (startCl->opt) { XOTclCmdList *m; - + for (m = startCl->opt->instmixins; m; m = m->nextPtr) { /* we should have no deleted commands in the list */ @@ -3588,10 +3588,10 @@ if (rc) {return rc;} } } - } + } - /* + /* * check all superclasses of startCl for instmixins */ for (sc = startCl->super; sc; sc = sc->nextPtr) { @@ -3621,7 +3621,7 @@ } } -static void +static void removeFromObjectMixinsOf(Tcl_Command cmd, XOTclCmdList *cmdlist) { for ( ; cmdlist; cmdlist = cmdlist->nextPtr) { XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); @@ -3638,7 +3638,7 @@ } } -static void +static void RemoveFromInstmixins(Tcl_Command cmd, XOTclCmdList *cmdlist) { for ( ; cmdlist; cmdlist = cmdlist->nextPtr) { XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); @@ -3656,7 +3656,7 @@ } } -static void +static void RemoveFromMixins(Tcl_Command cmd, XOTclCmdList *cmdlist) { for ( ; cmdlist; cmdlist = cmdlist->nextPtr) { XOTclObject *nobj = XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr); @@ -3675,17 +3675,17 @@ } -/* - * Reset mixin order for instances of a class +/* + * Reset mixin order for instances of a class */ - + static void MixinResetOrderForInstances(Tcl_Interp *interp, XOTclClass *cl) { Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr; hPtr = Tcl_FirstHashEntry(&cl->instances, &hSrch); - + /*fprintf(stderr,"invalidating instances of class %s\n", ObjStr(clPtr->cl->object.cmdName));*/ @@ -3736,15 +3736,15 @@ Tcl_HashTable objTable, *commandTable = &objTable; cl->order = NULL; - + /* reset mixin order for all instances of the class and the instances of its subclasses */ for (clPtr = ComputeOrder(cl, cl->order, Sub); clPtr; clPtr = clPtr->nextPtr) { Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr = &clPtr->cl->instances ? Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : NULL; - + /* reset mixin order for all objects having this class as per object mixin */ ResetOrderOfClassesUsedAsMixins(clPtr->cl); @@ -3769,7 +3769,7 @@ MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); getAllClassMixinsOf(interp, commandTable, cl, 1, 0, NULL, NULL); - for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; + for (hPtr = Tcl_FirstHashEntry(commandTable, &hSrch); hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { XOTclClass *ncl = (XOTclClass *)Tcl_GetHashKey(commandTable, hPtr); /*fprintf(stderr,"Got %s, reset for ncl %p\n",ncl?ObjStr(ncl->object.cmdName):"NULL",ncl);*/ @@ -3781,7 +3781,7 @@ } -static int MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, +static int MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, int withGuards, XOTclObject *matchObject); /* * the mixin order is either @@ -3830,10 +3830,10 @@ Tcl_Command cmd = NULL; XOTclCmdList *cmdList; XOTclClass *cls; - + assert(obj); assert(obj->mixinStack); - + /* ensure that the mixin order is not invalid, otherwise compute order */ assert(obj->flags & XOTCL_MIXIN_ORDER_VALID); /*MixinComputeDefined(interp, obj);*/ @@ -3842,12 +3842,12 @@ #if defined(ACTIVEMIXIN) RUNTIME_STATE(interp)->cmdPtr = cmdList->cmdPtr; #endif - + /* fprintf(stderr, "MixinSearch searching for '%s' %p\n", methodName, cmdList); */ /*CmdListPrint(interp,"MixinSearch CL = \n", cmdList);*/ - + while (cmdList) { if (Tcl_Command_cmdEpoch(cmdList->cmdPtr)) { cmdList = cmdList->nextPtr; @@ -3889,13 +3889,13 @@ * info option for mixins and instmixins */ static int -MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, +MixinInfo(Tcl_Interp *interp, XOTclCmdList *m, char *pattern, int withGuards, XOTclObject *matchObject) { Tcl_Obj *list = Tcl_NewListObj(0, NULL); XOTclClass *mixinClass; while (m) { - /* fprintf(stderr," mixin info m=%p, next=%p, pattern %s, matchObject %p\n", + /* fprintf(stderr," mixin info m=%p, next=%p, pattern %s, matchObject %p\n", m, m->next, pattern, matchObject);*/ mixinClass = XOTclGetClassFromCmdPtr(m->cmdPtr); if (mixinClass && @@ -3923,7 +3923,7 @@ /* * info option for mixinofs and isClassMixinOf */ - + static Tcl_Command MixinSearchMethodByName(Tcl_Interp *interp, XOTclCmdList *mixinList, char *name, XOTclClass **cl) { Tcl_Command cmd; @@ -4031,7 +4031,7 @@ * (i.e. they are inherited), then they are OR combined * -> if one check succeeds => return 1 */ - + /*fprintf(stderr, "checking guard **%s**\n", ObjStr(guard));*/ cs->guardCount++; @@ -4047,9 +4047,9 @@ } else if (rc == TCL_ERROR) { Tcl_Obj *sr = Tcl_GetObjResult(interp); INCR_REF_COUNT(sr); - + /* fprintf(stderr, " +++ ERROR\n");*/ - + XOTclVarErrMsg(interp, "Guard Error: '", ObjStr(guard), "'\n\n", ObjStr(sr), (char *) NULL); DECR_REF_COUNT(sr); @@ -4109,12 +4109,12 @@ GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd, Tcl_Interp *interp, Tcl_Obj *guard, int push) { int rc = TCL_OK; - + if (guard) { XOTclCallStackContent *csc = CallStackGetTopFrame(interp); Tcl_Obj *res = Tcl_GetObjResult(interp); /* save the result */ INCR_REF_COUNT(res); - + csc->callType |= XOTCL_CSC_CALL_IS_GUARD; /* GuardPrint(interp, cmdList->clientData); */ @@ -4134,7 +4134,7 @@ Tcl_SetObjResult(interp, res); /* restore the result */ DECR_REF_COUNT(res); } - + return rc; } @@ -4273,9 +4273,9 @@ ObjStr(startingCl->object.cmdName), " - proc: ", ObjStr(name), (char *) NULL); } - + /*fprintf(stderr, " +++ adding filter %s cl %p\n", ObjStr(name), cl);*/ - + new = CmdListAdd(filterList, cmd, cl, /*noDuplicates*/ 1); if (guard) { @@ -4344,7 +4344,7 @@ cl->order = NULL; savePtr = clPtr = ComputeOrder(cl, cl->order, Sub); cl->order = saved; - + for ( ; clPtr; clPtr = clPtr->nextPtr) { Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr = &clPtr->cl->instances ? @@ -4413,20 +4413,20 @@ XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd) { Tcl_Obj *list = Tcl_NewListObj(0, NULL); Tcl_Obj *procObj = Tcl_NewStringObj(cmdName, -1); - Tcl_ObjCmdProc *objProc = Tcl_Command_objProc(cmd); + Tcl_ObjCmdProc *objProc = Tcl_Command_objProc(cmd); int isTcl = (TclIsProc((Command *)cmd) != NULL); if (cl) { Tcl_ListObjAppendElement(interp, list, cl->object.cmdName); /*fprintf(stderr,"current %p, dispatch %p, forward %p, parametermcd %p, is tcl %p\n", - objProc, XOTclObjDispatch, XOTclForwardMethod, + objProc, XOTclObjDispatch, XOTclForwardMethod, XOTclSetterMethod, TclIsProc((Command *)cmd)); */ if (isTcl) { Tcl_ListObjAppendElement(interp, list, XOTclGlobalObjects[XOTE_INSTPROC]); } else if (objProc == XOTclForwardMethod) { Tcl_ListObjAppendElement(interp, list, XOTclGlobalObjects[XOTE_INSTFORWARD]); } else if (objProc == XOTclSetterMethod) { - Tcl_ListObjAppendElement(interp, list, XOTclGlobalObjects[XOTE_INSTPARAMETERCMD]); + Tcl_ListObjAppendElement(interp, list, XOTclGlobalObjects[XOTE_INSTPARAMETERCMD]); } else { Tcl_ListObjAppendElement(interp, list, XOTclGlobalObjects[XOTE_INSTCMD]); } @@ -4489,7 +4489,7 @@ fcl = f->clorobj; } Tcl_ListObjAppendElement(interp, list, - getFullProcQualifier(interp, simpleName, + getFullProcQualifier(interp, simpleName, fobj, fcl, f->cmdPtr)); } else { Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(simpleName, -1)); @@ -4528,7 +4528,7 @@ /* get the object for per-object filter */ XOTclObject *fObj = (XOTclObject *)fcl; /* and then get class */ - fcl = fObj->cl; + fcl = fObj->cl; } /* if we have a filter class -> search up the inheritance hierarchy*/ @@ -4577,7 +4577,7 @@ if (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { XOTclCmdList *ml; XOTclClass *mixin; - + for (ml = obj->mixinOrder; ml; ml = ml->nextPtr) { mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); if (mixin && mixin->opt && mixin->opt->instfilters) @@ -4742,7 +4742,7 @@ * current filter and the relevant calling information */ static Tcl_Command -FilterSearchProc(Tcl_Interp *interp, XOTclObject *obj, +FilterSearchProc(Tcl_Interp *interp, XOTclObject *obj, Tcl_Command *currentCmd, XOTclClass **cl) { XOTclCmdList *cmdList; @@ -4790,7 +4790,7 @@ XOTclClass **scl; int reversed = 0; int i, j; - + filterCheck = ComputeOrder(cl, cl->order, Super); /* * we have to remove all dependent superclass filter referenced @@ -4804,12 +4804,12 @@ for (; filterCheck; filterCheck = filterCheck->nextPtr) { FilterRemoveDependentFilterCmds(cl, filterCheck->cl); } - + /* invalidate all interceptors orders of instances of this and of all depended classes */ MixinInvalidateObjOrders(interp, cl); FilterInvalidateObjOrders(interp, cl); - + scl = NEW_ARRAY(XOTclClass*, oc); for (i = 0; i < oc; i++) { if (GetXOTclClassFromObj(interp, ov[i], &scl[i], base) != TCL_OK) { @@ -4818,11 +4818,11 @@ ObjStr(arg)); } } - + /* * check that superclasses don't precede their classes */ - + for (i = 0; i < oc; i++) { if (reversed) break; for (j = i+1; j < oc; j++) { @@ -4835,17 +4835,17 @@ if (dl) reversed = 1; } } - + if (reversed) { - return XOTclErrBadVal(interp, "superclass", "classes in dependence order", + return XOTclErrBadVal(interp, "superclass", "classes in dependence order", ObjStr(arg)); } - + while (cl->super) { /* * build up an old superclass list in case we need to revert */ - + XOTclClass *sc = cl->super->cl; XOTclClasses *l = osl; osl = NEW(XOTclClasses); @@ -4858,28 +4858,28 @@ } FREE(XOTclClass**, scl); FlushPrecedencesOnSubclasses(cl); - + if (!ComputeOrder(cl, cl->order, Super)) { - + /* * cycle in the superclass graph, backtrack */ - + XOTclClasses *l; while (cl->super) (void)RemoveSuper(cl, cl->super->cl); for (l = osl; l; l = l->nextPtr) AddSuper(cl, l->cl); XOTclClassListFree(osl); return XOTclErrBadVal(interp, "superclass", "a cycle-free graph", ObjStr(arg)); } XOTclClassListFree(osl); - + /* if there are no more super classes add the Object class as superclasses */ if (cl->super == NULL) { fprintf(stderr, "SuperClassAdd super of '%s' is NULL\n", className(cl)); /*AddSuper(cl, RUNTIME_STATE(interp)->theObject);*/ } - + Tcl_ResetResult(interp); return TCL_OK; } @@ -4970,14 +4970,14 @@ Var *varPtr, *arrayPtr; int result; int flags = 0; - + flags = (index == NULL) ? TCL_PARSE_PART1 : 0; - + XOTcl_PushFrame(interp, obj); - if (triggerTrace) + if (triggerTrace) varPtr = TclVarTraceExists(interp, varName); - else + else varPtr = TclLookupVar(interp, varName, index, flags, "access", /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); /* @@ -4990,7 +4990,7 @@ result = (varPtr && (!requireDefined || !TclIsVarUndefined(varPtr))); XOTcl_PopFrame(interp, obj); - + return result; } @@ -5000,7 +5000,7 @@ int doSubst = 0; char *value = ObjStr(*newValue), *v; /*fprintf(stderr,"+++++ %s.%s got '%s''\n", objectName(obj), varName, ObjStr(newValue));*/ - + /* TODO: maybe we can do this more elegantely without the need to parse the vars */ for (v=value; *v; v++) { if (*v == '[' && doSubst == 0) @@ -5010,19 +5010,19 @@ break; } } - + if (doSubst == 2) { /* we have to subst, we overwrite newValue */ Tcl_Obj *ov[2]; ov[1] = *newValue; Tcl_ResetResult(interp); - + CallStackPush(interp, obj, NULL, 0, 0, 0, XOTCL_CSC_TYPE_PLAIN); rc = XOTcl_SubstObjCmd(NULL, interp, 2, ov); CallStackPop(interp); - - /*fprintf(stderr,"+++++ %s.%s subst returned %d OK %d\n", + + /*fprintf(stderr,"+++++ %s.%s subst returned %d OK %d\n", objectName(obj), varName, rc, TCL_OK);*/ - + if (rc == TCL_OK) { *newValue = Tcl_GetObjResult(interp); } @@ -5039,18 +5039,18 @@ XOTcl_FrameDecls; XOTcl_PushFrame(interp, obj); /* make instvars of obj accessible */ - /* + /* * caller did a XOTcl_PushFrame(interp, obj), * so we have the instvars already accessible; */ - oldValue = Tcl_GetVar2Ex(interp, varName, NULL, + oldValue = Tcl_GetVar2Ex(interp, varName, NULL, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); /* Check whether the variable is already set. - * If yes, we do not set it again. + * If yes, we do not set it again. */ if (oldValue == NULL) { - Tcl_Obj *newValue = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "default", NULL, + Tcl_Obj *newValue = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "default", NULL, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); /*fprintf(stderr,"+++++ %s.%s undefined'\n", objectName(obj), varName);*/ if (newValue) { @@ -5060,31 +5060,31 @@ } /* - * just set the variable, checking is happening later + * just set the variable, checking is happening later */ /*fprintf(stderr,"+++++ %s.%s := '%s'\n", objectName(obj), varName, ObjStr(newValue));*/ Tcl_SetVar2Ex(interp, varName, NULL, newValue, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); - + } else { /*fprintf(stderr, "----- we have no new value %s\n", varName);*/ } - /* + /* * we set the initCmd for the time being unconditionally, if it is available */ { - /* try to get initcmd + /* try to get initcmd */ - Tcl_Obj *initCmd = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "initcmd", NULL, + Tcl_Obj *initCmd = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "initcmd", NULL, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); if (initCmd) { char *cmd = ObjStr(initCmd); /*fprintf(stderr, "----- we have an initcmd %s\n", cmd);*/ if (*cmd) { CallStackPush(interp, obj, NULL, 0, 0, 0, XOTCL_CSC_TYPE_PLAIN); /*allow to call self*/ - + /*fprintf(stderr,"!!!! evaluating '%s'\n", cmd); */ rc = Tcl_EvalObjEx(interp, initCmd, TCL_EVAL_DIRECT); CallStackPop(interp); @@ -5107,15 +5107,14 @@ checkRequiredValue(Tcl_Interp *interp, XOTclObject *obj, XOTclObject *slotObj) { CONST char *varName = Tcl_GetCommandName(interp, slotObj->id); int rc = TCL_OK, bool; - Tcl_Obj *requiredFlag = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "required", NULL, + Tcl_Obj *requiredFlag = XOTcl_GetVar2Ex((XOTcl_Object*)slotObj, interp, "required", NULL, TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); if (requiredFlag) { rc = Tcl_GetBooleanFromObj(interp, requiredFlag, &bool); if (rc == TCL_OK && bool) { /*fprintf(stderr,"+++++ %s.%s must check'\n", objectName(obj), varName);*/ if (!varExists(interp, obj, varName, NULL, 0, 1)) { - return XOTclVarErrMsg(interp, - "required parameter '", varName, "' missing", + return XOTclVarErrMsg(interp, "required parameter '", varName, "' missing", (char *) NULL); } } @@ -5172,12 +5171,12 @@ } XOTclMutexUnlock(&initMutex); } - + if (procPtr->bodyPtr->typePtr == byteCodeType) { # if defined(WITH_TCL_COMPILE) ByteCode *codePtr; Interp *iPtr = (Interp *) interp; - + /* * When we've got bytecode, this is the check for validity. That is, * the bytecode must be for the right interpreter (no cross-leaks!), @@ -5186,7 +5185,7 @@ * is right) and the resolverEpoch must match (so that new shadowed * commands and/or resolver changes are considered). */ - + codePtr = procPtr->bodyPtr->internalRep.otherValuePtr; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) @@ -5199,7 +5198,7 @@ # if defined(WITH_TCL_COMPILE) doCompilation: # endif - result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, + result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, (Namespace *) nsPtr, "body of proc", TclGetString(objv[isLambda])); /*fprintf(stderr,"compile returned %d",result);*/ if (result != TCL_OK) { @@ -5275,7 +5274,7 @@ rst->callIsDestroy = 0; /*fprintf(stderr,"callProcCheck: setting callIsDestroy = 0, m=%s obj=%p (%s) is TclProc %d\n", methodName, obj, objectName(obj), isTclProc);*/ - + /*fprintf(stderr,"*** callProcCheck: cmd = %p objproc = %p\n", cmd, Tcl_Command_objProc(cmd)); fprintf(stderr,"*** callProcCheck: cmd = %p\n", cmd); fprintf(stderr, @@ -5288,7 +5287,7 @@ XOTclObjscopedMethod, objv[0], objc ); - */ + */ #ifdef CALLSTACK_TRACE XOTclCallStackDump(interp); @@ -5298,7 +5297,7 @@ if (!obj->teardown) { goto finish; } - + if (isTclProc == 0) { if (obj->opt) { co = obj->opt->checkoptions; @@ -5307,20 +5306,20 @@ goto finish; } } - + #ifdef DISPATCH_TRACE printCall(interp,"callProcCheck cmd", objc, objv); fprintf(stderr,"\tcmd=%s\n", Tcl_GetCommandName(interp, cmd)); #endif - + result = (*Tcl_Command_objProc(cmd))(cp, interp, objc, objv); - + #ifdef DISPATCH_TRACE printExit(interp,"callProcCheck cmd", objc, objv, result); /*fprintf(stderr, " returnCode %d xotcl rc %d\n", Tcl_Interp_returnCode(interp), rst->returnCode);*/ #endif - + /* if (obj && obj->teardown && cl && !(obj->flags & XOTCL_DESTROY_CALLED)) { fprintf(stderr, "Obj= %s ", objectName(obj)); @@ -5343,17 +5342,17 @@ * if not: just step forward to the next filter */ /*fprintf(stderr,"calling proc %s isTclProc %d tearDown %d\n",methodName,isTclProc,obj->teardown);*/ - + if (frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { XOTclCmdList *cmdList; /* * seek cmd in obj's filterOrder */ assert(obj->flags & XOTCL_FILTER_ORDER_VALID); /* otherwise: FilterComputeDefined(interp, obj);*/ - + for (cmdList = obj->filterOrder; cmdList && cmdList->cmdPtr != cmd; cmdList = cmdList->nextPtr); - + /* * when it is found, check whether it has a filter guard */ @@ -5368,21 +5367,21 @@ * no callstackobjs */ /*fprintf(stderr, "... calling nextmethod\n"); XOTclCallStackDump(interp);*/ - + rc = XOTclNextMethod(obj, interp, cl, methodName, objc, objv, /*useCallStackObjs*/ 0); /*fprintf(stderr, "... after nextmethod\n"); XOTclCallStackDump(interp);*/ - + } - + return rc; } } } /*fprintf(stderr, "AFTER FILTER, teardown=%p call is destroy %d\n",obj->teardown,rst->callIsDestroy);*/ - + /* if (!obj->teardown || rst->callIsDestroy) { goto finish; @@ -5395,11 +5394,6 @@ goto finish; } -#if defined(RST_RETURNCODE) - if (Tcl_Interp_numLevels(interp) <= 2) - rst->returnCode = TCL_OK; -#endif - #ifdef DISPATCH_TRACE printCall(interp,"callProcCheck tclCmd", objc, objv); fprintf(stderr,"\tproc=%s\n", Tcl_GetCommandName(interp, cmd)); @@ -5421,44 +5415,50 @@ */ #if !defined(PRE85) /*fprintf(stderr,"\tproc=%s cp=%p %d\n", Tcl_GetCommandName(interp, cmd),cp, isTclProc);*/ - + result = PushProcCallFrame(cp, interp, objc, objv, /*isLambda*/ 0); - + if (result == TCL_OK) { rst->cs.top->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); + + /* It would be nice to be able to call the arg parser + XOTclInterpretNonpositionalArgsCmd() here and not + ::xotcl::interpretNonpositionalArgs, but unfortonately, the + variable environment is setup by InitArgsAndLocals() from + TclObjInterpProcCore(), so we can't reach the variable scope + from here; TODO: look for a way.... + + XOTclInterpretNonpositionalArgsCmd(cp, interp, objc, objv); + */ + result = TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError); } else { result = TCL_ERROR; } #else result = (*Tcl_Command_objProc(cmd))(cp, interp, objc, objv); #endif - + #ifdef DISPATCH_TRACE printExit(interp,"callProcCheck tclCmd", objc, objv, result); /* fprintf(stderr, " returnCode %d xotcl rc %d\n", Tcl_Interp_returnCode(interp), result);*/ #endif -#if defined(RST_RETURNCODE) - if (result == TCL_BREAK && rst->returnCode == TCL_OK) - rst->returnCode = result; -#endif - /* fprintf(stderr, "dispatch returned %d rst = %d\n", result, rst->returnCode);*/ - + /* we give the information whether the call has destroyed the object back to the caller, because after CallStackPop it cannot be retrieved via the call stack */ /* if the object is destroyed -> the assertion structs's are already destroyed */ if (rst->cs.top->callType & XOTCL_CSC_CALL_IS_DESTROY) { rst->callIsDestroy = 1; - /*fprintf(stderr,"callProcCheck: setting callIsDestroy = 1 method = %s\n", + /*fprintf(stderr,"callProcCheck: setting callIsDestroy = 1 method = %s\n", methodName);*/ } - - if (obj->opt && !rst->callIsDestroy && obj->teardown && + + if (obj->opt && !rst->callIsDestroy && obj->teardown && (obj->opt->checkoptions & CHECK_POST) && (result = AssertionCheck(interp, obj, cl, methodName, CHECK_POST) == TCL_ERROR)) { goto finish; @@ -5477,11 +5477,11 @@ static int DoCallProcCheck(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], - Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, + Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, char *methodName, int frameType) { int rc, push, isTclProc = 0; ClientData cp = Tcl_Command_objClientData(cmd); - + /*fprintf(stderr, "DoCallProcCheck method '%s' cmd %p cp=%p\n",methodName,cmd, cp);*/ if (cp) { @@ -5493,7 +5493,7 @@ } else if (proc == XOTclObjDispatch) { assert((TclIsProc((Command *)cmd) == NULL)); /*fprintf(stderr,"\t ObjDispatch\n");*/ - } else if (proc == XOTclForwardMethod || + } else if (proc == XOTclForwardMethod || proc == XOTclObjscopedMethod) { tclCmdClientData *tcd = (tclCmdClientData *)cp; tcd->obj = obj; @@ -5508,7 +5508,7 @@ if ((CallStackPush(interp, obj, cl, cmd, objc, objv, frameType)) != TCL_OK) { return TCL_ERROR; } - + } else { push = 0; assert((TclIsProc((Command *)cmd) == NULL)); @@ -5517,9 +5517,9 @@ /*fprintf(stderr,"DoCallProcCheck push=%d (%d), obj=%s fromNext %d\n", push, forcePush, objectName(obj), fromNext);*/ - + /*{int i; fprintf(stderr, "\tCALL ");for(i=0; iflags; /* avoid stalling */ INCR_REF_COUNT(cmdName); - + if (!(objflags & XOTCL_FILTER_ORDER_VALID)) FilterComputeDefined(interp, obj); - + if (!(objflags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, obj); - + /* Only start new filter chain, if (a) filters are defined and (b) the toplevel csc entry is not an filter on self */ - - if (((obj->flags & XOTCL_FILTER_ORDER_DEFINED_AND_VALID) == XOTCL_FILTER_ORDER_DEFINED_AND_VALID) - && RUNTIME_STATE(interp)->doFilters - && !(flags & XOTCL_CM_NO_FILTERS) + + if (((obj->flags & XOTCL_FILTER_ORDER_DEFINED_AND_VALID) == XOTCL_FILTER_ORDER_DEFINED_AND_VALID) + && RUNTIME_STATE(interp)->doFilters + && !(flags & XOTCL_CM_NO_FILTERS) && !cs->guardCount) { XOTclObject *self = GetSelfObj(interp); if (obj != self || cs->top->frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { filterStackPushed = FilterStackPush(interp, obj, objv[1]); cmd = FilterSearchProc(interp, obj, &obj->filterStack->currentCmdPtr,&cl); - if (cmd) { + if (cmd) { /*fprintf(stderr,"filterSearchProc returned cmd %p proc %p\n", cmd, proc);*/ frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; methodName = (char *)Tcl_GetCommandName(interp, cmd); @@ -5601,59 +5601,59 @@ } } } - + /* check if a mixin is to be called. don't use mixins on next method calls, since normally it is not intercepted (it is used as a primitive command). don't use mixins on init calls, since init is invoked on mixins during mixin registration (in XOTclOMixinMethod) */ if ((obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) == XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { - + mixinStackPushed = MixinStackPush(obj); - + if (frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { cmd = MixinSearchProc(interp, obj, methodName, &cl, &obj->mixinStack->currentCmdPtr); - if (cmd) { + if (cmd) { frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; } else { /* the else branch could be deleted */ MixinStackPop(obj); mixinStackPushed = 0; } } } - - + + /* if no filter/mixin is found => do ordinary method lookup */ if (cmd == NULL) { - + if (obj->nsPtr) { cmd = FindMethod(methodName, obj->nsPtr); /* fprintf(stderr,"lookup for proc in obj %p method %s nsPtr %p => %p\n", obj, methodName, obj->nsPtr, cmd);*/ } - + /*fprintf(stderr,"findMethod for proc '%s' in %p returned %p\n", methodName, obj->nsPtr, cmd);*/ - + if (cmd == NULL) { if (obj->cl->order == NULL) obj->cl->order = TopoOrder(obj->cl, Super); cl = SearchPLMethod(obj->cl->order, methodName, &cmd); } } - + if (cmd) { result = TCL_OK; - /*fprintf(stderr,"cmd %p %s flags %x\n", cmd, methodName, + /*fprintf(stderr,"cmd %p %s flags %x\n", cmd, methodName, ((Command *) cmd)->flags && 0x00010000);*/ - + /* check, whether we have a protected method, and whether the protected method, called on a different object. In this case, we call as well the unknown method */ - if ((Tcl_Command_flags(cmd) & XOTCL_PROTECTED_METHOD) && - (flags & XOTCL_CM_NO_UNKNOWN) == 0) { + if ((Tcl_Command_flags(cmd) & XOTCL_PROTECTED_METHOD) && + (flags & XOTCL_CM_NO_UNKNOWN) == 0) { XOTclCallStackContent *csc = CallStackGetTopFrame(interp); XOTclObject *o = NULL; XOTclObjConvertObject(interp, objv[0], &o); @@ -5672,8 +5672,8 @@ objectName(obj), frameType);*/ if ((result = DoCallProcCheck(clientData, interp, objc-1, objv+1, cmd, obj, cl, methodName, frameType)) == TCL_ERROR) { - result = XOTclErrInProc(interp, cmdName, - cl ? cl->object.cmdName : NULL, + result = XOTclErrInProc(interp, cmdName, + cl ? cl->object.cmdName : NULL, methodName); } unknown = RUNTIME_STATE(interp)->unknown; @@ -5687,7 +5687,7 @@ if (unknown) { if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { - return XOTclVarErrMsg(interp, ObjStr(objv[0]), + return XOTclVarErrMsg(interp, ObjStr(objv[0]), ": unable to dispatch method '", methodName, "'", (char *) NULL); } else if (objv[1] != XOTclGlobalObjects[XOTE_UNKNOWN]) { @@ -5712,7 +5712,7 @@ FREE_ON_STACK(tov); } else { /* unknown failed */ - return XOTclVarErrMsg(interp, ObjStr(objv[0]), + return XOTclVarErrMsg(interp, ObjStr(objv[0]), ": unable to dispatch method '", ObjStr(objv[2]), "'", (char *) NULL); } @@ -5781,7 +5781,7 @@ #ifdef XOTCL_BYTECODE int -XOTclDirectSelfDispatch(ClientData clientData, Tcl_Interp *interp, +XOTclDirectSelfDispatch(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int result; #ifdef XOTCLOBJ_TRACE @@ -5798,23 +5798,17 @@ * Non Positional Args */ -static void argDefinitionsFree(argDefinition *argDefinitions, int nr); +static void argDefinitionsFree(argDefinition *argDefinitions); static void NonposArgsDeleteHashEntry(Tcl_HashEntry *hPtr) { XOTclNonposArgs *nonposArg = (XOTclNonposArgs*) Tcl_GetHashValue(hPtr); if (nonposArg) { - if (nonposArg->nonposArgs) { - DECR_REF_COUNT(nonposArg->nonposArgs); - } - if (nonposArg->ordinaryArgs) { - DECR_REF_COUNT(nonposArg->ordinaryArgs); - } if (nonposArg->slotObj) { DECR_REF_COUNT(nonposArg->slotObj); } if (nonposArg->ifd) { - argDefinitionsFree(nonposArg->ifd, nonposArg->ifdSize); + argDefinitionsFree(nonposArg->ifd); } MEM_COUNT_FREE("nonposArg", nonposArg); @@ -5854,62 +5848,35 @@ } static Tcl_Obj * -NonposArgsFormat(Tcl_Interp *interp, Tcl_Obj *nonposArgsData) { - int r1, npalistc, npac, checkc, checkArgc, i, j, first; - Tcl_Obj **npalistv, **npav, **checkv, **checkArgv, - *list = Tcl_NewListObj(0, NULL), *innerlist, - *nameStringObj; +NonposArgsFormat(Tcl_Interp *interp, XOTclNonposArgs *nonposArgs) { + int first; + Tcl_Obj *list = Tcl_NewListObj(0, NULL), *innerlist, *nameStringObj; + argDefinition CONST *aPtr; - /*fprintf(stderr, "nonposargsformat '%s'\n", ObjStr(nonposArgsData));*/ - - r1 = Tcl_ListObjGetElements(interp, nonposArgsData, &npalistc, &npalistv); - if (r1 == TCL_OK) { - for (i=0; i < npalistc; i++) { - r1 = Tcl_ListObjGetElements(interp, npalistv[i], &npac, &npav); - if (r1 == TCL_OK) { - nameStringObj = Tcl_NewStringObj("-", 1); - Tcl_AppendStringsToObj(nameStringObj, ObjStr(npav[0]), - (char *) NULL); - if (npac > 1 && *(ObjStr(npav[1])) != '\0') { - first = 1; - r1 = Tcl_ListObjGetElements(interp, npav[1], &checkc, &checkv); - if (r1 == TCL_OK) { - for (j=0; j < checkc; j++) { - if (first) { - Tcl_AppendToObj(nameStringObj,":", 1); - first = 0; - } else { - Tcl_AppendToObj(nameStringObj,",", 1); - } - r1 = Tcl_ListObjGetElements(interp, checkv[j], &checkArgc, &checkArgv); - Tcl_AppendToObj(nameStringObj, ObjStr(checkArgv[0]), -1); - } - } + for (aPtr = nonposArgs->ifd; aPtr->name; aPtr++) { + if (*aPtr->name == '-') { + first = 1; + nameStringObj = Tcl_NewStringObj(aPtr->name, -1); + if (aPtr->required || aPtr->type) { + Tcl_AppendToObj(nameStringObj,":", 1); + if (aPtr->required) { + first = 0; + Tcl_AppendToObj(nameStringObj,"required", 8); } - /* fprintf(stderr, "nonposargsformat namestring '%s'\n", - ObjStr(nameStringObj));*/ - -#if 1 - innerlist = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(interp, innerlist, nameStringObj); - if (npac > 2) { - Tcl_ListObjAppendElement(interp, innerlist, npav[2]); + if (aPtr->type) { + if (!first) + Tcl_AppendToObj(nameStringObj,",", 1); + Tcl_AppendToObj(nameStringObj,aPtr->type, -1); } -#else - { - Tcl_DString ds, *dsPtr = &ds; - DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, ObjStr(nameStringObj), -1); - if (npac > 2) { - Tcl_DStringAppendElement(dsPtr, ObjStr(npav[2])); - } - innerlist = Tcl_NewStringObj(Tcl_DStringValue(dsPtr), - Tcl_DStringLength(dsPtr)); - DSTRING_FREE(dsPtr); - } -#endif - Tcl_ListObjAppendElement(interp, list, innerlist); } + + innerlist = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, innerlist, nameStringObj); + if (aPtr->defaultValue) { + Tcl_ListObjAppendElement(interp, innerlist, aPtr->defaultValue); + } + + Tcl_ListObjAppendElement(interp, list, innerlist); } } return list; @@ -5920,29 +5887,25 @@ */ static Tcl_Obj *addPrefixToBody(Tcl_Obj *body, int nonposArgs) { - Tcl_Obj *resultBody; - resultBody = Tcl_NewStringObj("", 0); + Tcl_Obj *resultBody = Tcl_NewStringObj("", 0); + INCR_REF_COUNT(resultBody); #if defined(PRE85) Tcl_AppendStringsToObj(resultBody, "::xotcl::initProcNS\n", (char *) NULL); -#endif - if (nonposArgs) { -#if 1 - /* just for now */ - Tcl_AppendStringsToObj(resultBody, - "::xotcl::interpretNonpositionalArgs {*}$args\n", + if (nonposArgs) + Tcl_AppendStringsToObj(resultBody, "::eval ::xotcl::interpretNonpositionalArgs $args\n", (char *) NULL); #else - Tcl_AppendStringsToObj(resultBody, - "::xotcl::interpretNonpositionalArgs $args\n", + if (nonposArgs) + Tcl_AppendStringsToObj(resultBody, "::xotcl::interpretNonpositionalArgs {*}$args\n", (char *) NULL); #endif - } Tcl_AppendStringsToObj(resultBody, ObjStr(body), (char *) NULL); return resultBody; } -static Tcl_Obj* +/* todo maybe, we will need this for custom type checkers */ +static Tcl_Obj* nonposargType(Tcl_Interp *interp, char *start, int len) { Tcl_Obj *result = Tcl_NewListObj(0, NULL); Tcl_Obj *type = Tcl_NewStringObj(start, len); @@ -5955,7 +5918,6 @@ return result; } - #define NEW_STRING(target,p,l) target = ckalloc(l+1); strncpy(target,p,l); *((target)+l) = '\0' static argDefinition *argDefinitionsNew(int nr) { @@ -5964,79 +5926,168 @@ return interface; } -static void argDefinitionsFree(argDefinition *argDefinitions, int nr) { - int i; +static void argDefinitionsFree(argDefinition *argDefinitions) { argDefinition *ifPtr; /*fprintf(stderr,"freeing %d argDefinitions\n",nr);*/ - for (i=0, ifPtr=argDefinitions; iname; ifPtr++) { /*fprintf(stderr,".... ifPtr = %p, name=%s, defaultValue %p\n",ifPtr,ifPtr->name,ifPtr->defaultValue);*/ if (ifPtr->name) ckfree(ifPtr->name); if (ifPtr->defaultValue) {DECR_REF_COUNT(ifPtr->defaultValue);} } FREE(argDefinition*,argDefinitions); } +XOTCLINLINE static int +noMetaChars(char *pattern) { + register char c, *p = pattern; + assert(pattern); + for (c=*p; c; c = *++p) { + if (c == '*' || c == '?' || c == '[') { + return 0; + } + } + return 1; +} -static XOTclTypeConverter convertToBoolean; -static XOTclTypeConverter convertToTclobj; +/* + * type converter + */ +static int convertToString(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + *clientData = (char *)ObjStr(objPtr); + return TCL_OK; +} +static int convertToTclobj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + *clientData = (ClientData)objPtr; + return TCL_OK; +} +static int convertToNothing(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + return TCL_OK; +} +static int convertToBoolean(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + int result, bool; + result = Tcl_GetBooleanFromObj(interp, objPtr, &bool); + if (result == TCL_OK) *clientData = (ClientData)bool; + return result; +} +static int convertToInteger(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + int result, i; + result = Tcl_GetIntFromObj(interp, objPtr, &i); + if (result == TCL_OK) *clientData = (ClientData)i; + return result; +} +static int convertToSwitch(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + return convertToBoolean(interp, objPtr, clientData); +} +static int convertToClass(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + if (GetXOTclClassFromObj(interp, objPtr, (XOTclClass **)clientData, 0) == TCL_OK) + return TCL_OK; + return XOTclObjErrType(interp, objPtr, "class"); +} +static int convertToObject(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + if (XOTclObjConvertObject(interp, objPtr, (XOTclObject **)clientData) == TCL_OK) + return TCL_OK; + return XOTclObjErrType(interp, objPtr, "object"); +} +static int convertToObjpattern(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { + Tcl_Obj *patternObj = objPtr; + char *pattern = ObjStr(objPtr); + + if (noMetaChars(pattern)) { + /* we have no meta characters, we try to check for an existing object */ + XOTclObject *obj = NULL; + XOTclObjConvertObject(interp, objPtr, &obj); + if (obj) { + patternObj = obj->cmdName; + } + } else { + /* + * We have a pattern and meta characters, we might have + * to prefix it to ovoid abvious errors: since all object + * names are prefixed with ::, we add this prefix automatically + * to the match pattern, if it does not exist + */ + if (*pattern != ':' && *pattern+1 != ':') { + patternObj = Tcl_NewStringObj("::", 2); + Tcl_AppendToObj(patternObj, pattern, -1); + } + } + if (patternObj) { + INCR_REF_COUNT(patternObj); + } + *clientData = (ClientData)patternObj; + return TCL_OK; +} + static int parseNonposargsOption(Tcl_Interp *interp, char *option, int length, argDefinition *ifPtr) { - fprintf(stderr, "def %s, option '%s' (%d)\n",ifPtr->name,option,length); - if (strncmp(option,"switch",length) == 0) { + /*fprintf(stderr, "def %s, option '%s' (%d)\n",ifPtr->name,option,length);*/ + if (strncmp(option,"required",length) == 0) { + ifPtr->required = 1; + } else if (strncmp(option,"switch",length) == 0) { ifPtr->nrargs = 0; - ifPtr->converter = convertToBoolean; + ifPtr->converter = convertToSwitch; assert(ifPtr->defaultValue == NULL); ifPtr->defaultValue = Tcl_NewBooleanObj(0); - fprintf(stderr, "setting default for switch\n"); INCR_REF_COUNT(ifPtr->defaultValue); + ifPtr->type = "switch"; + } else if (strncmp(option,"integer",length) == 0) { + ifPtr->nrargs = 1; + ifPtr->converter = convertToInteger; + ifPtr->type = "integer"; } else if (strncmp(option,"boolean",length) == 0) { ifPtr->nrargs = 1; ifPtr->converter = convertToBoolean; - } else if (strncmp(option,"required",length) == 0) { - ifPtr->required = 1; + ifPtr->type = "boolean"; + } else if (strncmp(option,"object",length) == 0) { + ifPtr->nrargs = 1; + ifPtr->converter = convertToObject; + ifPtr->type = "object"; + } else if (strncmp(option,"class",length) == 0) { + ifPtr->nrargs = 1; + ifPtr->converter = convertToClass; + ifPtr->type = "class"; } else { fprintf(stderr, "**** unknown option: def %s, option '%s' (%d)\n",ifPtr->name,option,length); } return TCL_OK; } static int -parseArgDefinition(Tcl_Interp *interp, char *procName, Tcl_Obj *arg, int isNpa, - Tcl_Obj **argObjPtr, argDefinition *ifPtr) { - Tcl_Obj **npav, *argObj; +parseArgDefinition(Tcl_Interp *interp, char *procName, Tcl_Obj *arg, int isNonposArgument, + argDefinition *ifPtr) { + Tcl_Obj **npav; char *argString, *argName; int rc, npac, length, j, nameLength; rc = Tcl_ListObjGetElements(interp, arg, &npac, &npav); if (rc != TCL_OK || npac < 1 || npac > 2) { - return XOTclVarErrMsg(interp, "wrong # of elements in non-positional args for method", + return XOTclVarErrMsg(interp, "wrong # of elements in non-positional args for method", procName, " (should be 1 or 2 list elements): ", ObjStr(arg), (char *) NULL); } argString = ObjStr(npav[0]); length = strlen(argString); - if (isNpa && *argString != '-') { + if (isNonposArgument && *argString != '-') { return XOTclVarErrMsg(interp, "non-positional arg '", argString,"' of method ",procName, " does not start with '-': ", argString, (char *) NULL); } - if (isNpa) { + if (isNonposArgument) { argName = argString+1; nameLength = length-1; + ifPtr->nrargs = 1; /* per default 1 argument, switches set their arg numbers */ } else { argName = argString; nameLength = length; - ifPtr->required = 1; + ifPtr->required = 1; /* positional arguments are required unless we have a default */ } - *argObjPtr = argObj = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(argObj); /*fprintf(stderr, "... parsing '%s', name '%s' \n",ObjStr(arg),argName);*/ - + /* find the first ':' */ for (j=0; jname,argString,j); /* skip space */ for (start = j+1; start0 && isspace((int)argString[end-1]); end--); - Tcl_ListObjAppendElement(interp, list, - nonposargType(interp, argString+start, end-start)); + for (end = l; end>0 && isspace((int)argString[end-1]); end--); parseNonposargsOption(interp, argString+start, end-start, ifPtr); l++; /* skip space */ for (start = l; start0 && isspace((int)argString[end-1]); end--); - Tcl_ListObjAppendElement(interp, list, - nonposargType(interp, argString+start, end-start)); + for (end = l; end>0 && isspace((int)argString[end-1]); end--); + /* process last option */ parseNonposargsOption(interp, argString+start, end-start, ifPtr); - /* append the whole thing to the list */ - Tcl_ListObjAppendElement(interp, argObj, list); - /* fprintf(stderr," appending list npa='%s'\n", ObjStr(argObj));*/ } else { /* no ':', the whole arg is the name */ NEW_STRING(ifPtr->name,argString,length); - Tcl_ListObjAppendElement(interp, argObj, Tcl_NewStringObj(argName, nameLength)); - Tcl_ListObjAppendElement(interp, argObj, Tcl_NewStringObj("", 0)); + if (isArgsString(argString)) { + ifPtr->converter = convertToNothing; + ifPtr->required = 0; + } } - /* check for default */ + + /* check for default values */ if (npac == 2) { - Tcl_ListObjAppendElement(interp, argObj, npav[1]); if (ifPtr->defaultValue) { /* might be set by parseNonposargsOption */ DECR_REF_COUNT(ifPtr->defaultValue); } ifPtr->defaultValue = Tcl_DuplicateObj(npav[1]); INCR_REF_COUNT(ifPtr->defaultValue); - ifPtr->required = 0; /* well, not required during the call */ + /* the argument will not required for an invocation, since we have a default */ + ifPtr->required = 0; } - /*fprintf(stderr, "... argObj '%s'\n",ObjStr(argObj));*/ /*fprintf(stderr,"%p %s ifPtr->name = '%s', nrargs %d, required %d, converter %p default %s\n",ifPtr,procName, ifPtr->name,ifPtr->nrargs,ifPtr->required, ifPtr->converter, ifPtr->defaultValue ? ObjStr(ifPtr->defaultValue) : "NONE");*/ @@ -6101,12 +6145,10 @@ } static int -parseNonposArgs(Tcl_Interp *interp, - char *procName, Tcl_Obj *npArgs, Tcl_Obj *ordinaryArgs, - Tcl_HashTable **nonposArgsTable, - int *haveNonposArgs) { +parseNonposArgs(Tcl_Interp *interp, char *procName, Tcl_Obj *npArgs, Tcl_Obj *ordinaryArgs, + Tcl_HashTable **nonposArgsTable, int *haveNonposArgs) { int rc, i, nonposArgsDefc, ordinaryArgsDefc; - Tcl_Obj **nonposArgsDefv, **ordinaryArgsDefv, *argObj, *nonposArgsObj,*posArgObj; + Tcl_Obj **nonposArgsDefv, **ordinaryArgsDefv; argDefinition *interface, *ifPtr; rc = Tcl_ListObjGetElements(interp, npArgs, &nonposArgsDefc, &nonposArgsDefv); @@ -6120,56 +6162,32 @@ ObjStr(ordinaryArgs), (char *) NULL); } - ifPtr = interface = argDefinitionsNew(nonposArgsDefc+ordinaryArgsDefc); /* TODO: add free on error exits */ - + ifPtr = interface = argDefinitionsNew(nonposArgsDefc+ordinaryArgsDefc); if (nonposArgsDefc > 0) { - nonposArgsObj = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(nonposArgsObj); - for (i=0; i < nonposArgsDefc; i++) { - - if ((rc = parseArgDefinition(interp, procName, nonposArgsDefv[i], 1, &argObj, ifPtr)) != TCL_OK) { - DECR_REF_COUNT(nonposArgsObj); + for (i=0; i < nonposArgsDefc; i++, ifPtr++) { + rc = parseArgDefinition(interp, procName, nonposArgsDefv[i], 1, ifPtr); + if (rc != TCL_OK) { + argDefinitionsFree(interface); return rc; } - *haveNonposArgs = 1; - Tcl_ListObjAppendElement(interp, nonposArgsObj, argObj); - ifPtr++; } - /* TODO: + /* TODO: for the time being, process the pos args only when we have nonpos args. We have to benchmark the overhead and maybe we have to provide a switch via e.g. configure to activate/deactivate pos args handling. */ if (*haveNonposArgs) { - posArgObj = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(posArgObj); - - for (i=0; i< ordinaryArgsDefc; i++) { - Tcl_Obj **resultObjv; - int resultObjc; - - if ((rc = parseArgDefinition(interp, procName, ordinaryArgsDefv[i], 0, &argObj, ifPtr)) != TCL_OK) { - DECR_REF_COUNT(posArgObj); + for (i=0; i< ordinaryArgsDefc; i++, ifPtr++) { + rc = parseArgDefinition(interp, procName, ordinaryArgsDefv[i], 0, ifPtr); + if (rc != TCL_OK) { + argDefinitionsFree(interface); return rc; } - /* TODO: once we get all info from our interface definition, this should no be necessary */ - rc = Tcl_ListObjGetElements(interp, argObj, &resultObjc, &resultObjv); - /*fprintf(stderr, "ordinary args oc %d, rc %d '%s'\n",resultObjc,rc,ObjStr(argObj));*/ - if (resultObjc < 3) { - Tcl_ListObjAppendElement(interp, posArgObj, resultObjv[0]); - } else { - Tcl_Obj *pair = Tcl_NewListObj(0,NULL); - Tcl_ListObjAppendElement(interp, pair, resultObjv[0]); - Tcl_ListObjAppendElement(interp, pair, resultObjv[2]); - Tcl_ListObjAppendElement(interp, posArgObj, pair); - DECR_REF_COUNT(argObj); - } - ifPtr++; } } - + if (*haveNonposArgs) { XOTclNonposArgs *nonposArg; Tcl_HashEntry *hPtr; @@ -6178,31 +6196,26 @@ if (*nonposArgsTable == NULL) { *nonposArgsTable = NonposArgsCreateTable(); } - + hPtr = Tcl_CreateHashEntry(*nonposArgsTable, procName, &nw); assert(nw); - + MEM_COUNT_ALLOC("nonposArg", nonposArg); nonposArg = (XOTclNonposArgs*)ckalloc(sizeof(XOTclNonposArgs)); nonposArg->slotObj = NULL; - nonposArg->nonposArgs = nonposArgsObj; nonposArg->ifd = interface; - nonposArg->ifdSize = nonposArgsDefc+ordinaryArgsDefc; - nonposArg->ordinaryArgs = posArgObj; Tcl_SetHashValue(hPtr, (ClientData)nonposArg); } else { /* empty definitions */ - DECR_REF_COUNT(nonposArgsObj); } } return TCL_OK; } - static int -MakeProc(Tcl_Namespace *ns, XOTclAssertionStore *aStore, Tcl_HashTable **nonposArgsTable, - Tcl_Interp *interp, +MakeProc(Tcl_Namespace *ns, XOTclAssertionStore *aStore, Tcl_HashTable **nonposArgsTable, + Tcl_Interp *interp, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition, XOTclObject *obj, int clsns) { int result, haveNonposArgs = 0, argsc, i; @@ -6300,7 +6313,7 @@ return result; } -static int makeMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, +static int makeMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition, int clsns) { XOTclClassOpt *opt = cl->opt; int result = TCL_OK; @@ -6314,7 +6327,7 @@ className(cl), " can not be overwritten. Derive a ", "sub-class", (char *) NULL); if (precondition && !postcondition) { - return XOTclVarErrMsg(interp, className(cl), " method '", nameStr, + return XOTclVarErrMsg(interp, className(cl), " method '", nameStr, "'; when specifying a precondition (", ObjStr(precondition), ") a postcondition must be specified as well", (char *) NULL); @@ -6331,8 +6344,8 @@ opt->assertions = AssertionCreateStore(); aStore = opt->assertions; } - result = MakeProc(cl->nsPtr, aStore, &(cl->nonposArgsTable), - interp, name, args, body, precondition, postcondition, + result = MakeProc(cl->nsPtr, aStore, &(cl->nonposArgsTable), + interp, name, args, body, precondition, postcondition, &cl->object, clsns); } @@ -6342,19 +6355,7 @@ return result; } -XOTCLINLINE static int -noMetaChars(char *pattern) { - register char c, *p = pattern; - assert(pattern); - for (c=*p; c; c = *++p) { - if (c == '*' || c == '?' || c == '[') { - return 0; - } - } - return 1; -} - -static int +static int getMatchObject(Tcl_Interp *interp, Tcl_Obj *patternObj, Tcl_Obj *origObj, XOTclObject **matchObject, char **pattern) { if (patternObj) { @@ -6384,8 +6385,8 @@ } static int -forwardProcessOptions(Tcl_Interp *interp, Tcl_Obj *name, - Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, +forwardProcessOptions(Tcl_Interp *interp, Tcl_Obj *name, + Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int objc, Tcl_Obj * CONST objv[], forwardCmdClientData **tcdp) { @@ -6403,11 +6404,11 @@ if (withMethodprefix) { tcd->prefix = withMethodprefix; INCR_REF_COUNT(tcd->prefix); - } + } if (withOnerror) { tcd->onerror = withOnerror; INCR_REF_COUNT(tcd->onerror); - } + } tcd->objscope = withObjscope; tcd->verbose = withVerbose; tcd->needobjmap = 0; @@ -6432,7 +6433,7 @@ tcd->cmdName = name; } - /*fprintf(stderr, "cmdName = %s, args = %s, # = %d\n", + /*fprintf(stderr, "cmdName = %s, args = %s, # = %d\n", ObjStr(tcd->cmdName), tcd->args?ObjStr(tcd->args):"NULL", tcd->nr_args);*/ if (tcd->objscope) { @@ -6453,7 +6454,7 @@ if (withEarlybinding) { Tcl_Command cmd = Tcl_GetCommandFromObj(interp, tcd->cmdName); - if (cmd == NULL) + if (cmd == NULL) return XOTclVarErrMsg(interp, "cannot lookup command '", ObjStr(tcd->cmdName), "'", (char *) NULL); tcd->objProc = Tcl_Command_objProc(cmd); @@ -6466,7 +6467,7 @@ tcd->clientData = Tcl_Command_objClientData(cmd); } } - + tcd->passthrough = !tcd->args && *(ObjStr(tcd->cmdName)) != '%' && tcd->objProc; /*fprintf(stderr, "forward args = %p, name = '%s'\n", tcd->args, ObjStr(tcd->cmdName));*/ @@ -6479,17 +6480,17 @@ } static XOTclClasses * -ComputePrecedenceList(Tcl_Interp *interp, XOTclObject *obj, char *pattern, +ComputePrecedenceList(Tcl_Interp *interp, XOTclObject *obj, char *pattern, int withMixins) { XOTclClasses *precedenceList = NULL, *pcl, **npl = &precedenceList; - + if (withMixins) { if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, obj); - + if (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { XOTclCmdList *ml = obj->mixinOrder; - + while (ml) { XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); if (pattern) { @@ -6501,7 +6502,7 @@ } } } - + pcl = ComputeOrder(obj->cl, obj->cl->order, Super); for (; pcl; pcl = pcl->nextPtr) { if (pattern) { @@ -6531,26 +6532,19 @@ } static void -AppendOrdinaryArgsFromNonposArgs(Tcl_Interp *interp, XOTclNonposArgs *nonposArgs, - int varsOnly, - Tcl_Obj *argList) { - int i, rc, ordinaryArgsDefc, defaultValueObjc; - Tcl_Obj **ordinaryArgsDefv, **defaultValueObjv, *ordinaryArg; - rc = Tcl_ListObjGetElements(interp, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); - for (i=0; i < ordinaryArgsDefc; i++) { - ordinaryArg = ordinaryArgsDefv[i]; - rc = Tcl_ListObjGetElements(interp, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); - if (rc == TCL_OK) { - if (varsOnly || defaultValueObjc<2) { - Tcl_ListObjAppendElement(interp, argList, defaultValueObjv[0]); - } else { - Tcl_Obj *pair = Tcl_NewListObj(0,NULL); - Tcl_ListObjAppendElement(interp, pair, defaultValueObjv[0]); - Tcl_ListObjAppendElement(interp, pair, defaultValueObjv[1]); - Tcl_ListObjAppendElement(interp, argList, pair); - } +AppendOrdinaryArgsFromNonposArgs(Tcl_Interp *interp, XOTclNonposArgs *nonposArgs, + int varsOnly, Tcl_Obj *argList) { + argDefinition CONST *aPtr; + + for (aPtr = nonposArgs->ifd; aPtr->name; aPtr++) { + if (*aPtr->name == '-') continue; + if (varsOnly || aPtr->defaultValue == NULL) { + Tcl_ListObjAppendElement(interp, argList, Tcl_NewStringObj(aPtr->name,-1)); + } else { + Tcl_Obj *pair = Tcl_NewListObj(0,NULL); + Tcl_ListObjAppendElement(interp, pair, Tcl_NewStringObj(aPtr->name,-1)); + Tcl_ListObjAppendElement(interp, pair, aPtr->defaultValue); + Tcl_ListObjAppendElement(interp, argList, pair); } } } @@ -6610,12 +6604,12 @@ #if defined(PRE85) if (strncmp(body, "::xotcl::initProcNS\n", 20) == 0) body+=20; -#endif - /* TODO REMOVE ME - if (strncmp(body, "::xotcl::interpretNonpositionalArgs $args\n", 42) == 0) - body += 42;*/ + if (strncmp(body, "::eval ::xotcl::interpretNonpositionalArgs $args\n", 49) == 0) + body += 49; +#else if (strncmp(body, "::xotcl::interpretNonpositionalArgs {*}$args\n", 45) == 0) body += 45; +#endif return body; } @@ -6665,7 +6659,7 @@ Tcl_DeleteHashTable(&slotTable); MEM_COUNT_FREE("Tcl_InitHashTable", slotTable); - + XOTclClassListFree(pl); return slotObjects; @@ -6692,7 +6686,7 @@ if (cmd) { return NULL; } - } + } return SearchCMethod(obj->cl, methodName, &cmd); } @@ -6842,8 +6836,8 @@ */ } #endif - - /*fprintf(stderr,"givenMethod = %s, csc = %p, useCallstackObj %d, objc %d\n", + + /*fprintf(stderr,"givenMethod = %s, csc = %p, useCallstackObj %d, objc %d\n", givenMethod, csc, useCallstackObjs, objc);*/ /* if no args are given => use args from stack */ @@ -6868,12 +6862,12 @@ /* * Search the next method & compute its method data */ - NextSearchMethod(obj, interp, csc, cl, methodName, &cmd, + NextSearchMethod(obj, interp, csc, cl, methodName, &cmd, &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); /* fprintf(stderr, "NextSearchMethod -- RETURN: method=%s eoffc=%d,", - *methodName, endOfFilterChain); + *methodName, endOfFilterChain); if (obj) fprintf(stderr, " obj=%s,", objectName(obj)); @@ -6892,7 +6886,7 @@ if (obj->mixinStack) { if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_MIXIN) csc->frameType = XOTCL_CSC_TYPE_INACTIVE_MIXIN; - + /* otherwise move the command pointer forward */ if (isMixinEntry) { frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; @@ -6915,11 +6909,11 @@ obj->filterStack->currentCmdPtr = currentCmd; } } - + /* * now actually call the "next" method */ - + /* cut the flag, that no stdargs should be used, if it is there */ if (nobjc > 1) { char *nobjv1 = ObjStr(nobjv[1]); @@ -6932,7 +6926,7 @@ obj, *cl, *methodName, frameType); csc->callType &= ~XOTCL_CSC_CALL_IS_NEXT; - + if (csc->frameType == XOTCL_CSC_TYPE_INACTIVE_FILTER) csc->frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; else if (csc->frameType == XOTCL_CSC_TYPE_INACTIVE_MIXIN) @@ -6955,12 +6949,12 @@ if (!csc->self) return XOTclVarErrMsg(interp, "next: can't find self", (char *) NULL); - + if (!csc->cmdPtr) return XOTclErrMsg(interp, "next: no executing proc", TCL_STATIC); - + return XOTclNextMethod(csc->self, interp, csc->cl, - (char *)Tcl_GetCommandName(interp, csc->cmdPtr), + (char *)Tcl_GetCommandName(interp, csc->cmdPtr), objc, objv, 1); } @@ -6970,7 +6964,7 @@ char *string; if (objc != 2) return XOTclVarErrMsg(interp, "wrong # of args for __qualify", (char *) NULL); - + string = ObjStr(objv[1]); if (!isAbsolutePath(string)) { Tcl_SetObjResult(interp, NameInNamespaceObj(interp, string, callingNameSpace(interp))); @@ -7005,7 +6999,7 @@ &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); if (cmd) { - Tcl_SetObjResult(interp, getFullProcQualifier(interp, Tcl_GetCommandName(interp, cmd), + Tcl_SetObjResult(interp, getFullProcQualifier(interp, Tcl_GetCommandName(interp, cmd), o, cl, cmd)); } return TCL_OK; @@ -7062,7 +7056,7 @@ }; enum selfOptionIdx { - procIdx, classIdx, + procIdx, classIdx, activelevelIdx, argsIdx, #if defined(ACTIVEMIXIN) activemixinIdx, @@ -7075,7 +7069,7 @@ }; assert(option); - + if (Tcl_GetIndexFromObj(interp, option, opts, "self option", 0, &opt) != TCL_OK) { return TCL_ERROR; } @@ -7111,7 +7105,7 @@ Tcl_SetObjResult(interp, computeLevelObj(interp, ACTIVE_LEVEL)); break; } - + case argsIdx: { int nobjc; Tcl_Obj **nobjv; @@ -7147,36 +7141,36 @@ } break; } - + case calledclassIdx: Tcl_SetResult(interp, className(FindCalledClass(interp, obj)), TCL_VOLATILE); break; - + case callingprocIdx: csc = XOTclCallStackFindLastInvocation(interp, 1); Tcl_SetResult(interp, csc ? (char *)Tcl_GetCommandName(interp, csc->cmdPtr) : "", TCL_VOLATILE); break; - + case callingclassIdx: csc = XOTclCallStackFindLastInvocation(interp, 1); Tcl_SetObjResult(interp, csc && csc->cl ? csc->cl->object.cmdName : XOTclGlobalObjects[XOTE_EMPTY]); break; - + case callinglevelIdx: if (!obj) { Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); } else { Tcl_SetObjResult(interp, computeLevelObj(interp, CALLING_LEVEL)); } break; - + case callingobjectIdx: csc = XOTclCallStackFindLastInvocation(interp, 1); Tcl_SetObjResult(interp, csc ? csc->self->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); break; - + case filterregIdx: if (!(csc = CallStackFindActiveFilter(interp))) { rc = XOTclVarErrMsg(interp, @@ -7186,7 +7180,7 @@ Tcl_SetObjResult(interp, FilterFindReg(interp, obj, GetSelfProcCmdPtr(interp))); } break; - + case isnextcallIdx: { XOTclCallStack *cs = &RUNTIME_STATE(interp)->cs; csc = cs->top; @@ -7196,15 +7190,15 @@ (csc->callType & XOTCL_CSC_CALL_IS_NEXT))); break; } - + case nextIdx: rc = FindSelfNext(interp, obj); break; } - + return rc; } - + /* int XOTclKObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { @@ -7250,15 +7244,15 @@ static int unsetInAllNamespaces(Tcl_Interp *interp, Namespace *nsPtr, CONST char *name) { int rc = 0; - fprintf(stderr, "### unsetInAllNamespaces variable '%s', current namespace '%s'\n", + fprintf(stderr, "### unsetInAllNamespaces variable '%s', current namespace '%s'\n", name, nsPtr ? nsPtr->fullName : "NULL"); if (nsPtr) { Tcl_HashSearch search; Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); Tcl_Var *varPtr; int result; - + varPtr = (Tcl_Var *) Tcl_FindNamespaceVar(interp, name, (Tcl_Namespace *) nsPtr, 0); /*fprintf(stderr, "found %s in %s -> %p\n", name, nsPtr->fullName, varPtr);*/ if (varPtr) { @@ -7279,7 +7273,7 @@ } Tcl_DStringFree(dsPtr); } - + while (rc == 0 && entryPtr) { Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); /*fprintf(stderr, "child = %s\n", childNsPtr->fullName);*/ @@ -7299,7 +7293,7 @@ the vartrace is still active. Destroying the object will be a problem in case the variable is deleted later and fires the trace. So, we unset the variable here - which will cause a destroy via var trace, which in + which will cause a destroy via var trace, which in turn clears the volatileVarName flag. */ /*fprintf(stderr,"### freeUnsetTraceVariable %s\n", obj->opt->volatileVarName);*/ @@ -7328,8 +7322,8 @@ Tcl_Obj *obj = (Tcl_Obj *)clientData; XOTclObject *o; char *result = NULL; - - /*fprintf(stderr,"XOTclUnsetTrace %s flags %x %x\n", name, flags, + + /*fprintf(stderr,"XOTclUnsetTrace %s flags %x %x\n", name, flags, flags & TCL_INTERP_DESTROYED); */ if ((flags & TCL_INTERP_DESTROYED) == 0) { @@ -7346,7 +7340,7 @@ result = "Destroy for volatile object failed"; } else result = "No XOTcl Object passed"; - + Tcl_SetObjResult(interp, res); /* restore the result */ DECR_REF_COUNT(res); } @@ -7395,7 +7389,7 @@ CleanupDestroyObject(Tcl_Interp *interp, XOTclObject *obj, int softrecreate) { /* remove the instance, but not for ::Class/::Object */ - if ((obj->flags & XOTCL_IS_ROOT_CLASS) == 0 && + if ((obj->flags & XOTCL_IS_ROOT_CLASS) == 0 && (obj->flags & XOTCL_IS_ROOT_META_CLASS) == 0 ) { if (!softrecreate) { @@ -7429,7 +7423,7 @@ * Remove this object from all per object mixin lists and clear the mixin list */ removeFromObjectMixinsOf(obj->id, opt->mixins); - + CmdListRemoveList(&opt->mixins, GuardDel); CmdListRemoveList(&opt->filters, GuardDel); @@ -7529,7 +7523,7 @@ #if 0 { /* Prevent that PrimitiveODestroy is called more than once. - This code was used in earlier versions of XOTcl + This code was used in earlier versions of XOTcl but does not seem necessary any more. If it has to be used again in the future, don't use Tcl_GetCommandFromObj() in Tcl 8.4.* versions. @@ -7644,13 +7638,13 @@ static XOTclClass * DefaultSuperClass(Tcl_Interp *interp, XOTclClass *cl, XOTclClass *mcl, int isMeta) { XOTclClass *defaultClass = NULL; - + /*fprintf(stderr, "DefaultSuperClass cl %s, mcl %s, isMeta %d\n", className(cl), className(mcl), isMeta );*/ if (mcl) { int result; - result = setInstVar(interp, (XOTclObject *)mcl, isMeta ? + result = setInstVar(interp, (XOTclObject *)mcl, isMeta ? XOTclGlobalObjects[XOTE_DEFAULTMETACLASS] : XOTclGlobalObjects[XOTE_DEFAULTSUPERCLASS], NULL); @@ -7668,7 +7662,7 @@ /*fprintf(stderr,"DefaultSuperClass: search in superclasses starting with %p\n",cl->super);*/ for (sc = mcl->super; sc && sc->cl != cl; sc = sc->nextPtr) { /*fprintf(stderr, " ... check ismeta %d %s root mcl %d root cl %d\n", - isMeta, className(sc->cl), + isMeta, className(sc->cl), sc->cl->object.flags & XOTCL_IS_ROOT_META_CLASS, sc->cl->object.flags & XOTCL_IS_ROOT_CLASS);*/ if (isMeta) { @@ -7689,7 +7683,7 @@ } else { /* during bootstrapping, there might be no meta class defined yet */ /*fprintf(stderr, "no meta class ismeta %d %s root mcl %d root cl %d\n", - isMeta, className(cl), + isMeta, className(cl), cl->object.flags & XOTCL_IS_ROOT_META_CLASS, cl->object.flags & XOTCL_IS_ROOT_CLASS );*/ @@ -7710,36 +7704,36 @@ XOTclClass *defaultClass = NULL; assert(softrecreate? recreate == 1 : 1); - + /*fprintf(stderr, "CleanupDestroyClass softrecreate=%d,recreate=%d, %p\n", softrecreate,recreate,clopt); */ /* do this even with no clopt, since the class might be used as a superclass of a per object mixin, so it has no clopt... */ - MixinInvalidateObjOrders(interp, cl); + MixinInvalidateObjOrders(interp, cl); FilterInvalidateObjOrders(interp, cl); if (clopt) { /* * Remove this class from all isClassMixinOf lists and clear the instmixin list */ RemoveFromClassMixinsOf(clopt->id, clopt->instmixins); - + CmdListRemoveList(&clopt->instmixins, GuardDel); /*MixinInvalidateObjOrders(interp, cl);*/ - + CmdListRemoveList(&clopt->instfilters, GuardDel); /*FilterInvalidateObjOrders(interp, cl);*/ if (!recreate) { /* * Remove this class from all mixin lists and clear the isObjectMixinOf list */ - + RemoveFromMixins(clopt->id, clopt->isObjectMixinOf); CmdListRemoveList(&clopt->isObjectMixinOf, GuardDel); - + /* * Remove this class from all instmixin lists and clear the isClassMixinOf list */ @@ -7755,7 +7749,7 @@ XOTclFreeObjectData(cl); #endif } - + Tcl_ForgetImport(interp, cl->nsPtr, "*"); /* don't destroy namespace imported objects */ NSCleanupNamespace(interp, cl->nsPtr); NSDeleteChildren(interp, cl->nsPtr); @@ -7770,11 +7764,11 @@ reset to ::xotcl::Class (and not to ::xotcl::Object as in earlier versions), since otherwise their instances can't be deleted, because ::xotcl::Object has no method "dealloc". - + We do not have to reclassing in case, cl == ::xotcl::Object */ if ((cl->object.flags & XOTCL_IS_ROOT_CLASS) == 0) { - XOTclClass *baseClass = IsMetaClass(interp, cl, 1) ? + XOTclClass *baseClass = IsMetaClass(interp, cl, 1) ? DefaultSuperClass(interp, cl, cl->object.cl, 1) : defaultClass; @@ -7802,7 +7796,7 @@ } } } - } + } Tcl_DeleteHashTable(&cl->instances); MEM_COUNT_FREE("Tcl_InitHashTable",&cl->instances); } @@ -7827,8 +7821,8 @@ clopt = cl->opt = 0; } - /* On a recreate, it might be possible that the newly created class - has a different superclass. So we have to flush the precedence list + /* On a recreate, it might be possible that the newly created class + has a different superclass. So we have to flush the precedence list on a recreate as well. */ FlushPrecedencesOnSubclasses(cl); @@ -7880,9 +7874,9 @@ cl->nsPtr = namespacePtr; - if (!softrecreate) { + if (!softrecreate) { /* subclasses are preserved during recreate, superclasses not (since - the creation statement defined the superclass, might be different + the creation statement defined the superclass, might be different the second time) */ cl->sub = NULL; @@ -7982,7 +7976,7 @@ * ensure that namespace is newly created during CleanupInitClass * ie. kill it, if it exists already */ - if (Tcl_PushCallFrame(interp, (Tcl_CallFrame *)framePtr, + if (Tcl_PushCallFrame(interp, (Tcl_CallFrame *)framePtr, RUNTIME_STATE(interp)->XOTclClassesNS, 0) != TCL_OK) return; ns = NSGetFreshNamespace(interp, (ClientData)cl, name); @@ -8038,7 +8032,7 @@ XOTCLINLINE static int changeClass(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl) { assert(obj); - + /*fprintf(stderr,"changing %s to class %s ismeta %d\n", objectName(obj), className(cl), @@ -8056,22 +8050,22 @@ (char *) NULL); } } else { - /* The target class is not a meta class. Changing meta-class to - meta-class, or class to class, or object to object is fine, + /* The target class is not a meta class. Changing meta-class to + meta-class, or class to class, or object to object is fine, but upgrading/downgrading is not allowed */ - /*fprintf(stderr,"target class %s not a meta class, am i a class %d\n", + /*fprintf(stderr,"target class %s not a meta class, am i a class %d\n", className(cl), XOTclObjectIsClass(obj) );*/ if (XOTclObjectIsClass(obj)) { - return XOTclVarErrMsg(interp, "cannot turn class into an object ", + return XOTclVarErrMsg(interp, "cannot turn class into an object ", (char *) NULL); } } (void)RemoveInstance(obj, obj->cl); AddInstance(obj, cl); - + MixinComputeDefined(interp, obj); FilterComputeDefined(interp, obj); } @@ -8129,11 +8123,11 @@ Tcl_Obj *savedObjResult = Tcl_GetObjResult(interp); /* save the result */ INCR_REF_COUNT(savedObjResult); - /* - * clear INIT_CALLED flag + /* + * clear INIT_CALLED flag */ obj->flags &= ~XOTCL_INIT_CALLED; - + /* * call configure methods (starting with '-') */ @@ -8143,15 +8137,15 @@ goto objinitexit; } - /* - * check, whether init was called already + /* + * check, whether init was called already */ if (!(obj->flags & XOTCL_INIT_CALLED)) { int nobjc = 0; Tcl_Obj **nobjv, *resultObj = Tcl_GetObjResult(interp); /* - * Call the user-defined constructor 'init' and pass the result of + * Call the user-defined constructor 'init' and pass the result of * configure to it as arguments */ INCR_REF_COUNT(resultObj); @@ -8161,7 +8155,7 @@ obj->flags |= XOTCL_INIT_CALLED; DECR_REF_COUNT(resultObj); } - + if (result == TCL_OK) { Tcl_SetObjResult(interp, savedObjResult); } @@ -8200,7 +8194,7 @@ cxtNsPtr = Tcl_GetCurrentNamespace(interp); } - TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,flags, + TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /*fprintf(stderr, " ***Found %s, %s\n", nsPtr[0]->fullName, nsPtr[0]->fullName);*/ @@ -8264,7 +8258,7 @@ -static int +static int hasMetaProperty(Tcl_Interp *interp, XOTclClass *cl) { return cl->object.flags & XOTCL_IS_ROOT_META_CLASS; } @@ -8284,7 +8278,7 @@ if (hasMetaProperty(interp, pl->cl)) return 1; } - + if (withMixins) { /* has the class metaclass mixed in? */ for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->nextPtr) { @@ -8296,7 +8290,7 @@ &checkList, 0); } } - + /* TODO: should be a class of isMetaClass, or? */ for (mc=mixinClasses; mc; mc = mc->nextPtr) { /*fprintf(stderr,"- got %s\n", className(mc->cl));*/ @@ -8310,7 +8304,7 @@ XOTclClassListFree(checkList); /*fprintf(stderr,"has MC returns %d, mixinClasses = %p\n", hasMCM, mixinClasses);*/ - } + } return hasMCM; } @@ -8340,7 +8334,7 @@ int success = 0, opt; static CONST char *opts[] = { - "type", "object", "class", "metaclass", "mixin", + "type", "object", "class", "metaclass", "mixin", NULL }; enum subCmdIdx { @@ -8350,21 +8344,21 @@ if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0, &opt) != TCL_OK) { return TCL_ERROR; } - + switch (opt) { - case typeIdx: - if (objc != 4) return XOTclObjErrArgCnt(interp, objv[0], NULL, "type "); - success = (XOTclObjConvertObject(interp, objv[1], &obj) == TCL_OK + case typeIdx: + if (objc != 4) return XOTclObjErrArgCnt(interp, objv[0], NULL, "type "); + success = (XOTclObjConvertObject(interp, objv[1], &obj) == TCL_OK && GetXOTclClassFromObj(interp, objv[3], &cl, 0) == TCL_OK && isSubType(obj->cl, cl)); break; - case objectIdx: + case objectIdx: if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, "object "); success = (XOTclObjConvertObject(interp, objv[1], &obj) == TCL_OK); break; - case classIdx: + case classIdx: if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, "class "); success = (GetXOTclClassFromObj(interp, objv[1], &cl, 0) == TCL_OK); break; @@ -8380,8 +8374,8 @@ case mixinIdx: if (objc != 4) return XOTclObjErrArgCnt(interp, objv[0], NULL, "mixin "); - success = (XOTclObjConvertObject(interp, objv[1], &obj) == TCL_OK - && GetXOTclClassFromObj(interp, objv[3], &cl, 0) == TCL_OK + success = (XOTclObjConvertObject(interp, objv[1], &obj) == TCL_OK + && GetXOTclClassFromObj(interp, objv[3], &cl, 0) == TCL_OK && hasMixin(interp, obj, cl)); break; } @@ -8439,20 +8433,20 @@ int objc, Tcl_Obj *CONST objv[]) { XOTclClass *cl = (XOTclClass *) class; int result; - + INCR_REF_COUNT(name); - + ALLOC_ON_STACK(Tcl_Obj *, objc+2, ov); ov[0] = NULL; ov[1] = name; if (objc>0) { memcpy(ov+2, objv, sizeof(Tcl_Obj *)*objc); } result = createMethod(interp, cl, ObjStr(name), objc+2, ov); - + FREE_ON_STACK(ov); DECR_REF_COUNT(name); - + return result; } @@ -8505,7 +8499,7 @@ if (otherPtr == NULL) { return XOTclVarErrMsg(interp, "can't make instvar ", ObjStr(varName), - ": can't find variable on ", objectName(obj), + ": can't find variable on ", objectName(obj), (char *) NULL); } /* @@ -8532,9 +8526,9 @@ */ if (strstr(newName, "::")) { return XOTclVarErrMsg(interp, "variable name \"", newName, - "\" illegal: must not contain namespace separator", + "\" illegal: must not contain namespace separator", (char *) NULL); - } + } #endif varFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); @@ -8549,10 +8543,10 @@ Var *localVarPtr = Tcl_CallFrame_compiledLocals(varFramePtr); char *newNameString = ObjStr(newName); int i, nameLen = strlen(newNameString); - + for (i = 0; i < localCt; i++) { /* look in compiled locals */ /* fprintf(stderr,"%d of %d %s flags %x not isTemp %d\n", i, localCt, - localPtr->name, localPtr->flags, + localPtr->name, localPtr->flags, !TclIsCompiledLocalTemporary(localPtr));*/ if (!TclIsCompiledLocalTemporary(localPtr)) { @@ -8567,7 +8561,7 @@ } localPtr = localPtr->nextPtr; } - + if (varPtr == NULL) { /* look in frame's local var hashtable */ tablePtr = Tcl_CallFrame_varTablePtr(varFramePtr); if (tablePtr == NULL) { @@ -8584,7 +8578,7 @@ if (!new) { /*fprintf(stderr,"GetIntoScope createalias\n");*/ if (varPtr == otherPtr) - return XOTclVarErrMsg(interp, "can't instvar to variable itself", + return XOTclVarErrMsg(interp, "can't instvar to variable itself", (char *) NULL); if (TclIsVarLink(varPtr)) { @@ -8596,15 +8590,15 @@ /*fprintf(stderr, "linkvar flags=%x\n", linkPtr->flags); Tcl_Panic("new linkvar %s... When does this happen?", newNameString, NULL);*/ - + /* We have already a variable with the same name imported - from a different object. Get rid of this old variable + from a different object. Get rid of this old variable */ VarHashRefCount(linkPtr)--; if (TclIsVarUndefined(linkPtr)) { CleanupVar(linkPtr, (Var *) NULL); } - + } else if (!TclIsVarUndefined(varPtr)) { return XOTclVarErrMsg(interp, "variable '", ObjStr(newName), "' exists already", (char *) NULL); @@ -8627,13 +8621,13 @@ varPtr->value.linkPtr = otherPtr; #endif VarHashRefCount(otherPtr)++; - + /* { Var85 *p = (Var85 *)varPtr; fprintf(stderr,"defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n", ObjStr(newName), objectName(obj), forwardCompatibleMode, - varFlags(varPtr), + varFlags(varPtr), TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr)); } */ @@ -8728,7 +8722,7 @@ return (cl && cl->opt) ? cl->opt->clientData : 0; } -static int +static int setInstVar(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *name, Tcl_Obj *value) { Tcl_Obj *result; int flags = (obj->nsPtr) ? TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY : TCL_LEAVE_ERR_MSG; @@ -8746,7 +8740,7 @@ if (result) { Tcl_SetObjResult(interp, result); return TCL_OK; - } + } return TCL_ERROR; } @@ -8881,7 +8875,7 @@ } -static int +static int callForwarder(forwardCmdClientData *tcd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { ClientData clientData; int result; @@ -8923,7 +8917,7 @@ } static int -XOTclForwardMethod(ClientData clientData, Tcl_Interp *interp, +XOTclForwardMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { forwardCmdClientData *tcd = (forwardCmdClientData *)clientData; int result, j, inputarg = 1, outputarg = 0; @@ -8933,16 +8927,16 @@ /* it is a c-method; establish a value for the currentFramePtr */ RUNTIME_STATE(interp)->cs.top->currentFramePtr = (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp); - + /*fprintf(stderr,"...setting currentFramePtr %p to %p (ForwardMethod)\n", RUNTIME_STATE(interp)->cs.top->currentFramePtr, (Tcl_CallFrame *) Tcl_Interp_varFramePtr(interp)); */ - + if (tcd->passthrough) { /* two short cuts for simple cases */ /* early binding, cmd *resolved, we have to care only for objscope */ return callForwarder(tcd, interp, objc, objv); return callForwarder(tcd, interp, objc, objv); - } else if (!tcd->args && *(ObjStr(tcd->cmdName)) != '%') { + } else if (!tcd->args && *(ObjStr(tcd->cmdName)) != '%') { /* we have ony to replace the method name with the given cmd name */ ALLOC_ON_STACK(Tcl_Obj*, objc, ov); /*fprintf(stderr,"+++ forwardMethod must subst \n");*/ @@ -8962,7 +8956,7 @@ if (tcd->needobjmap) { memset(objvmap, -1, sizeof(int)*totalargs); } - + #if 0 fprintf(stderr,"command %s (%p) objc=%d, subcommand=%d, args=%p, nrargs\n", ObjStr(objv[0]), tcd, objc, @@ -9015,7 +9009,7 @@ fprintf(stderr,"\n"); #endif - if (tcd->needobjmap) + if (tcd->needobjmap) for (j=0; jcmdName; - result = callForwarder(tcd, interp, objc, ov); + OV[0] = tcd->cmdName; + result = callForwarder(tcd, interp, objc, ov); if (tcd->prefix) {DECR_REF_COUNT(ov[1]);} exitforwardmethod: @@ -9091,11 +9085,11 @@ int rc; XOTcl_FrameDecls; /* fprintf(stderr,"objscopedMethod obj=%p, ptr=%p\n", obj, tcd->objProc); */ - + XOTcl_PushFrame(interp, obj); rc = (tcd->objProc)(tcd->clientData, interp, objc, objv); XOTcl_PopFrame(interp, obj); - + return rc; } @@ -9107,7 +9101,7 @@ } static int -XOTclDispatchCmd(ClientData clientData, Tcl_Interp *interp, +XOTclDispatchCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { int result; char *method; @@ -9119,11 +9113,11 @@ } XOTclObjConvertObject(interp, objv[2], &obj); - if (!obj) + if (!obj) return XOTclObjErrType(interp, objv[2], "Class|Object"); method = ObjStr(objv[1]); - n = method + strlen(method); + n = method + strlen(method); /*fprintf(stderr, "Dispatch obj=%s, o=%p cmd m='%s'\n",ObjStr(objv[2]),obj,method);*/ @@ -9135,7 +9129,7 @@ /*search for last '::'*/ while ((*n != ':' || *(n-1) != ':') && n-1 > method) {n--; } if (*n == ':' && n > method && *(n-1) == ':') {n--;} - + if ((n-method)>1 || *method == ':') { Tcl_DString parentNSName, *dsp = &parentNSName; Tcl_Namespace *ns; @@ -9153,7 +9147,7 @@ } if (!ns) { return XOTclVarErrMsg(interp, "cannot lookup parent namespace '", - method, "'", (char *) NULL); + method, "'", (char *) NULL); } fprintf(stderr, " .... findmethod '%s' in %s\n",tail, ns->fullName); cmd = FindMethod(tail, ns); @@ -9165,13 +9159,13 @@ return XOTclVarErrMsg(interp, "cannot lookup command '", tail, "'", (char *) NULL); } - + result = DoCallProcCheck((ClientData)obj, interp, - objc-2, objv+2, cmd, obj, + objc-2, objv+2, cmd, obj, NULL /*XOTclClass *cl*/, tail, XOTCL_CSC_TYPE_PLAIN); } else { - /* no colons, use method from dispatch order, with filters etc. - + /* no colons, use method from dispatch order, with filters etc. - strictly speaking unneccessary, but can be used to invoke protected methods */ int nobjc; Tcl_Obj *arg; @@ -9187,54 +9181,10 @@ nobjc = objc-3; result = XOTclCallMethodWithArgs((ClientData)obj, interp, objv[1], arg, nobjc, nobjv, XOTCL_CM_NO_UNKNOWN); - } - return result; -} - - -static int -XOTclConfigureCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - int bool, opt, result = TCL_OK; - static CONST char *opts[] = { - "filter", "softrecreate", - NULL - }; - enum subCmdIdx { - filterIdx, softrecreateIdx, - }; - - if (objc < 2 || objc>3) - return XOTclObjErrArgCnt(interp, objv[0], NULL, - "filter|softrecreate ?on|off?"); - - if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, &opt) != TCL_OK) { - return TCL_ERROR; } - - if (objc == 3) { - result = Tcl_GetBooleanFromObj(interp, objv[2], &bool); - } - if (result == TCL_OK) { - switch (opt) { - case filterIdx: - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (RUNTIME_STATE(interp)->doFilters)); - if (objc == 3) - RUNTIME_STATE(interp)->doFilters = bool; - break; - - case softrecreateIdx: - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (RUNTIME_STATE(interp)->doSoftrecreate)); - if (objc == 3) - RUNTIME_STATE(interp)->doSoftrecreate = bool; - break; - } - } return result; } - typedef enum {NO_DASH, SKALAR_DASH, LIST_DASH} dashArgType; static dashArgType @@ -9399,15 +9349,15 @@ /*fprintf(stderr,"+++ createspecifiedName '%s', objName '%s', newObj=%p ismeta(%s) %d, ismeta(%s) %d\n", specifiedName, objName, newobj, - className(cl), IsMetaClass(interp, cl, 1), - newobj ? ObjStr(newobj->cl->object.cmdName) : "NULL", + className(cl), IsMetaClass(interp, cl, 1), + newobj ? ObjStr(newobj->cl->object.cmdName) : "NULL", newobj ? IsMetaClass(interp, newobj->cl, 1) : 0 );*/ /* don't allow to - recreate an object as a class, and to - - recreate a class as an object - + - recreate a class as an object + In these clases, we use destroy + create instead of recrate. */ @@ -9427,7 +9377,7 @@ objTrace("RECREATE", newobj); } else { - /* + /* * newobj might exist here, but will be automatically destroyed by * alloc */ @@ -9463,95 +9413,31 @@ } /*********************************** - * objv parser and objv converter + * objv parser ***********************************/ -static int convertToString(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - *clientData = (char *)ObjStr(objPtr); - return TCL_OK; -} -static int convertToTclobj(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - *clientData = (ClientData)objPtr; - return TCL_OK; -} -static int convertToNothing(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - return TCL_OK; -} -static int convertToBoolean(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - Tcl_Obj *boolean = Tcl_DuplicateObj(objPtr); /*TODO: is duplication still needed?*/ - int result, bool; - INCR_REF_COUNT(boolean); - result = Tcl_GetBooleanFromObj(interp, boolean, &bool); - if (result == TCL_OK) { - *clientData = (ClientData)bool; - } - DECR_REF_COUNT(boolean); - return result; -} -static int convertToClass(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - if (GetXOTclClassFromObj(interp, objPtr, (XOTclClass **)clientData, 0) == TCL_OK) - return TCL_OK; - return XOTclObjErrType(interp, objPtr, "class"); -} -static int convertToObject(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - if (XOTclObjConvertObject(interp, objPtr, (XOTclObject **)clientData) == TCL_OK) - return TCL_OK; - return XOTclObjErrType(interp, objPtr, "object"); -} - -static int convertToObjpattern(Tcl_Interp *interp, Tcl_Obj *objPtr, ClientData *clientData) { - Tcl_Obj *patternObj = objPtr; - char *pattern = ObjStr(objPtr); - - if (noMetaChars(pattern)) { - /* we have no meta characters, we try to check for an existing object */ - XOTclObject *obj = NULL; - XOTclObjConvertObject(interp, objPtr, &obj); - if (obj) { - patternObj = obj->cmdName; - } - } else { - /* - * We have a pattern and meta characters, we might have - * to prefix it to ovoid abvious errors: since all object - * names are prefixed with ::, we add this prefix automatically - * to the match pattern, if it does not exist - */ - if (*pattern != ':' && *pattern+1 != ':') { - patternObj = Tcl_NewStringObj("::", 2); - Tcl_AppendToObj(patternObj, pattern, -1); - } - } - if (patternObj) { - INCR_REF_COUNT(patternObj); - } - *clientData = (ClientData)patternObj; - return TCL_OK; -} - #include "tclAPI.h" - -/* TODO: pass method name as a single argument, omit methodName from - objv; this will make nonposargs case simpler */ static int -parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int start, argDefinition CONST *ifdPtr, - parseContext *pc) { - int i, o, args = 0, flagCount = 0, nrReq = 0, nrOpt = 0, varArgs = 0; +parseObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], Tcl_Obj *procName, + argDefinition CONST *ifdPtr, parseContext *pc) { + int i, o, args = 0, flagCount = 0, nrReq = 0, nrOpt = 0, varArgs = 0, dashdash = 0; /* todo benchmark with and without CONST */ argDefinition CONST *aPtr, *bPtr; memset(pc, 0, sizeof(parseContext)); #if defined(PARSE_TRACE) - fprintf(stderr, "BEGIN (%d) [0]%s ",objc,start==1 ? ObjStr(objv[0]) : "NONE"); - for (o=start; oname && oname,o);*/ + /*fprintf(stderr, "processing from %d to %d\n",1,objc-1);*/ + for (i=0, o=1, aPtr=ifdPtr; aPtr->name && oname,aPtr->required?"req":"not req"); +#endif if (*aPtr->name == '-') { /* the interface defintion has switches, which can be given in an arbitrary order */ @@ -9562,23 +9448,30 @@ /*fprintf(stderr,"....checking objv[%d]=%s\n", p, objStr);*/ if (objStr[0] == '-') { found = 0; - for (bPtr = aPtr; *bPtr->name == '-'; bPtr ++) { + for (bPtr = aPtr; bPtr->name && *bPtr->name == '-'; bPtr ++) { if (strcmp(objStr,bPtr->name) == 0) { - /*fprintf(stderr, "... flag '%s' o=%d p=%d, objc=%d nrargs %d\n",objStr,o,p,objc,bPtr->nrargs);*/ - pc->objv[bPtr-ifdPtr] = objv[p]; + /*fprintf(stderr, "... flag '%s' o=%d p=%d, objc=%d nrargs %d\n",objStr,o,p,objc,bPtr->nrargs);*/ + if (bPtr->required) nrReq++; else nrOpt++; if (bPtr->nrargs == 0) { - pc->clientData[bPtr-ifdPtr] = (ClientData)1; + pc->clientData[bPtr-ifdPtr] = (ClientData)1; /* the flag was given */ + pc->objv[bPtr-ifdPtr] = XOTclGlobalObjects[XOTE_ONE]; } else { - /* we assume for now, nrargs is at most 1 */ + /* we assume for now, nrargs is at most 1 */ o++; p++; + if (bPtr->required) nrReq++; else nrOpt++; if (oconverter)(interp, objv[o], &pc->clientData[bPtr-ifdPtr]) != TCL_OK) { +#if defined(PARSE_TRACE_FULL) + fprintf(stderr, "... setting cd[%d] '%s' = %s (%d) %s\n", + bPtr-ifdPtr, bPtr->name, ObjStr(objv[p]), bPtr->nrargs, + bPtr->required?"req":"not req"); +#endif + if ((*bPtr->converter)(interp, objv[p], &pc->clientData[bPtr-ifdPtr]) != TCL_OK) { return TCL_ERROR; } + pc->objv[bPtr-ifdPtr] = objv[p]; } else { Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "Argument for flag '", objStr, "' expected", (char *) NULL); + Tcl_AppendResult(interp, "Argument for parameter '", objStr, "' expected", (char *) NULL); return TCL_ERROR; } } @@ -9596,12 +9489,23 @@ } /*fprintf(stderr, "... we found %d flags\n",flagCount);*/ /* skip in interface until the end of the switches */ - while (*aPtr->name == '-') {aPtr++,i++;}; + while (aPtr->name && *aPtr->name == '-') {aPtr++,i++;}; /* under the assumption, flags have no arguments */ - /* todo: check --; wanted? */ o += flagCount; + /* + * check double dash -- + */ + if (orequired) nrReq++; else nrOpt++; args ++; /*fprintf(stderr,"... arg %s req %d converter %p try to set on %d: '%s'\n", @@ -9610,24 +9514,25 @@ return TCL_ERROR; } - /* + /* * objv is always passed via pc->objv */ - /*fprintf(stderr, "... setting %s pc->objv[%d] to '%s'\n",aPtr->name,i,ObjStr(objv[o]));*/ +#if defined(PARSE_TRACE_FULL) + fprintf(stderr, "... setting %s pc->objv[%d] to [%d]'%s'\n",aPtr->name,i,o,ObjStr(objv[o])); +#endif pc->objv[i] = objv[o]; o++; i++; aPtr++; } } pc->lastobjc = aPtr->name ? o : o-1; - /* pc->lastobjc = aPtr->name ? o+1 : o;*/ - /* process to end of interface;*/ + /* Process to end of interface;*/ while (aPtr->name) { /*fprintf(stderr, "end of if def %s\n",aPtr->name);*/ if (aPtr->required) nrReq++; else nrOpt++; aPtr++; } - + /* is last argument a vararg? */ aPtr--; if (!varArgs && aPtr->converter == convertToNothing) { @@ -9636,23 +9541,25 @@ } /* fprintf(stderr, "less nrreq %d last arg %s type %s\n", args < nrReq, aPtr->name, aPtr->converter); - fprintf(stderr, "objc = %d, args = %d, nrReq %d, nrReq + nrOpt = %d, varArgs %d i %d %s\n", + fprintf(stderr, "objc = %d, args = %d, nrReq %d, nrReq + nrOpt = %d, varArgs %d i %d %s\n", objc,args,nrReq,nrReq + nrOpt, varArgs, i,aPtr->name);*/ #if defined(PARSE_TRACE) - fprintf(stderr, "END lastobjc %d, varargs %d, not enough args (%d<%d) = %d\n", - pc->lastobjc,varArgs, args,nrReq,args < nrReq); + fprintf(stderr, "END lastobjc %d, varargs %d, not enough args (%d<%d) = %d, to many (%d>%d) = %d\n", + pc->lastobjc, varArgs, args, nrReq, args < nrReq, + objc-dashdash-1, nrReq + nrOpt, objc-dashdash-1 > nrReq + nrOpt + ); #endif - if (args < nrReq || (!varArgs && args > nrReq + nrOpt)) { + if (pc->lastobjc < nrReq || (!varArgs && objc-dashdash-1 > nrReq + nrOpt)) { Tcl_Obj *msg = Tcl_NewStringObj("", 0); for (aPtr=ifdPtr; aPtr->name; aPtr++) { if (aPtr != ifdPtr) { Tcl_AppendToObj(msg, " ", 1); } if (aPtr->required) { Tcl_AppendToObj(msg, aPtr->name, -1); - } else { + } else { Tcl_AppendToObj(msg, "?", 1); Tcl_AppendToObj(msg, aPtr->name, -1); if (aPtr->nrargs >0) { @@ -9661,14 +9568,14 @@ Tcl_AppendToObj(msg, "?", 1); } } - return XOTclObjErrArgCntObj(interp, objv[0], NULL, msg); + return XOTclObjErrArgCntObj(interp, procName, NULL, msg); } return TCL_OK; } /*********************************** - * Begin result setting commands + * Begin result setting commands * (essentially List*() and support ***********************************/ static int @@ -9742,14 +9649,14 @@ char *key = Tcl_GetHashKey(table, hPtr); Tcl_Command cmd = (Tcl_Command)Tcl_GetHashValue(hPtr); Tcl_ObjCmdProc *proc = Tcl_Command_objProc(cmd); - + if (pattern && !Tcl_StringMatch(key, pattern)) continue; if (noCmds && proc != RUNTIME_STATE(interp)->objInterpProc) continue; if (noProcs && proc == RUNTIME_STATE(interp)->objInterpProc) continue; if (onlyForwarder && proc != XOTclForwardMethod) continue; if (onlySetter && proc != XOTclSetterMethod) continue; /* XOTclObjscopedMethod ??? */ - + if (dups) { int new; Tcl_HashEntry *duphPtr; @@ -9869,14 +9776,14 @@ XOTclClasses *pl; Tcl_HashTable dupsTable, *dups = &dupsTable; Tcl_InitHashTable(dups, TCL_STRING_KEYS); - + /*fprintf(stderr,"listMethods %s %d %d %d %d\n", pattern, noProcs, noCmds, noMixins, inContext);*/ if (obj->nsPtr) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(obj->nsPtr); ListMethodKeys(interp, cmdTable, pattern, noProcs, noCmds, dups, 0, 0); } - + if (!noMixins) { if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, obj); @@ -9899,7 +9806,7 @@ } } } - + /* append per-class filters */ for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->nextPtr) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(pl->cl->nsPtr); @@ -9971,45 +9878,29 @@ ListProcDefault(Tcl_Interp *interp, Tcl_HashTable *table, char *name, char *arg, Tcl_Obj *var) { Tcl_Obj *defVal; - int result; + if (GetProcDefault(interp, table, name, arg, &defVal) == TCL_OK) { - result = SetProcDefault(interp, var, defVal); + return SetProcDefault(interp, var, defVal); } else { - XOTclVarErrMsg(interp, "method '", name, - "' doesn't exist or doesn't have an argument '", - arg, "'", (char *) NULL); - result = TCL_ERROR; + return XOTclVarErrMsg(interp, "method '", name, + "' doesn't exist or doesn't have an argument '", + arg, "'", (char *) NULL); } - return result; } static int ListDefaultFromOrdinaryArgs(Tcl_Interp *interp, char *procName, XOTclNonposArgs *nonposArgs, char *arg, Tcl_Obj *var) { - int i, rc, ordinaryArgsDefc, defaultValueObjc; - Tcl_Obj **ordinaryArgsDefv, **defaultValueObjv, *ordinaryArg; + argDefinition CONST *aPtr; - rc = Tcl_ListObjGetElements(interp, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); - if (rc != TCL_OK) - return TCL_ERROR; - - for (i=0; i < ordinaryArgsDefc; i++) { - ordinaryArg = ordinaryArgsDefv[i]; - rc = Tcl_ListObjGetElements(interp, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); - /*fprintf(stderr, "arg='%s', *arg==0 %d, defaultValueObjc=%d\n", arg, *arg==0, defaultValueObjc);*/ - if (rc == TCL_OK) { - if (defaultValueObjc > 0 && !strcmp(arg, ObjStr(defaultValueObjv[0]))) { - return SetProcDefault(interp, var, defaultValueObjc == 2 ? defaultValueObjv[1] : NULL); - } else if (defaultValueObjc == 0 && *arg == 0) { - return SetProcDefault(interp, var, NULL); - } + for (aPtr = nonposArgs->ifd; aPtr->name; aPtr++) { + if (*aPtr->name == '-') continue; + if (strcmp(aPtr->name,arg) == 0) { + return SetProcDefault(interp, var, aPtr->defaultValue); } } - XOTclVarErrMsg(interp, "method '", procName, "' doesn't have an argument '", - arg, "'", (char *) NULL); - return TCL_ERROR; + return XOTclVarErrMsg(interp, "method '", procName, "' doesn't have an argument '", + arg, "'", (char *) NULL); } static int @@ -10055,15 +9946,15 @@ /* } */ /******************************** - * End result setting commands + * End result setting commands ********************************/ /********************************* - * Begin generated XOTcl commands + * Begin generated XOTcl commands *********************************/ -static int XOTclAliasCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, +static int XOTclAliasCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withObjscope, int withPer_object, int withProtected, Tcl_Obj *cmdName) { XOTclClass *cl; Tcl_Command cmd, importedCmd; @@ -10072,7 +9963,7 @@ Tcl_CmdDeleteProc *dp = NULL; aliasCmdClientData *tcd = NULL; int flags = 0; - + if (XOTclObjectIsClass(object)) { cl = (XOTclClass *)object; allocation = 'c'; @@ -10081,14 +9972,14 @@ allocation = 'o'; } cmd = Tcl_GetCommandFromObj(interp, cmdName); - if (cmd == NULL) + if (cmd == NULL) return XOTclVarErrMsg(interp, "cannot lookup command '", ObjStr(cmdName), "'", (char *) NULL); - + if ((importedCmd = TclGetOriginalCommand(cmd))) { cmd = importedCmd; } - objProc = Tcl_Command_objProc(cmd); + objProc = Tcl_Command_objProc(cmd); if (withObjscope) { tcd = NEW(aliasCmdClientData); @@ -10103,20 +9994,47 @@ } if (withProtected) { - flags = XOTCL_PROTECTED_METHOD; + flags = XOTCL_PROTECTED_METHOD; } if (allocation == 'c') { - XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, methodName, + XOTclAddInstanceMethod(interp, (XOTcl_Class*)cl, methodName, objProc, tcd, dp, flags); } else { - XOTclAddObjectMethod(interp, (XOTcl_Object*)object, methodName, + XOTclAddObjectMethod(interp, (XOTcl_Object*)object, methodName, objProc, tcd, dp, flags); } return TCL_OK; } -static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, +static int XOTclConfigureCmd(Tcl_Interp *interp, int configureoption, Tcl_Obj *value) { + int bool; + + if (value) { + int result = Tcl_GetBooleanFromObj(interp, value, &bool); + if (result != TCL_OK) + return result; + } + + switch (configureoption) { + case configureoptionFilterIdx: + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), + (RUNTIME_STATE(interp)->doFilters)); + if (value) + RUNTIME_STATE(interp)->doFilters = bool; + break; + + case configureoptionSoftrecreateIdx: + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), + (RUNTIME_STATE(interp)->doSoftrecreate)); + if (value) + RUNTIME_STATE(interp)->doSoftrecreate = bool; + break; + } + return TCL_OK; +} + +static int XOTclMethodPropertyCmd(Tcl_Interp *interp, XOTclObject *object, char *methodName, int withPer_object, int methodproperty, Tcl_Obj *value) { XOTclClass *cl; Tcl_Command cmd = NULL; @@ -10138,33 +10056,33 @@ } if (allocation == 'o') { - if (object->nsPtr) + if (object->nsPtr) cmd = FindMethod(methodName, object->nsPtr); if (!cmd) { return XOTclVarErrMsg(interp, "Cannot lookup object method '", methodName, "' for object ", objectName(object), (char *) NULL); } } else { - if (cl->nsPtr) + if (cl->nsPtr) cmd = FindMethod(methodName, cl->nsPtr); - if (!cmd) + if (!cmd) return XOTclVarErrMsg(interp, "Cannot lookup method '", methodName, "' from class ", objectName(object), (char *) NULL); } - + if (methodproperty == methodpropertyProtectedIdx || methodproperty == methodpropertyPublicIdx) { protected = (methodproperty == methodpropertyProtectedIdx); - + if (protected) { - Tcl_Command_flags(cmd) |= XOTCL_PROTECTED_METHOD; + Tcl_Command_flags(cmd) |= XOTCL_PROTECTED_METHOD; } else { Tcl_Command_flags(cmd) &= XOTCL_PROTECTED_METHOD; } } else { /* slotobj */ - Tcl_HashTable **nonposArgsTable = allocation == 'o' ? - &(object->nonposArgsTable) : + Tcl_HashTable **nonposArgsTable = allocation == 'o' ? + &(object->nonposArgsTable) : &(cl->nonposArgsTable); XOTclNonposArgs *nonposArgs; @@ -10188,19 +10106,15 @@ MEM_COUNT_ALLOC("nonposArg", nonposArgs); nonposArgs = (XOTclNonposArgs*)ckalloc(sizeof(XOTclNonposArgs)); nonposArgs->slotObj = NULL; - nonposArgs->nonposArgs = NULL; - nonposArgs->ordinaryArgs = NULL; + nonposArgs->ifd = NULL; Tcl_SetHashValue(hPtr, (ClientData)nonposArgs); /* TODO check: - problem with nonposArgs->nonposArgs = NULL ? - problem with nonposArgs->ordinaryArgs = NULL ? - what happens if first method property and then method. what happens if method then property then new method? */ } else { - + fprintf(stderr,"define slotobj for a method with nonpospargs\n slotobj = %s \n", ObjStr(value)); if (nonposArgs->slotObj) { DECR_REF_COUNT(nonposArgs->slotObj); @@ -10226,9 +10140,9 @@ char *methodName = ObjStr(method); Tcl_Command cmd = FindMethod(methodName, cl->nsPtr); if (cmd == 0) - return XOTclVarErrMsg(interp, objectName(self), + return XOTclVarErrMsg(interp, objectName(self), ": unable to dispatch local method '", - methodName, "' in class ", className(cl), + methodName, "' in class ", className(cl), (char *) NULL); result = DoCallProcCheck((ClientData)self, interp, nobjc+2, nobjv, cmd, self, cl, methodName, 0); @@ -10251,7 +10165,7 @@ case relationtypeObject_mixinIdx: case relationtypeMixinIdx: case relationtypeObject_filterIdx: - case relationtypeFilterIdx: + case relationtypeFilterIdx: if (value == NULL) { objopt = object->opt; switch (relationtype) { @@ -10269,29 +10183,29 @@ case relationtypeClass_mixinIdx: case relationtypeInstmixinIdx: case relationtypeClass_filterIdx: - case relationtypeInstfilterIdx: + case relationtypeInstfilterIdx: if (XOTclObjectIsClass(object)) { cl = (XOTclClass *)object; } else { return XOTclObjErrType(interp, object->cmdName, "Class"); } - + if (value == NULL) { clopt = cl->opt; switch (relationtype) { case relationtypeClass_mixinIdx: case relationtypeInstmixinIdx: return clopt ? MixinInfo(interp, clopt->instmixins, NULL, 1, NULL) : TCL_OK; - case relationtypeClass_filterIdx: + case relationtypeClass_filterIdx: case relationtypeInstfilterIdx: return objopt ? FilterInfo(interp, clopt->instfilters, NULL, 1, 0) : TCL_OK; } - } - + } + if (Tcl_ListObjGetElements(interp, value, &oc, &ov) != TCL_OK) return TCL_ERROR; clopt = XOTclRequireClassOpt(cl); break; - case relationtypeSuperclassIdx: + case relationtypeSuperclassIdx: if (!XOTclObjectIsClass(object)) return XOTclObjErrType(interp, object->cmdName, "Class"); cl = (XOTclClass *)object; @@ -10301,21 +10215,21 @@ if (Tcl_ListObjGetElements(interp, value, &oc, &ov) != TCL_OK) return TCL_ERROR; return SuperclassAdd(interp, cl, oc, ov, value, cl->object.cl); - - case relationtypeClassIdx: + + case relationtypeClassIdx: if (value == NULL) { Tcl_SetObjResult(interp, object->cl->object.cmdName); return TCL_OK; } GetXOTclClassFromObj(interp, value, &cl, object->cl); if (!cl) return XOTclErrBadVal(interp, "class", "a class", objectName(object)); return changeClass(interp, object, cl); - - case relationtypeRootclassIdx: + + case relationtypeRootclassIdx: { XOTclClass *metaClass; - if (!XOTclObjectIsClass(object)) + if (!XOTclObjectIsClass(object)) return XOTclObjErrType(interp, object->cmdName, "Class"); cl = (XOTclClass *)object; @@ -10331,16 +10245,16 @@ XOTclClassListAdd(&RUNTIME_STATE(interp)->rootClasses, cl, (ClientData)metaClass); return TCL_OK; - /* todo: - need to remove these properties? + /* todo: + need to remove these properties? allow to delete a classystem at runtime? */ } } switch (relationtype) { - case relationtypeObject_mixinIdx: - case relationtypeMixinIdx: + case relationtypeObject_mixinIdx: + case relationtypeMixinIdx: if (objopt->mixins) { XOTclCmdList *cmdlist, *del; for (cmdlist = objopt->mixins; cmdlist; cmdlist = cmdlist->nextPtr) { @@ -10358,7 +10272,7 @@ } CmdListRemoveList(&objopt->mixins, GuardDel); } - + object->flags &= ~XOTCL_MIXIN_ORDER_VALID; /* * since mixin procs may be used as filters -> we have to invalidate @@ -10385,16 +10299,16 @@ } /* else fprintf(stderr,"Problem registering %s as a mixinof of %s\n", ObjStr(ov[i]), className(cl)); */ } - + MixinComputeDefined(interp, object); FilterComputeDefined(interp, object); break; - case relationtypeObject_filterIdx: - case relationtypeFilterIdx: + case relationtypeObject_filterIdx: + case relationtypeFilterIdx: if (objopt->filters) CmdListRemoveList(&objopt->filters, GuardDel); - + object->flags &= ~XOTCL_FILTER_ORDER_VALID; for (i = 0; i < oc; i ++) { if (FilterAdd(interp, &objopt->filters, ov[i], object, 0) != TCL_OK) @@ -10403,7 +10317,7 @@ /*FilterComputeDefined(interp, obj);*/ break; - case relationtypeClass_mixinIdx: + case relationtypeClass_mixinIdx: case relationtypeInstmixinIdx: if (clopt->instmixins) { @@ -10416,15 +10330,15 @@ * we have to invalidate the filters as well */ FilterInvalidateObjOrders(interp, cl); - + for (i = 0; i < oc; i++) { Tcl_Obj *ocl = NULL; if (MixinAdd(interp, &clopt->instmixins, ov[i], cl->object.cl) != TCL_OK) { return TCL_ERROR; } - /* fprintf(stderr,"Added to instmixins of %s: %s\n", + /* fprintf(stderr,"Added to instmixins of %s: %s\n", className(cl), ObjStr(ov[i])); */ - + Tcl_ListObjIndex(interp, ov[i], 0, &ocl); XOTclObjConvertObject(interp, ocl, &nobj); if (nobj) { @@ -10437,11 +10351,11 @@ } break; - case relationtypeClass_filterIdx: + case relationtypeClass_filterIdx: case relationtypeInstfilterIdx: if (clopt->instfilters) CmdListRemoveList(&clopt->instfilters, GuardDel); - + FilterInvalidateObjOrders(interp, cl); for (i = 0; i < oc; i ++) { if (FilterAdd(interp, &clopt->instfilters, ov[i], 0, cl) != TCL_OK) @@ -10458,13 +10372,13 @@ } /*************************** - * End generated XOTcl commands + * End generated XOTcl commands ***************************/ /*************************** * Begin Object Methods ***************************/ -static int XOTclOAutonameMethod(Tcl_Interp *interp, XOTclObject *obj, int withInstance, int withReset, +static int XOTclOAutonameMethod(Tcl_Interp *interp, XOTclObject *obj, int withInstance, int withReset, Tcl_Obj *name) { Tcl_Obj *autoname = AutonameIncr(interp, name, obj, withInstance, withReset); if (autoname) { @@ -10517,7 +10431,7 @@ if (opt->checkoptions == CHECK_NONE && ocArgs>0) { return XOTclVarErrMsg(interp, "Unknown check option in command '", objectName(obj), " check ", ObjStr(flag), - "', valid: all pre post invar instinvar", + "', valid: all pre post invar instinvar", (char *) NULL); } @@ -10530,35 +10444,35 @@ char *fn; int softrecreate; Tcl_Obj *savedNameObj; - + #if defined(OBJDELETION_TRACE) fprintf(stderr,"+++ XOTclOCleanupMethod\n"); #endif PRINTOBJ("XOTclOCleanupMethod", obj); - + fn = objectName(obj); savedNameObj = obj->cmdName; INCR_REF_COUNT(savedNameObj); - + /* save and pass around softrecreate*/ softrecreate = obj->flags & XOTCL_RECREATE && RUNTIME_STATE(interp)->doSoftrecreate; - + CleanupDestroyObject(interp, obj, softrecreate); CleanupInitObject(interp, obj, obj->cl, obj->nsPtr, softrecreate); if (cl) { CleanupDestroyClass(interp, cl, softrecreate, 1); CleanupInitClass(interp, cl, cl->nsPtr, softrecreate, 1); } - + DECR_REF_COUNT(savedNameObj); return TCL_OK; } static int XOTclOConfigureMethod(Tcl_Interp *interp, XOTclObject *obj, int objc, Tcl_Obj *CONST objv[]) { XOTclObjects *slotObjects, *so; int result; - /* would be nice to do it here instead of setValue + /* would be nice to do it here instead of setValue XOTcl_FrameDecls; XOTcl_PushFrame(interp, obj); make instvars of obj accessible */ @@ -10569,7 +10483,7 @@ slotObjects = computeSlotObjects(interp, obj, NULL); for (so = slotObjects; so; so = so->nextPtr) { result = setDefaultValue(interp, obj, so->obj); - if (result != TCL_OK) { + if (result != TCL_OK) { goto configure_exit; } } @@ -10579,7 +10493,7 @@ */ /*{ int i; fprintf(stderr, "call setvalues %d: ",objc+1); - for (i=0; inextPtr) { result = checkRequiredValue(interp, obj, so->obj); - if (result != TCL_OK) { + if (result != TCL_OK) { goto configure_exit; } } configure_exit: /*XOTcl_PopFrame(interp, obj);*/ - if (slotObjects) + if (slotObjects) XOTclObjectListFree(slotObjects); return result; } @@ -10669,7 +10583,7 @@ fcl = NULL; } - Tcl_SetObjResult(interp, getFullProcQualifier(interp, filter, fobj, fcl, + Tcl_SetObjResult(interp, getFullProcQualifier(interp, filter, fobj, fcl, cmdList->cmdPtr)); return TCL_OK; } @@ -10685,7 +10599,7 @@ if (!Tcl_Interp_varFramePtr(interp)) { CallStackRestoreSavedFrames(interp, &ctx); return XOTclVarErrMsg(interp, "instvar used on ", objectName(obj), - ", but callstack is not in procedure scope", + ", but callstack is not in procedure scope", (char *) NULL); } @@ -10729,7 +10643,7 @@ static int XOTclOIsClassMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *class) { XOTclObject *o; - Tcl_SetIntObj(Tcl_GetObjResult(interp), + Tcl_SetIntObj(Tcl_GetObjResult(interp), (XOTclObjConvertObject(interp, class ? class : obj->cmdName, &o) == TCL_OK && XOTclObjectIsClass(o) )); return TCL_OK; @@ -10761,7 +10675,7 @@ static int XOTclOIsObjectMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *object) { XOTclObject *o; - Tcl_SetIntObj(Tcl_GetObjResult(interp), (XOTclObjConvertObject(interp, object, &o) == TCL_OK)); + Tcl_SetIntObj(Tcl_GetObjResult(interp), (XOTclObjConvertObject(interp, object, &o) == TCL_OK)); return TCL_OK; } @@ -10828,14 +10742,14 @@ return TCL_OK; } -static int XOTclOProcMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *name, - Tcl_Obj *args, Tcl_Obj *body, +static int XOTclOProcMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *name, + Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition) { char *argStr = ObjStr(args), *bdyStr = ObjStr(body), *nameStr = ObjStr(name); int result; if (precondition && !postcondition) { - return XOTclVarErrMsg(interp, objectName(obj), " method '", nameStr, + return XOTclVarErrMsg(interp, objectName(obj), " method '", nameStr, "'; when specifying a precondition (", ObjStr(precondition), ") a postcondition must be specified as well", (char *) NULL); @@ -10855,7 +10769,7 @@ } requireObjNamespace(interp, obj); result = MakeProc(obj->nsPtr, aStore, &(obj->nonposArgsTable), - interp, name, args, body, precondition, postcondition, + interp, name, args, body, precondition, postcondition, obj, 0); } @@ -10886,7 +10800,7 @@ if (!cmd && obj->nsPtr) { cmd = FindMethod(name, obj->nsPtr); } - + if (!cmd && obj->cl) pcl = SearchCMethod(obj->cl, name, &cmd); @@ -10948,7 +10862,7 @@ default: { return XOTclVarErrMsg(interp, objectName(obj), - " configure: unexpected argument '", + " configure: unexpected argument '", ObjStr(objv[i]), "' between parameters", (char *) NULL); } @@ -10957,17 +10871,17 @@ resultObj = Tcl_NewListObj(normalArgs, objv+1); /*fprintf(stderr,".... setvalues returns %s\n", ObjStr(resultObj));*/ Tcl_SetObjResult(interp, resultObj); - + return result; } -static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *method, - Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, +static int XOTclOForwardMethod(Tcl_Interp *interp, XOTclObject *obj, Tcl_Obj *method, + Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, + int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { forwardCmdClientData *tcd; - int rc = forwardProcessOptions(interp, method, - withDefault, withEarlybinding, withMethodprefix, + int rc = forwardProcessOptions(interp, method, + withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, nobjc, nobjv, &tcd); if (rc == TCL_OK) { @@ -11092,9 +11006,9 @@ if (Tcl_SetVar2(interp, vn, NULL, fullName, 0)) { XOTclObjectOpt *opt = XOTclRequireObjectOpt(obj); - + /*fprintf(stderr,"### setting trace for %s\n", fullName);*/ - result = Tcl_TraceVar(interp, vn, TCL_TRACE_UNSETS, + result = Tcl_TraceVar(interp, vn, TCL_TRACE_UNSETS, (Tcl_VarTraceProc*)XOTclUnsetTrace, (ClientData)o); opt->volatileVarName = vn; @@ -11175,7 +11089,7 @@ } /* - * If the path is not absolute, we add the appropriate namespace + * If the path is not absolute, we add the appropriate namespace */ if (!isAbsolutePath(name)) { tmpName = NameInNamespaceObj(interp, name, callingNameSpace(interp)); @@ -11192,7 +11106,7 @@ XOTclClass *newcl = PrimitiveCCreate(interp, name, cl); if (newcl == 0) { result = XOTclVarErrMsg(interp, "Class alloc failed for '", name, - "' (possibly parent namespace does not exist)", + "' (possibly parent namespace does not exist)", (char *) NULL); } else { Tcl_SetObjResult(interp, newcl->object.cmdName); @@ -11205,7 +11119,7 @@ XOTclObject *newobj = PrimitiveOCreate(interp, name, cl); if (newobj == 0) result = XOTclVarErrMsg(interp, "Object alloc failed for '", name, - "' (possibly parent namespace does not exist)", + "' (possibly parent namespace does not exist)", (char *) NULL); else { result = TCL_OK; @@ -11220,25 +11134,25 @@ return result; } -static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, +static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]) { if (RUNTIME_STATE(interp)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) { fprintf(stderr,"### Can't create object %s during shutdown\n", ObjStr(objv[1])); return TCL_OK; /* don't fail, if this happens during destroy, it might be canceled */ } - + return createMethod(interp, cl, name, objc, objv); } static int XOTclCDeallocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *object) { XOTclObject *delobj; int rc; - + if (XOTclObjConvertObject(interp, object, &delobj) != TCL_OK) return XOTclVarErrMsg(interp, "Can't destroy object ", - ObjStr(object), " that does not exist.", + ObjStr(object), " that does not exist.", (char *) NULL); - + /* fprintf(stderr,"dealloc obj=%s, opt=%p\n", objectName(delobj), delobj->opt);*/ rc = freeUnsetTraceVariable(interp, delobj); if (rc != TCL_OK) { @@ -11259,7 +11173,7 @@ return TCL_OK; } -static int XOTclCNewMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *withChildof, +static int XOTclCNewMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *withChildof, int objc, Tcl_Obj *CONST objv[]) { Tcl_Obj *fullname; int result, prefixLength; @@ -11342,7 +11256,7 @@ static int XOTclCInstMixinGuardMethod(Tcl_Interp *interp, XOTclClass *cl, char *mixin, Tcl_Obj *guard) { XOTclClassOpt *opt = cl->opt; XOTclCmdList *h; - + if (opt && opt->instmixins) { XOTclClass *mixinCl = XOTclpGetClass(interp, mixin); Tcl_Command mixinCmd = NULL; @@ -11370,28 +11284,28 @@ return TCL_OK; } -static int XOTclCInstProcMethod(Tcl_Interp *interp, XOTclClass *cl, - Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, +static int XOTclCInstProcMethod(Tcl_Interp *interp, XOTclClass *cl, + Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition) { return makeMethod(interp, cl, name, args, body, precondition, postcondition, 0); } -static int XOTclCInstProcMethodC(Tcl_Interp *interp, XOTclClass *cl, - Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, +static int XOTclCInstProcMethodC(Tcl_Interp *interp, XOTclClass *cl, + Tcl_Obj *name, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition) { return makeMethod(interp, cl, name, args, body, precondition, postcondition, 1); } -static int XOTclCInstForwardMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *method, - Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, - int withObjscope, Tcl_Obj *withOnerror, int withVerbose, +static int XOTclCInstForwardMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *method, + Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, + int withObjscope, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]) { forwardCmdClientData *tcd; int rc; - rc = forwardProcessOptions(interp, method, - withDefault, withEarlybinding, withMethodprefix, + rc = forwardProcessOptions(interp, method, + withDefault, withEarlybinding, withMethodprefix, withObjscope, withOnerror, withVerbose, target, nobjc, nobjv, &tcd); @@ -11404,7 +11318,7 @@ return rc; } -static int XOTclCRecreateMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, +static int XOTclCRecreateMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name, int objc, Tcl_Obj *CONST objv[]) { XOTclObject *newobj; int result; @@ -11426,12 +11340,12 @@ return result; } -static int XOTclCUnknownMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, +static int XOTclCUnknownMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]) { if (isCreateString(name)) return XOTclVarErrMsg(interp, "error ", className(cl), ": unable to dispatch '", name, "'", (char *)NULL); - + return callMethod((ClientData)cl, interp, XOTclGlobalObjects[XOTE_CREATE], objc+1, objv+1, 0); } @@ -11453,7 +11367,7 @@ /* the variable is not yet defined (set), so we cannot check whether it is boolean or not */ return TCL_OK; - } + } boolean = Tcl_DuplicateObj(value); INCR_REF_COUNT(boolean); @@ -11467,8 +11381,7 @@ static int XOTclCheckRequiredArgs(Tcl_Interp *interp, char *name, Tcl_Obj *value) { if (value == NULL) { - return XOTclVarErrMsg(interp, - "required arg: '", name, "' missing", + return XOTclVarErrMsg(interp, "required arg: '", name, "' missing", (char *) NULL); } Tcl_ResetResult(interp); @@ -11487,7 +11400,7 @@ static int XOTclObjInfoArgsMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { if (object->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(object->nonposArgsTable, methodName); - if (nonposArgs && nonposArgs->ordinaryArgs) { + if (nonposArgs) { return ListArgsFromOrdinaryArgs(interp, nonposArgs); } } @@ -11499,7 +11412,7 @@ } static int XOTclObjInfoCheckMethod(Tcl_Interp *interp, XOTclObject *object) { - return AssertionListCheckOption(interp, object); + return AssertionListCheckOption(interp, object); } static int XOTclObjInfoChildrenMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { @@ -11518,19 +11431,19 @@ static int XOTclObjInfoDefaultMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName, char *arg, Tcl_Obj *var) { if (object->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(object->nonposArgsTable, methodName); - if (nonposArgs && nonposArgs->ordinaryArgs) { + if (nonposArgs) { return ListDefaultFromOrdinaryArgs(interp, methodName, nonposArgs, arg, var); } } - return object->nsPtr ? - ListProcDefault(interp, Tcl_Namespace_cmdTable(object->nsPtr), methodName, arg, var) : + return object->nsPtr ? + ListProcDefault(interp, Tcl_Namespace_cmdTable(object->nsPtr), methodName, arg, var) : TCL_OK; } -static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, int withOrder, int withGuards, +static int XOTclObjInfoFilterMethod(Tcl_Interp *interp, XOTclObject *object, int withOrder, int withGuards, char *pattern) { XOTclObjectOpt *opt = object->opt; - if (withOrder) { + if (withOrder) { if (!(object->flags & XOTCL_FILTER_ORDER_VALID)) FilterComputeDefined(interp, object); return FilterInfo(interp, object->filterOrder, pattern, withGuards, 1); @@ -11543,13 +11456,13 @@ } static int XOTclObjInfoForwardMethod(Tcl_Interp *interp, XOTclObject *object, int withDefinition, char *pattern) { - return object->nsPtr ? - ListForward(interp, Tcl_Namespace_cmdTable(object->nsPtr), pattern, withDefinition) : + return object->nsPtr ? + ListForward(interp, Tcl_Namespace_cmdTable(object->nsPtr), pattern, withDefinition) : TCL_OK; } static int XOTclObjInfoHasnamespaceMethod(Tcl_Interp *interp, XOTclObject *object) { - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), object->nsPtr != NULL); + Tcl_SetBooleanObj(Tcl_GetObjResult(interp), object->nsPtr != NULL); return TCL_OK; } @@ -11560,17 +11473,17 @@ return TCL_OK; } -static int XOTclObjInfoMethodsMethod(Tcl_Interp *interp, XOTclObject *object, int withNoprocs, +static int XOTclObjInfoMethodsMethod(Tcl_Interp *interp, XOTclObject *object, int withNoprocs, int withNocmds, int withNomixins, int withIncontext, char *pattern) { return ListMethods(interp, object, pattern, withNoprocs, withNocmds, withNomixins, withIncontext); } -static int XOTclObjInfoMixinMethod(Tcl_Interp *interp, XOTclObject *object, int withGuards, int withOrder, +static int XOTclObjInfoMixinMethod(Tcl_Interp *interp, XOTclObject *object, int withGuards, int withOrder, char *patternString, XOTclObject *patternObj) { if (withOrder) { if (!(object->flags & XOTCL_MIXIN_ORDER_VALID)) MixinComputeDefined(interp, object); - return MixinInfo(interp, object->mixinOrder, patternString, + return MixinInfo(interp, object->mixinOrder, patternString, withGuards, patternObj); } return object->opt ? MixinInfo(interp, object->opt->mixins, patternString, withGuards, patternObj) : TCL_OK; @@ -11583,8 +11496,8 @@ static int XOTclObjInfoNonposargsMethod(Tcl_Interp *interp, XOTclObject *object, char *methodName) { if (object->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(object->nonposArgsTable, methodName); - if (nonposArgs && nonposArgs->nonposArgs) { - Tcl_SetObjResult(interp, NonposArgsFormat(interp, nonposArgs->nonposArgs)); + if (nonposArgs) { + Tcl_SetObjResult(interp, NonposArgsFormat(interp, nonposArgs)); } } return TCL_OK; @@ -11593,7 +11506,7 @@ static int XOTclObjInfoParametercmdMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { if (object->nsPtr) { return ListMethodKeys(interp, Tcl_Namespace_cmdTable(object->nsPtr), pattern, 1, 0, 0, 0, 1); - } + } return TCL_OK; } @@ -11620,7 +11533,7 @@ return TCL_OK; } -static int XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, +static int XOTclObjInfoPrecedenceMethod(Tcl_Interp *interp, XOTclObject *object, int withIntrinsicOnly, char *pattern) { XOTclClasses *precedenceList = NULL, *pl; @@ -11634,7 +11547,7 @@ } static int XOTclObjInfoProcsMethod(Tcl_Interp *interp, XOTclObject *object, char *pattern) { - return object->nsPtr ? ListMethodKeys(interp, Tcl_Namespace_cmdTable(object->nsPtr), + return object->nsPtr ? ListMethodKeys(interp, Tcl_Namespace_cmdTable(object->nsPtr), pattern, /*noProcs*/ 0, /*noCmds*/ 1, NULL, 0, 0) : TCL_OK; } @@ -11646,7 +11559,7 @@ for (; pl; pl = pl->nextPtr) { Tcl_ListObjAppendElement(interp, list, pl->obj->cmdName); } - + XOTclObjectListFree(pl); Tcl_SetObjResult(interp, list); return TCL_OK; @@ -11656,7 +11569,7 @@ Tcl_Obj *varlist, *okList, *element; int i, length; TclVarHashTable *varTable = object->nsPtr ? Tcl_Namespace_varTable(object->nsPtr) : object->varTable; - + #if defined(PRE85) # if FORWARD_COMPATIBLE if (forwardCompatibleMode) { @@ -11707,21 +11620,21 @@ * get all instances of a class recursively into an initialized * String key hashtable */ -static int XOTclClassInfoInstancesMethod1(Tcl_Interp *interp, XOTclClass *startCl, +static int XOTclClassInfoInstancesMethod1(Tcl_Interp *interp, XOTclClass *startCl, int withClosure, char *pattern, XOTclObject *matchObject) { Tcl_HashTable *table = &startCl->instances; XOTclClasses *sc; Tcl_HashSearch search; Tcl_HashEntry *hPtr; int rc = 0; - /*fprintf(stderr,"XOTclClassInfoInstancesMethod: clo %d pattern %s match %p\n", + /*fprintf(stderr,"XOTclClassInfoInstancesMethod: clo %d pattern %s match %p\n", withClosure, pattern, matchObject);*/ for (hPtr = Tcl_FirstHashEntry(table, &search); hPtr; hPtr = Tcl_NextHashEntry(&search)) { XOTclObject *inst = (XOTclObject*) Tcl_GetHashKey(table, hPtr); - /*fprintf(stderr, "match '%s' %p %p '%s'\n", + /*fprintf(stderr, "match '%s' %p %p '%s'\n", matchObject ? objectName(matchObject) : "NULL" ,matchObject, inst, objectName(inst));*/ if (matchObject && inst == matchObject) { Tcl_SetObjResult(interp, matchObject->cmdName); @@ -11738,18 +11651,18 @@ return rc; } -static int XOTclClassInfoInstancesMethod(Tcl_Interp *interp, XOTclClass *startCl, +static int XOTclClassInfoInstancesMethod(Tcl_Interp *interp, XOTclClass *startCl, int withClosure, char *pattern, XOTclObject *matchObject) { XOTclClassInfoInstancesMethod1(interp, startCl, withClosure, pattern, matchObject); return TCL_OK; } static int XOTclClassInfoInstargsMethod(Tcl_Interp *interp, XOTclClass *class, char *methodName) { Tcl_Namespace *nsp = class->nsPtr; - + if (class->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(class->nonposArgsTable, methodName); - if (nonposArgs && nonposArgs->ordinaryArgs) { + if (nonposArgs) { return ListArgsFromOrdinaryArgs(interp, nonposArgs); } } @@ -11764,18 +11677,18 @@ return ListKeys(interp, Tcl_Namespace_cmdTable(class->nsPtr), pattern); } -static int XOTclClassInfoInstdefaultMethod(Tcl_Interp *interp, XOTclClass *class, +static int XOTclClassInfoInstdefaultMethod(Tcl_Interp *interp, XOTclClass *class, char *methodName, char *arg, Tcl_Obj *var) { Tcl_Namespace *nsp = class->nsPtr; if (class->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(class->nonposArgsTable, methodName); - if (nonposArgs && nonposArgs->ordinaryArgs) { + if (nonposArgs) { return ListDefaultFromOrdinaryArgs(interp, methodName, nonposArgs, arg, var); } } - return nsp ? - ListProcDefault(interp, Tcl_Namespace_cmdTable(nsp), methodName, arg, var) : + return nsp ? + ListProcDefault(interp, Tcl_Namespace_cmdTable(nsp), methodName, arg, var) : TCL_OK; } @@ -11787,7 +11700,7 @@ return class->opt ? GuardList(interp, class->opt->instfilters, filter) : TCL_OK; } -static int XOTclClassInfoInstforwardMethod(Tcl_Interp *interp, XOTclClass *class, +static int XOTclClassInfoInstforwardMethod(Tcl_Interp *interp, XOTclClass *class, int withDefinition, char *pattern) { return ListForward(interp, Tcl_Namespace_cmdTable(class->nsPtr), pattern, withDefinition); } @@ -11829,7 +11742,7 @@ return class->opt ? GuardList(interp, class->opt->instmixins, mixin) : TCL_OK; } -static int XOTclClassInfoInstmixinofMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, +static int XOTclClassInfoInstmixinofMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, char *patternString, XOTclObject *patternObj) { XOTclClassOpt *opt = class->opt; int rc; @@ -11842,7 +11755,7 @@ rc = getAllClassMixinsOf(interp, commandTable, class, 0, 1, patternString, patternObj); MEM_COUNT_FREE("Tcl_InitHashTable", commandTable); } else { - rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, + rc = AppendMatchingElementsFromCmdList(interp, opt->isClassMixinOf, patternString, patternObj); } if (patternObj) { @@ -11856,7 +11769,7 @@ if (class->nonposArgsTable) { XOTclNonposArgs *nonposArgs = NonposArgsGet(class->nonposArgsTable, methodName); if (nonposArgs) { - Tcl_SetObjResult(interp, NonposArgsFormat(interp, nonposArgs->nonposArgs)); + Tcl_SetObjResult(interp, NonposArgsFormat(interp, nonposArgs)); } } return TCL_OK; @@ -11883,17 +11796,17 @@ } static int XOTclClassInfoInstprocsMethod(Tcl_Interp *interp, XOTclClass * class, char * pattern) { - return ListMethodKeys(interp, Tcl_Namespace_cmdTable(class->nsPtr), + return ListMethodKeys(interp, Tcl_Namespace_cmdTable(class->nsPtr), pattern, /*noProcs*/ 0, /*noCmds*/ 1, NULL, 0, 0 ); } -static int XOTclClassInfoMixinofMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, +static int XOTclClassInfoMixinofMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, char *patternString, XOTclObject *patternObj) { XOTclClassOpt *opt = class->opt; int rc; if (opt && !withClosure) { - rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, patternString, patternObj); + rc = AppendMatchingElementsFromCmdList(interp, opt->isObjectMixinOf, patternString, patternObj); } else if (withClosure) { Tcl_HashTable objTable, *commandTable = &objTable; MEM_COUNT_ALLOC("Tcl_InitHashTable", commandTable); @@ -11919,7 +11832,7 @@ obj = XOTclpGetObject(interp, Tcl_DStringValue(dsPtr)); if (obj) { Tcl_Obj *varNameObj = Tcl_NewStringObj("__parameter",-1); - Tcl_Obj *parameters = XOTcl_ObjGetVar2((XOTcl_Object*)obj, + Tcl_Obj *parameters = XOTcl_ObjGetVar2((XOTcl_Object*)obj, interp, varNameObj, NULL, TCL_LEAVE_ERR_MSG); if (parameters) { @@ -11949,7 +11862,7 @@ return rc; } -static int XOTclClassInfoSubclassMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, +static int XOTclClassInfoSubclassMethod(Tcl_Interp *interp, XOTclClass * class, int withClosure, char *patternString, XOTclObject *patternObj) { int rc; if (withClosure) { @@ -11992,15 +11905,15 @@ Tcl_HashSearch hSrch; Tcl_HashEntry *hPtr; XOTclObject *obj; - XOTclClass *cl; + XOTclClass *cl; if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " "); ns = ObjFindNamespace(interp, objv[1]); if (!ns) return TCL_OK; - + name = ObjStr(objv[1]); /* check, if we work on an object or class namespace */ if (isClassName(name)) { @@ -12058,7 +11971,7 @@ } else { /* don't overwrite objects -> will be recreated */ hPtr = Tcl_NextHashEntry(&hSrch); - DECR_REF_COUNT(newFullCmdName); + DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName); continue; } @@ -12073,7 +11986,7 @@ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't copy ", " \"", oldName, "\": command doesn't exist", (char *) NULL); - DECR_REF_COUNT(newFullCmdName); + DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName); return TCL_ERROR; } @@ -12094,27 +12007,27 @@ if (nonposArgsTable) { nonposArgs = NonposArgsGet(nonposArgsTable, name); if (nonposArgs) { - arglistObj = NonposArgsFormat(interp, nonposArgs->nonposArgs); + arglistObj = NonposArgsFormat(interp, nonposArgs); INCR_REF_COUNT(arglistObj); AppendOrdinaryArgsFromNonposArgs(interp, nonposArgs, 0, arglistObj); } - } + } if (!arglistObj) { arglistObj = Tcl_NewListObj(0, NULL); INCR_REF_COUNT(arglistObj); for (localPtr = procPtr->firstLocalPtr; localPtr; localPtr = localPtr->nextPtr) { - + if (TclIsCompiledLocalArgument(localPtr)) { Tcl_Obj *defVal, *defStringObj = Tcl_NewStringObj(localPtr->name, -1); INCR_REF_COUNT(defStringObj); /* check for default values */ if ((GetProcDefault(interp, cmdTable, name, localPtr->name, &defVal) == TCL_OK) && defVal) { - Tcl_AppendStringsToObj(defStringObj, " ", ObjStr(defVal), + Tcl_AppendStringsToObj(defStringObj, " ", ObjStr(defVal), (char *) NULL); } Tcl_ListObjAppendElement(interp, arglistObj, defStringObj); @@ -12231,10 +12144,10 @@ Tcl_Obj *destFullNameObj; TclCallFrame frame, *framePtr = &frame; Tcl_Obj *varNameObj = NULL; - + if (objc != 3) return XOTclObjErrArgCnt(interp, objv[0], NULL, " "); - + ns = ObjFindNamespace(interp, objv[1]); /*fprintf(stderr,"copyvars from %s to %s, ns=%p\n", ObjStr(objv[1]), ObjStr(objv[2]), ns);*/ @@ -12287,7 +12200,7 @@ /* can't rely on "set", if there are multiple object systems */ setInstVar(interp, destObj, varNameObj, valueOfVar(Tcl_Obj, varPtr, objPtr)); } else { - Tcl_ObjSetVar2(interp, varNameObj, NULL, + Tcl_ObjSetVar2(interp, varNameObj, NULL, valueOfVar(Tcl_Obj, varPtr, objPtr), TCL_NAMESPACE_ONLY); } @@ -12306,10 +12219,10 @@ if (TclIsVarScalar(eltVar)) { if (obj) { - XOTcl_ObjSetVar2((XOTcl_Object*)destObj, interp, varNameObj, eltNameObj, + XOTcl_ObjSetVar2((XOTcl_Object*)destObj, interp, varNameObj, eltNameObj, valueOfVar(Tcl_Obj, eltVar, objPtr), 0); } else { - Tcl_ObjSetVar2(interp, varNameObj, eltNameObj, + Tcl_ObjSetVar2(interp, varNameObj, eltNameObj, valueOfVar(Tcl_Obj, eltVar, objPtr), TCL_NAMESPACE_ONLY); } @@ -12349,7 +12262,7 @@ if (RUNTIME_STATE(interp)->cs.top->currentFramePtr == NULL) { RUNTIME_STATE(interp)->cs.top->currentFramePtr = varFramePtr; } /* else { - + fprintf(stderr,"not overwriting currentFramePtr in %p from %p to %p\n", RUNTIME_STATE(interp)->cs.top, RUNTIME_STATE(interp)->cs.top->currentFramePtr, varFramePtr); @@ -12364,6 +12277,7 @@ } #endif +#if 0 /* * Interpretation of Non-Positional Args */ @@ -12374,6 +12288,7 @@ int i, npac; Tcl_Obj **npav; char *varName; + if (argStr[0] == '-') { for (i=0; i < nonposArgsDefc; i++) { if (Tcl_ListObjGetElements(interp, nonposArgsDefv[i], @@ -12389,318 +12304,81 @@ } return 0; } +#endif -#if 1 int XOTclInterpretNonpositionalArgsCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { XOTclObject *object = GetSelfObj(interp); - XOTclClass *class = XOTclObjectIsClass(object) ? (XOTclClass *)object : NULL; + XOTclClass *class = GetSelfClass(interp); Tcl_HashTable *nonposArgsTable = class ? class->nonposArgsTable : object->nonposArgsTable; - char *methodName = (char *)GetSelfProc(interp); - XOTclNonposArgs *nonposArgs = NonposArgsGet(nonposArgsTable, methodName); + char *procName = (char *)GetSelfProc(interp); + XOTclNonposArgs *nonposArgs = NonposArgsGet(nonposArgsTable, procName); + Tcl_Obj *proc = Tcl_NewStringObj(procName, -1); + argDefinition CONST *aPtr; parseContext pc; - argDefinition CONST *aPtr, *bPtr; - Tcl_Obj *argsv; - int i, rc, argsc; + int i, rc; - /* the arguments are passed via the single argument "args"; strictly - speaking, this is not necessary and could be handled as well via - introspection (this is a possible TODO for optimization) + /* The arguments are passed via argument vector (not the single + argument) at least for Tcl 8.5. TODO: Tcl 8.4 support? possible + via introspection? (this is a possible TODO for optimization) */ - - /* rc = Tcl_ListObjGetElements(interp, objv[1], &argsc, &argsv); - fprintf(stderr, "oc=%d %s, argsc %d, rc=%d\n",objc,ObjStr(objv[1]),argsc,rc); - */ - /*fprintf(stderr, "oc=%d\n",objc);*/ - if (parseObjv(interp, objc, objv, 1, nonposArgs->ifd, &pc) != TCL_OK) { - return TCL_ERROR; - } + /*if (!nonposArgs) {return TCL_OK;}*/ + + INCR_REF_COUNT(proc); + rc = parseObjv(interp, objc, objv, proc, nonposArgs->ifd, &pc); + DECR_REF_COUNT(proc); + + if (rc != TCL_OK) + return rc; + for (aPtr = nonposArgs->ifd, i=0; aPtr->name; aPtr++, i++) { char *argName = aPtr->name; if (*argName == '-') argName++; - /*fprintf(stderr, "got for arg %s (%d) => %p, default %s\n",aPtr->name, aPtr->required, - pc.clientData[i], + /*fprintf(stderr, "got for arg %s (%d) => %p %p, default %s\n", + aPtr->name, aPtr->required, + pc.clientData[i], pc.objv[i], aPtr->defaultValue ? ObjStr(aPtr->defaultValue) : "NONE");*/ - - if (pc.clientData[i] == 0) { - /* no valued passed, try take default */ - if (aPtr->defaultValue) { - /* TODO not jet checked */ - Tcl_SetVar2Ex(interp, argName, NULL, aPtr->defaultValue, 0); - } else if (aPtr->required) { - fprintf(stderr, "required argument %s missing\n",argName); - return TCL_ERROR; - } - } else { + + if (pc.objv[i]) { /* got a value, already checked by objv parser */ /*fprintf(stderr, "setting passed value for %s to '%s'\n",argName,ObjStr(pc.objv[i]));*/ - Tcl_SetVar2Ex(interp, argName, NULL, pc.objv[i], 0); - } - - } - return TCL_OK; -} -#else - -int -XOTclInterpretNonpositionalArgsCmd(ClientData clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]) { - Tcl_Obj **npav, **checkv, **checkArgv, **argsv, **nonposArgsDefv, - *invocation[4], **ordinaryArgsDefv, **defaultValueObjv, *list, - *checkObj, *ordinaryArg; - int npac, checkc, checkArgc, argsc, nonposArgsDefc, - ordinaryArgsDefc, defaultValueObjc, argsDefined = 0, - ordinaryArgsCounter = 0, i, j, result, ic; - char *lastDefArg = NULL, *arg, *argStr; - int endOfNonposArgsReached = 0; - Var *varPtr; - - XOTclClass *currentClass = GetSelfClass(interp); - char *methodName = (char *) GetSelfProc(interp); - Tcl_HashTable *nonposArgsTable; - XOTclNonposArgs *nonposArgs; - XOTclObject *selfObj; - int r1, r2, r3, r4; - - if (objc != 2) { - return XOTclObjErrArgCnt(interp, objv[0], NULL, "?args?"); - } - - if (currentClass) { - nonposArgsTable = currentClass->nonposArgsTable; - } else if ((selfObj = GetSelfObj(interp))) { - nonposArgsTable = selfObj->nonposArgsTable; - } else { - return XOTclVarErrMsg(interp, "Non positional args: can't find self/self class", - (char *) NULL); - } - - nonposArgs = NonposArgsGet(nonposArgsTable, methodName); - if (nonposArgs == 0) { - return XOTclVarErrMsg(interp, - "Non positional args: can't find hash entry for: ", - methodName, - (char *) NULL); - } - - r1 = Tcl_ListObjGetElements(interp, nonposArgs->nonposArgs, - &nonposArgsDefc, &nonposArgsDefv); - r2 = Tcl_ListObjGetElements(interp, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); - r3 = Tcl_ListObjGetElements(interp, objv[1], &argsc, &argsv); - - - if (r1 != TCL_OK || r2 != TCL_OK || r3 != TCL_OK) { - return XOTclVarErrMsg(interp, - "Cannot split non positional args list: ", - methodName, - (char *) NULL); - } - - /*fprintf(stderr,"InterpretNonpositionalArgs: setting defaults\n");*/ - - /* setting variables to default values */ - for (i=0; i < nonposArgsDefc; i++) { - r1 = Tcl_ListObjGetElements(interp, nonposArgsDefv[i], &npac, &npav); - - if (r1 == TCL_OK) { - if (npac == 3) { - Tcl_SetVar2Ex(interp, ObjStr(npav[0]), NULL, npav[2], 0); - /* for unknown reasons, we can't use Tcl_ObjSetVar2 here in case the - variable is referenced via eval (sample murr6) */ - /* Tcl_ObjSetVar2(interp, npav[0], NULL, npav[2], 0); */ - } else if (npac == 2 && !strncmp(ObjStr(npav[1]), "{switch",7)) { - /* we could as well do yet another split to get the type from - the first element of the list*/ - /*fprintf(stderr,"setting default value for switch %s\n",ObjStr(npav[0]));*/ - Tcl_SetVar2Ex(interp, ObjStr(npav[0]), NULL, Tcl_NewBooleanObj(0), 0); - } - } - } - - if (ordinaryArgsDefc > 0) { - lastDefArg = ObjStr(ordinaryArgsDefv[ordinaryArgsDefc-1]); - if (isArgsString(lastDefArg)) { - argsDefined = 1; - } - } - - /* fprintf(stderr,"InterpretNonpositionalArgs: setting values\n");*/ - - /* setting specified variables */ - for (i=0; i < argsc; i++) { - - if (!endOfNonposArgsReached) { - char *type; - Tcl_Obj *var; - argStr = ObjStr(argsv[i]); - - if (isDoubleDashString(argStr)) { - endOfNonposArgsReached = 1; - i++; - } - if (isNonposArg(interp, argStr, nonposArgsDefc, nonposArgsDefv, &var,&type)) { - /* we could as well do yet another split to get the type from - the first element of the list*/ - if (*type == '{' && !strncmp(type, "{switch",7)) { - int bool; - Tcl_Obj *boolObj = Tcl_ObjGetVar2(interp, var, 0, 0); - if (Tcl_GetBooleanFromObj(interp, boolObj, &bool) != TCL_OK) { - return XOTclVarErrMsg(interp, "Non positional arg '", argStr, - "': no boolean value", (char *) NULL); - } - Tcl_SetVar2Ex(interp, ObjStr(var), NULL, Tcl_NewBooleanObj(!bool), 0); - /*Tcl_ObjSetVar2(interp, var, NULL, Tcl_NewBooleanObj(!bool), 0); */ - } else { - i++; - if (i >= argsc) - return XOTclVarErrMsg(interp, "Non positional arg '", - argStr, "': value missing", (char *) NULL); - Tcl_SetVar2Ex(interp, ObjStr(var), NULL, argsv[i], 0); - /* Tcl_ObjSetVar2(interp, var, NULL, argsv[i], 0);*/ - } + if (aPtr->converter == convertToSwitch) { + int bool; + Tcl_GetBooleanFromObj(interp, aPtr->defaultValue, &bool); + /*fprintf(stderr, "setting passed value for %s to '%d'\n",argName,!pc.clientData[i]);*/ + Tcl_SetVar2Ex(interp, argName, NULL, Tcl_NewBooleanObj(!bool), 0); } else { - endOfNonposArgsReached = 1; + /*fprintf(stderr, "setting passed value for %s to '%s'\n",argName,ObjStr(pc.objv[i]));*/ + Tcl_SetVar2Ex(interp, argName, NULL, pc.objv[i], 0); } - } - - if (endOfNonposArgsReached && i < argsc) { - if (ordinaryArgsCounter >= ordinaryArgsDefc) { - Tcl_Obj *tmp = NonposArgsFormat(interp, nonposArgs->nonposArgs); - XOTclVarErrMsg(interp, "unknown argument '", - ObjStr(argsv[i]), - "' for method '", - methodName, - "': valid arguments ", - ObjStr(tmp), - " ", - ObjStr(nonposArgs->ordinaryArgs), - (char *) NULL); - DECR_REF_COUNT(tmp); - return TCL_ERROR; + } else { + /* no valued passed, check if default is available */ + if (aPtr->defaultValue) { + /* TODO: default value is not jet checked; should be in arg parsing */ + /*fprintf(stderr,"=== setting default value '%s' for var '%s'\n",ObjStr(aPtr->defaultValue),argName);*/ + Tcl_SetVar2Ex(interp, argName, NULL, aPtr->defaultValue, 0); + } else if (aPtr->required) { + return XOTclVarErrMsg(interp, "method ",procName, ": required argument '", + argName, "' is missing", (char *) NULL); } - arg = ObjStr(ordinaryArgsDefv[ordinaryArgsCounter]); - /* this is the last arg and 'args' is defined */ - if (argsDefined && ordinaryArgsCounter+1 == ordinaryArgsDefc) { - list = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(list); - for(; i < argsc; i++) - Tcl_ListObjAppendElement(interp, list, argsv[i]); - Tcl_ObjSetVar2(interp, ordinaryArgsDefv[ordinaryArgsCounter], NULL, list, 0); - DECR_REF_COUNT(list); - } else { - /* break down this argument, if it has a default value, - use only the first part */ - ordinaryArg = ordinaryArgsDefv[ordinaryArgsCounter]; - r4 = Tcl_ListObjGetElements(interp, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); - if (r4 == TCL_OK && defaultValueObjc == 2) { - ordinaryArg = defaultValueObjv[0]; - } - Tcl_ObjSetVar2(interp, ordinaryArg, NULL, argsv[i], 0); - } - ordinaryArgsCounter++; } } - /*fprintf(stderr,"... args defined %d argsc=%d oa %d oad %d\n", - argsDefined, argsc, - ordinaryArgsCounter, ordinaryArgsDefc); */ - - if ((!argsDefined && ordinaryArgsCounter != ordinaryArgsDefc) || - (argsDefined && ordinaryArgsCounter < ordinaryArgsDefc-1)) { - - /* we do not have enough arguments, maybe there are default arguments - for the missing args */ - while (ordinaryArgsCounter != ordinaryArgsDefc) { - if (argsDefined && ordinaryArgsCounter+1 == ordinaryArgsDefc) - break; - r4 = Tcl_ListObjGetElements(interp, ordinaryArgsDefv[ordinaryArgsCounter], - &defaultValueObjc, &defaultValueObjv); - /*fprintf(stderr,"... try to get default for '%s', rc %d, objc %d\n", - ObjStr(ordinaryArgsDefv[ordinaryArgsCounter]), - r4, defaultValueObjc);*/ - if (r4 == TCL_OK && defaultValueObjc == 2) { - Tcl_ObjSetVar2(interp, defaultValueObjv[0], NULL, defaultValueObjv[1], 0); - } else { - Tcl_Obj *tmp = NonposArgsFormat(interp, nonposArgs->nonposArgs); - XOTclVarErrMsg(interp, "wrong # args for method '", - methodName, "': valid arguments ", ObjStr(tmp), " ", - ObjStr(nonposArgs->ordinaryArgs), - (char *) NULL); - DECR_REF_COUNT(tmp); - return TCL_ERROR; - } - ordinaryArgsCounter++; - } - if (argsDefined) { - Tcl_SetVar2(interp, "args", NULL, "", 0); - } - } else if (argsDefined && ordinaryArgsCounter == ordinaryArgsDefc-1) { - Tcl_SetVar2(interp, "args", NULL, "", 0); - } - - if (!argsDefined) { + aPtr--; + if (aPtr->converter == convertToNothing) { + /* "args" is always defined as non-required and with convertToNoting */ + int elts = objc - pc.lastobjc; + /*fprintf(stderr, "args last objc=%d, objc=%d, elts=%d\n", pc.lastobjc, objc, elts);*/ + Tcl_SetVar2Ex(interp, aPtr->name, NULL, Tcl_NewListObj(elts,objv+pc.lastobjc), 0); + } else { Tcl_UnsetVar2(interp, "args", NULL, 0); } - /* checking vars */ - for (i=0; i < nonposArgsDefc; i++) { - r1 = Tcl_ListObjGetElements(interp, nonposArgsDefv[i], &npac, &npav); - if (r1 == TCL_OK && npac > 1 && *(ObjStr(npav[1])) != '\0') { - r1 = Tcl_ListObjGetElements(interp, npav[1], &checkc, &checkv); - if (r1 == TCL_OK) { - int checkResult = 0; - checkObj = nonposArgs->slotObj == NULL ? - XOTclGlobalObjects[XOTE_NON_POS_ARGS_OBJ] : - nonposArgs->slotObj; - - for (j=0; j < checkc; j++) { - r1 = Tcl_ListObjGetElements(interp, checkv[j], &checkArgc, &checkArgv); - if (r1 == TCL_OK && checkArgc > 1) { - if (isCheckObjString((ObjStr(checkArgv[0]))) && checkArgc == 2) { - checkObj = checkArgv[1]; - continue; - } - } - invocation[0] = checkObj; - /*invocation[1] = checkv[j];*/ - invocation[1] = checkArgv[1]; - varPtr = TclVarTraceExists(interp, ObjStr(npav[0])); - invocation[2] = npav[0]; - ic = 3; - if (varPtr && !TclIsVarUndefined(varPtr)) { - invocation[3] = Tcl_ObjGetVar2(interp, npav[0], 0, 0); - ic = 4; - } - result = Tcl_EvalObjv(interp, ic, invocation, 0); - /* - {Tcl_Obj *objPtr = Tcl_ConcatObj(ic, invocation); - fprintf(stderr,"eval on <%s>\n", ObjStr(objPtr)); - result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); - } - */ - if (result == TCL_OK && ic == 4) { - result = Tcl_GetIntFromObj(interp, Tcl_GetObjResult(interp),&checkResult); - } - if (result != TCL_OK) { - return result; - } - if (!checkResult && ic == 4) { - return XOTclVarErrMsg(interp, - "non-positional argument: '", ObjStr(invocation[2]), "' with value '", - ObjStr(invocation[3]), "' is not of ", ObjStr(invocation[1]), - (char *) NULL); - } - } - } - } - } return TCL_OK; } -#endif + /* create a slave interp that calls XOTcl Init */ static int XOTcl_InterpObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { @@ -12763,7 +12441,7 @@ #ifdef DO_FULL_CLEANUP /* delete global variables and procs */ -static void +static void deleteProcsAndVars(Tcl_Interp *interp) { Tcl_Namespace *ns = Tcl_GetGlobalNamespace(interp); Tcl_HashTable *varTable = ns ? Tcl_Namespace_varTable(ns) : NULL; @@ -12837,8 +12515,8 @@ return result; } -static void -freeAllXOTclObjectsAndClasses(Tcl_Interp *interp, Tcl_HashTable *commandTable, +static void +freeAllXOTclObjectsAndClasses(Tcl_Interp *interp, Tcl_HashTable *commandTable, XOTclClass *rootClass, XOTclClass *rootMetaClass) { Tcl_HashEntry *hPtr; Tcl_HashSearch hSrch; @@ -12855,7 +12533,7 @@ char *key = Tcl_GetHashKey(commandTable, hPtr); obj = XOTclpGetObject(interp, key); if (obj && !XOTclObjectIsClass(obj) && !ObjectHasChildren(interp, obj)) { - /* fprintf(stderr," ... delete object %s %p, class=%s\n", key, obj, + /* fprintf(stderr," ... delete object %s %p, class=%s\n", key, obj, className(obj->cl));*/ freeUnsetTraceVariable(interp, obj); Tcl_DeleteCommandFromToken(interp, obj->id); @@ -12962,7 +12640,7 @@ return TCL_OK; } -/* +/* * ::xotcl::finalize command */ static int @@ -12985,7 +12663,7 @@ "Error in line %d: %s\nExecution interrupted.\n", interp->errorLine, ObjStr(Tcl_GetObjResult(interp))); } - + for (os = RUNTIME_STATE(interp)->rootClasses; os; os = os->nextPtr) { destroyObjectSystem(interp, os->cl, (XOTclClass *)os->clientData); } @@ -13054,7 +12732,7 @@ if (Tcl_CallFrame_level(f) == 0) break; Tcl_PopCallFrame(interp); } - + /* must be before freeing of XOTclGlobalObjects */ XOTclShadowTclCommands(interp, SHADOW_UNLOAD); @@ -13071,10 +12749,10 @@ checkmem checkmemFile"); */ #endif MEM_COUNT_DUMP(); - + FREE(Tcl_Obj**, XOTclGlobalObjects); FREE(XOTclRuntimeState, RUNTIME_STATE(interp)); - + Tcl_Interp_flags(interp) = flags; Tcl_Release((ClientData) interp); } @@ -13087,7 +12765,7 @@ static void XOTcl_ThreadExitProc(ClientData clientData) { /*fprintf(stderr,"+++ XOTcl_ThreadExitProc\n");*/ - + void XOTcl_ExitProc(ClientData clientData); Tcl_DeleteExitHandler(XOTcl_ExitProc, clientData); ExitHandler(clientData); @@ -13123,8 +12801,8 @@ int XOTclCreateObjectSystem(Tcl_Interp *interp, char *Object, char *Class) { XOTclClass *theobj = 0; - XOTclClass *thecls = 0; - + XOTclClass *thecls = 0; + /* Create a basic object system with the basic root class Object and the basic metaclass Class, and store them in the RUNTIME STATE if successful */ @@ -13166,7 +12844,7 @@ } static int -XOTclCreateObjectSystemCmd(ClientData clientData, Tcl_Interp *interp, +XOTclCreateObjectSystemCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { if (objc < 3) { return XOTclObjErrArgCnt(interp, objv[0], NULL, "rootClass rootMetaClass"); @@ -13205,11 +12883,11 @@ { int major, minor, patchlvl, type; Tcl_GetVersion(&major, &minor, &patchlvl, &type); - + if ((major == 8) && (minor < 5)) { - /* - * loading a version of xotcl compiled for 8.4 version - * into a 8.4 Tcl + /* + * loading a version of xotcl compiled for 8.4 version + * into a 8.4 Tcl */ /* fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.4 Tcl\n"); @@ -13222,9 +12900,9 @@ varRefCountOffset = TclOffset(Var, refCount); varHashTableSize = sizeof(Tcl_HashTable); } else { - /* - * loading a version of xotcl compiled for 8.4 version - * into a 8.5 Tcl + /* + * loading a version of xotcl compiled for 8.4 version + * into a 8.5 Tcl */ /* fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.5 Tcl\n"); @@ -13237,7 +12915,7 @@ varRefCountOffset = TclOffset(VarInHash, refCount); varHashTableSize = sizeof(TclVarHashTable85); } - + } #endif /* @@ -13262,7 +12940,7 @@ /* create xotcl namespace */ RUNTIME_STATE(interp)->XOTclNS = Tcl_CreateNamespace(interp, "::xotcl", (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL); - + MEM_COUNT_ALLOC("TclNamespace", RUNTIME_STATE(interp)->XOTclNS); /* @@ -13338,10 +13016,9 @@ #endif Tcl_CreateObjCommand(interp, "::xotcl::self", XOTclGetSelfObjCmd, 0, 0); /*Tcl_CreateObjCommand(interp, "::xotcl::K", XOTclKObjCmd, 0, 0);*/ - + Tcl_CreateObjCommand(interp, "::xotcl::createobjectsystem", XOTclCreateObjectSystemCmd, 0, 0); Tcl_CreateObjCommand(interp, "::xotcl::dispatch", XOTclDispatchCmd, 0, 0); - Tcl_CreateObjCommand(interp, "::xotcl::configure", XOTclConfigureCmd, 0, 0); Tcl_CreateObjCommand(interp, "::xotcl::deprecated", XOTcl_DeprecatedCmd, 0, 0); Tcl_CreateObjCommand(interp, "::xotcl::finalize", XOTclFinalizeObjCmd, 0, 0); #if defined(PRE85) Index: generic/xotcl.h =================================================================== diff -u -r108d81ec266a27d011953bdc6b7d8b32eb0afcc7 -recc8a110c338877202b900868da32eb8dcd561ad --- generic/xotcl.h (.../xotcl.h) (revision 108d81ec266a27d011953bdc6b7d8b32eb0afcc7) +++ generic/xotcl.h (.../xotcl.h) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -79,8 +79,14 @@ #define OBJDELETION_TRACE 1 #define STACK_TRACE 1 #define PARSE_TRACE 1 +#define PARSE_TRACE_FULL 1 */ + +#if defined PARSE_TRACE_FULL +# define PARSE_TRACE 1 +#endif + #ifdef XOTCL_MEM_COUNT # define DO_FULL_CLEANUP 1 #endif Index: generic/xotclInt.h =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- generic/xotclInt.h (.../xotclInt.h) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ generic/xotclInt.h (.../xotclInt.h) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -1,8 +1,7 @@ /* -*- Mode: c++ -*- - * $Id: xotclInt.h,v 1.27 2007/10/12 19:53:32 neumann Exp $ * Extended Object Tcl (XOTcl) * - * Copyright (C) 1999-2008 Gustaf Neumann, Uwe Zdun + * Copyright (C) 1999-2009 Gustaf Neumann, Uwe Zdun * * xotclInt.h -- * @@ -44,7 +43,7 @@ #endif #ifdef XOTCL_MEM_COUNT -Tcl_HashTable xotclMemCount; +Tcl_HashTable xotclMemCount; extern int xotclMemCountInterpCounter; typedef struct XOTclMemCounter { int peak; @@ -58,9 +57,9 @@ xotclMemCountInterpCounter = 1; \ } # define MEM_COUNT_DUMP() XOTclMemCountDump(interp) -# define MEM_COUNT_OPEN_FRAME() +# define MEM_COUNT_OPEN_FRAME() /*if (obj->varTable) noTableBefore = 0*/ -# define MEM_COUNT_CLOSE_FRAME() +# define MEM_COUNT_CLOSE_FRAME() /* if (obj->varTable && noTableBefore) \ XOTclMemCountAlloc("obj->varTable",NULL)*/ #else @@ -184,7 +183,7 @@ type *var = __##var + 1; var[-1] = var[__##var##_count] = (type)0xdeadbeaf # define FREE_ON_STACK(var) \ assert(var[-1] == var[__##var##_count] && (void *)var[-1] == (void*)0xdeadbeaf) -# else +# else # define ALLOC_ON_STACK(type,n,var) type var[(n)] # define FREE_ON_STACK(var) # endif @@ -228,7 +227,7 @@ #endif #if defined(TCL_THREADS) -# define XOTclMutex Tcl_Mutex +# define XOTclMutex Tcl_Mutex # define XOTclMutexLock(a) Tcl_MutexLock(a) # define XOTclMutexUnlock(a) Tcl_MutexUnlock(a) #else @@ -261,7 +260,7 @@ MEM_COUNT_CLOSE_FRAME() #else -/* slightly slower version based on Tcl_PushCallFrame. +/* slightly slower version based on Tcl_PushCallFrame. Note that it is possible that between push and pop a obj->nsPtr can be created (e.g. during a read trace) */ @@ -300,7 +299,7 @@ ctx,obj,ObjStr(obj->cmdName), obj->id, obj->teardown, \ (obj->flags & XOTCL_DESTROY_CALLED)) #else -# define PRINTOBJ(ctx,obj) +# define PRINTOBJ(ctx,obj) #endif #define className(cl) (cl ? ObjStr(cl->object.cmdName) : "") @@ -358,8 +357,8 @@ CHECK_ALL = CHECK_INVAR + CHECK_PRE + CHECK_POST } CheckOptions; -void XOTclAssertionRename(Tcl_Interp *interp, Tcl_Command cmd, - XOTclAssertionStore *as, +void XOTclAssertionRename(Tcl_Interp *interp, Tcl_Command cmd, + XOTclAssertionStore *as, char *oldSimpleCmdName, char *newName); /* * mixins @@ -389,13 +388,13 @@ int length; } XOTclStringIncrStruct; -/* +/* * object flags ... */ -/* DESTROY_CALLED indicates that destroy was called on obj */ +/* DESTROY_CALLED indicates that destroy was called on obj */ #define XOTCL_DESTROY_CALLED 0x0001 -/* INIT_CALLED indicates that init was called on obj */ +/* INIT_CALLED indicates that init was called on obj */ #define XOTCL_INIT_CALLED 0x0002 /* MIXIN_ORDER_VALID set when mixin order is valid */ #define XOTCL_MIXIN_ORDER_VALID 0x0004 @@ -438,14 +437,12 @@ int nrargs; XOTclTypeConverter *converter; Tcl_Obj *defaultValue; + char *type; } argDefinition; typedef struct XOTclNonposArgs { - Tcl_Obj *nonposArgs; - Tcl_Obj *ordinaryArgs; - Tcl_Obj *slotObj; argDefinition *ifd; - int ifdSize; + Tcl_Obj *slotObj; } XOTclNonposArgs; typedef struct XOTclObjectOpt { @@ -524,12 +521,12 @@ XOTE_EMPTY, XOTE_UNKNOWN, XOTE_CREATE, XOTE_DESTROY, XOTE_DEALLOC, XOTE_ALLOC, XOTE_INIT, XOTE_INSTVAR, XOTE_INTERP, XOTE_AUTONAMES, XOTE_ZERO, XOTE_ONE, XOTE_MOVE, XOTE_SELF, XOTE_CLASS, XOTE_RECREATE, - XOTE_SELF_CLASS, XOTE_SELF_PROC, - XOTE_EXIT_HANDLER, XOTE_DEFAULTSUPERCLASS, XOTE_DEFAULTMETACLASS, + XOTE_SELF_CLASS, XOTE_SELF_PROC, + XOTE_EXIT_HANDLER, XOTE_DEFAULTSUPERCLASS, XOTE_DEFAULTMETACLASS, XOTE_NON_POS_ARGS_OBJ, XOTE_SETVALUES, XOTE_CLEANUP, XOTE_CONFIGURE, XOTE_FILTER, XOTE_INSTFILTER, XOTE_INSTPROC, XOTE_PROC, XOTE_INSTFORWARD, XOTE_FORWARD, - XOTE_INSTCMD, XOTE_CMD, XOTE_INSTPARAMETERCMD, XOTE_PARAMETERCMD, + XOTE_INSTCMD, XOTE_CMD, XOTE_INSTPARAMETERCMD, XOTE_PARAMETERCMD, XOTE_FORMAT, XOTE_INITSLOTS, XOTE_NEWOBJ, XOTE_GUARD_OPTION, XOTE_DEFAULTMETHOD, XOTE___UNKNOWN, XOTE_ARGS, XOTE_SPLIT, XOTE_COMMA, @@ -544,14 +541,14 @@ "", "unknown", "create", "destroy", "dealloc", "alloc", "init", "instvar", "interp", "__autonames", "0", "1", "move", "self", "class", "recreate", - "self class", "self proc", + "self class", "self proc", "__exitHandler", "__default_superclass", "__default_metaclass", "::xotcl::nonposArgs", "setvalues", "cleanup", "configure", "filter", "instfilter", "instproc", "proc", "instforward", "forward", "instcmd", "cmd", "instparametercmd", "parametercmd", "format", "initslots", - "__#", "-guard", "defaultmethod", + "__#", "-guard", "defaultmethod", "__unknown", "args", "split", ",", "expr", "info", "rename", "subst", }; @@ -690,7 +687,7 @@ extern void XOTclProfilePrintData(Tcl_Interp *interp); -extern void +extern void XOTclProfileInit(Tcl_Interp *interp); #endif @@ -711,12 +708,12 @@ extern void XOTclMetaDataInit(XOTclObject *obj); extern int -XOTclOMetaDataMethod (ClientData cd, Tcl_Interp *interp, +XOTclOMetaDataMethod (ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *objv[]); #endif /* XOTCL_METADATA */ -/* +/* * bytecode support */ #ifdef XOTCL_BYTECODE @@ -727,20 +724,20 @@ Tcl_ObjCmdProc *callProc; } XOTclCompEnv; -typedef enum {INST_INITPROC, INST_NEXT, INST_SELF, INST_SELF_DISPATCH, +typedef enum {INST_INITPROC, INST_NEXT, INST_SELF, INST_SELF_DISPATCH, LAST_INSTRUCTION} XOTclByteCodeInstructions; extern XOTclCompEnv *XOTclGetCompEnv(); -Tcl_ObjCmdProc XOTclInitProcNSCmd, XOTclSelfDispatchCmd, +Tcl_ObjCmdProc XOTclInitProcNSCmd, XOTclSelfDispatchCmd, XOTclNextObjCmd, XOTclGetSelfObjCmd; int XOTclDirectSelfDispatch(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); #endif -int +int XOTclObjDispatch(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); Index: tests/testx.xotcl =================================================================== diff -u -rfb1840d39d6069f7b26e0d982448ef2602782e9e -recc8a110c338877202b900868da32eb8dcd561ad --- tests/testx.xotcl (.../testx.xotcl) (revision fb1840d39d6069f7b26e0d982448ef2602782e9e) +++ tests/testx.xotcl (.../testx.xotcl) (revision ecc8a110c338877202b900868da32eb8dcd561ad) @@ -3289,8 +3289,8 @@ namespace eval ns1 {Class C; namespace export C} o eval {namespace import ::ns1::*} - ::errorCheck [o info children] "::o::cde ::o::bcd ::o::abc" "info children 1" - ::errorCheck [o info children *cd*] "::o::cde ::o::bcd" "info children 2" + ::errorCheck [lsort [o info children]] "::o::abc ::o::bcd ::o::cde" "info children 1" + ::errorCheck [lsort [o info children *cd*]] "::o::bcd ::o::cde" "info children 2" ::errorCheck [o info children ::o::cde] ::o::cde "info children 3" ::errorCheck [o info children ::o::def] "" "info children 4" Object new -childof o @@ -3845,19 +3845,19 @@ catch { o y 4 56 5 } m - errorCheck $m {unknown argument '5' for method 'y': valid arguments -x {-a {1 2 3}} a b} "wrong \# check 1" + errorCheck $m {wrong # args: should be "y ?-x arg? ?-a arg? a b"} "wrong \# check 1" catch { o y } m - errorCheck $m "wrong # args for method 'y': valid arguments -x {-a {1 2 3}} a b" "wrong \# check 2" + errorCheck $m {wrong # args: should be "y ?-x arg? ?-a arg? a b"} "wrong \# check 2" catch { o y -x 1 } m - errorCheck $m "wrong # args for method 'y': valid arguments -x {-a {1 2 3}} a b" "wrong \# check 3" + errorCheck $m {method y: required argument 'a' is missing} "wrong \# check 3" catch { o z1 a 1 2 3 } m - errorCheck $m "required arg: 'x' missing" "required missing" + errorCheck $m {method z1: required argument 'x' is missing} "required missing" errorCheck [o z1 -x 1 a 1 2 3] "1 -- 1 2 3" "invocation 1" errorCheck [o z2 -x 2 a 1 2 3] "2 -- a 1 2 3 -- 1 -- 1 2" "invocation 2" catch { @@ -3868,17 +3868,15 @@ "1 -- a b c -- 2 -- 3" "invocation 3" errorCheck [p z2 -x 1 -a 2 -b 3 a b c] \ "1 -- a b c -- 2 -- 3" "invocation 4" - errorCheck [o z3 -b true -- -b] "true -b" "dash dash" - errorCheck [o z5 -pos 1 a b] "1 {a b}" "nonpos with given args" errorCheck [o z5 -pos 1 a] "1 a" "nonpos with given args" errorCheck [o z5 -pos 1] "1 {}" "nonpos without given args" catch { o z3 -b abc -- -b } m - errorCheck $m "non-positional argument: 'b' with value 'abc' is not of type=boolean" "not boolean" + errorCheck $m {expected boolean value but got "abc"} "not boolean" set ::r "" #o z4 -c 1 1 @@ -3927,7 +3925,7 @@ o foo o foo -foo 0 catch {o foo -foo} msg - errorCheck $msg "Non positional arg '-foo': value missing" "Empty non-pos arg" + errorCheck $msg "Argument for parameter '-foo' expected" "Empty non-pos arg" Object oa oa proc foo {{-a A} b} { @@ -3938,7 +3936,7 @@ oa foo "---" catch {oa foo "--"} msg - errorCheck $msg "wrong # args for method 'foo': valid arguments {-a A} b" "Non-pos arg: double dash alone" + errorCheck $msg "method foo: required argument 'b' is missing" "Non-pos arg: double dash alone" Class C C create c1 @@ -4070,8 +4068,19 @@ errorCheck [catch {o p7 -x 2 1}] 0 nonpos-15 errorCheck [catch {o p7 -x 2 }] 1 nonpos-16 errorCheck [catch {o p8 -x 2 }] 0 nonpos-17 - o destroy + o proc foo {-enable:switch i:integer} { + return "enable=$enable, i=$i" + } + o proc bar {-enable:switch o:object c:class} { + return "o=$o c=$c" + } + errorCheck [catch {o foo 123}] 0 check-pos-args-1 + errorCheck [catch {o foo abc}] 1 check-pos-args-2 + errorCheck [catch {o bar o Object}] 0 check-pos-args-3 + errorCheck [catch {o bar ooo Object}] 1 check-pos-args-4 + errorCheck [catch {o bar o Object1}] 1 check-pos-args-5 + Class X X instproc ListOfStringsOption {{-default "murr6"} {-cb {}} name} { if {$cb eq {}} { set cb "::set ::$name " } ;# global variable