Index: generic/gentclAPI.decls =================================================================== diff -u -rbc6eb608936be7ce3ab17f64981902a4f51194d1 -r08e94eff6214a9b51f96c9bd14dd521e89589b6e --- generic/gentclAPI.decls (.../gentclAPI.decls) (revision bc6eb608936be7ce3ab17f64981902a4f51194d1) +++ generic/gentclAPI.decls (.../gentclAPI.decls) (revision 08e94eff6214a9b51f96c9bd14dd521e89589b6e) @@ -124,6 +124,11 @@ {-argName "objectkind" -type "type|object|class|baseclass|metaclass|hasmixin"} {-argName "value" -required 0 -type tclobj} } +xotclCmd parametercheck XOTclParametercheckCmd { + {-argName "-nocomplain"} + {-argName "param" -type tclobj} + {-argName "value" -required 0 -type tclobj} +} xotclCmd __qualify XOTclQualifyObjCmd { {-argName "name" -required 1 -type tclobj} } @@ -145,11 +150,6 @@ {-argName "-per-object"} {-argName "parameter" -type tclobj} } -xotclCmd valuecheck XOTclValuecheckCmd { - {-argName "-nocomplain"} - {-argName "param" -type tclobj} - {-argName "value" -required 0 -type tclobj} -} # # object methods # Index: generic/tclAPI.h =================================================================== diff -u -rbc6eb608936be7ce3ab17f64981902a4f51194d1 -r08e94eff6214a9b51f96c9bd14dd521e89589b6e --- generic/tclAPI.h (.../tclAPI.h) (revision bc6eb608936be7ce3ab17f64981902a4f51194d1) +++ generic/tclAPI.h (.../tclAPI.h) (revision 08e94eff6214a9b51f96c9bd14dd521e89589b6e) @@ -209,11 +209,11 @@ static int XOTclNSCopyCmdsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclNSCopyVarsStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclObjectpropertyCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); +static int XOTclParametercheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclQualifyObjCmdStub(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 []); static int XOTclSetInstvarCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclSetterCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); -static int XOTclValuecheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv []); static int XOTclCAllocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *name); static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]); @@ -290,11 +290,11 @@ static int XOTclNSCopyCmds(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int XOTclNSCopyVars(Tcl_Interp *interp, Tcl_Obj *fromNs, Tcl_Obj *toNs); static int XOTclObjectpropertyCmd(Tcl_Interp *interp, Tcl_Obj *object, int objectkind, Tcl_Obj *value); +static int XOTclParametercheckCmd(Tcl_Interp *interp, int withNocomplain, Tcl_Obj *param, Tcl_Obj *value); static int XOTclQualifyObjCmd(Tcl_Interp *interp, Tcl_Obj *name); static int XOTclRelationCmd(Tcl_Interp *interp, XOTclObject *object, int relationtype, Tcl_Obj *value); static int XOTclSetInstvarCmd(Tcl_Interp *interp, XOTclObject *object, Tcl_Obj *variable, Tcl_Obj *value); static int XOTclSetterCmd(Tcl_Interp *interp, XOTclObject *object, int withPer_object, Tcl_Obj *parameter); -static int XOTclValuecheckCmd(Tcl_Interp *interp, int withNocomplain, Tcl_Obj *param, Tcl_Obj *value); enum { XOTclCAllocMethodIdx, @@ -372,11 +372,11 @@ XOTclNSCopyCmdsIdx, XOTclNSCopyVarsIdx, XOTclObjectpropertyCmdIdx, + XOTclParametercheckCmdIdx, XOTclQualifyObjCmdIdx, XOTclRelationCmdIdx, XOTclSetInstvarCmdIdx, - XOTclSetterCmdIdx, - XOTclValuecheckCmdIdx + XOTclSetterCmdIdx } XOTclMethods; @@ -1859,6 +1859,26 @@ } static int +XOTclParametercheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { + parseContext pc; + + if (ArgumentParse(interp, objc, objv, NULL, objv[0], + method_definitions[XOTclParametercheckCmdIdx].paramDefs, + method_definitions[XOTclParametercheckCmdIdx].nrParameters, + &pc) != TCL_OK) { + return TCL_ERROR; + } else { + int withNocomplain = (int )PTR2INT(pc.clientData[0]); + Tcl_Obj *param = (Tcl_Obj *)pc.clientData[1]; + Tcl_Obj *value = (Tcl_Obj *)pc.clientData[2]; + + parseContextRelease(&pc); + return XOTclParametercheckCmd(interp, withNocomplain, param, value); + + } +} + +static int XOTclQualifyObjCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { parseContext pc; @@ -1936,26 +1956,6 @@ } } -static int -XOTclValuecheckCmdStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { - parseContext pc; - - if (ArgumentParse(interp, objc, objv, NULL, objv[0], - method_definitions[XOTclValuecheckCmdIdx].paramDefs, - method_definitions[XOTclValuecheckCmdIdx].nrParameters, - &pc) != TCL_OK) { - return TCL_ERROR; - } else { - int withNocomplain = (int )PTR2INT(pc.clientData[0]); - Tcl_Obj *param = (Tcl_Obj *)pc.clientData[1]; - Tcl_Obj *value = (Tcl_Obj *)pc.clientData[2]; - - parseContextRelease(&pc); - return XOTclValuecheckCmd(interp, withNocomplain, param, value); - - } -} - static methodDefinition method_definitions[] = { {"::xotcl::cmd::Class::alloc", XOTclCAllocMethodStub, 1, { {"name", 1, 0, convertToTclobj}} @@ -2295,6 +2295,11 @@ {"objectkind", 0, 0, convertToObjectkind}, {"value", 0, 0, convertToTclobj}} }, +{"::xotcl::parametercheck", XOTclParametercheckCmdStub, 3, { + {"-nocomplain", 0, 0, convertToString}, + {"param", 0, 0, convertToTclobj}, + {"value", 0, 0, convertToTclobj}} +}, {"::xotcl::__qualify", XOTclQualifyObjCmdStub, 1, { {"name", 1, 0, convertToTclobj}} }, @@ -2312,11 +2317,6 @@ {"object", 1, 0, convertToObject}, {"-per-object", 0, 0, convertToString}, {"parameter", 0, 0, convertToTclobj}} -}, -{"::xotcl::valuecheck", XOTclValuecheckCmdStub, 3, { - {"-nocomplain", 0, 0, convertToString}, - {"param", 0, 0, convertToTclobj}, - {"value", 0, 0, convertToTclobj}} },{NULL} }; Index: generic/xotcl.c =================================================================== diff -u -rbc6eb608936be7ce3ab17f64981902a4f51194d1 -r08e94eff6214a9b51f96c9bd14dd521e89589b6e --- generic/xotcl.c (.../xotcl.c) (revision bc6eb608936be7ce3ab17f64981902a4f51194d1) +++ generic/xotcl.c (.../xotcl.c) (revision 08e94eff6214a9b51f96c9bd14dd521e89589b6e) @@ -11465,12 +11465,10 @@ Tcl_AppendToObj(paramObj, ",arg=", 5); Tcl_AppendObjToObj(paramObj, arg); - result = XOTclValuecheckCmd(interp, 1, paramObj, value); + result = XOTclParametercheckCmd(interp, 1, paramObj, value); DECR_REF_COUNT(paramObj); } else { - INCR_REF_COUNT(constraintObj); - result = XOTclValuecheckCmd(interp, 1, constraintObj, value); - DECR_REF_COUNT(constraintObj); + result = XOTclParametercheckCmd(interp, 1, constraintObj, value); } return result; @@ -12564,20 +12562,20 @@ } /* -xotclCmd valuecheck XOTclValuecheckCmd { +xotclCmd parametercheck XOTclParametercheckCmd { {-argName "param" -type tclobj} {-argName "-nocomplain"} {-argName "value" -required 0 -type tclobj} } */ -static int XOTclValuecheckCmd(Tcl_Interp *interp, int withNocomplain, Tcl_Obj *objPtr, Tcl_Obj *value) { +static int XOTclParametercheckCmd(Tcl_Interp *interp, int withNocomplain, Tcl_Obj *objPtr, Tcl_Obj *value) { XOTclParamWrapper *paramWrapperPtr; XOTclParam *paramPtr; ClientData checkedData; Tcl_Obj *outObjPtr; int result, flags = 0; - /*fprintf(stderr, "XOTclValuecheckCmd %s %s\n",ObjStr(objPtr), ObjStr(value));*/ + /*fprintf(stderr, "XOTclParametercheckCmd %s %s\n",ObjStr(objPtr), ObjStr(value));*/ if (objPtr->typePtr == ¶mObjType) { paramWrapperPtr = (XOTclParamWrapper *) objPtr->internalRep.twoPtrValue.ptr1; @@ -12611,10 +12609,10 @@ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); } - /*fprintf(stderr, "XOTclValuecheckCmd paramPtr %p final refcount of wrapper %d can free %d\n",paramPtr, + /*fprintf(stderr, "XOTclParametercheckCmd paramPtr %p final refcount of wrapper %d can free %d\n",paramPtr, paramWrapperPtr->refCount, paramWrapperPtr->canFree);*/ if (paramWrapperPtr->refCount == 0) { - /* fprintf(stderr, "XOTclValuecheckCmd paramPtr %p manual free\n",paramPtr);*/ + /* fprintf(stderr, "XOTclParametercheckCmd paramPtr %p manual free\n",paramPtr);*/ ParamsFree(paramWrapperPtr->paramPtr); FREE(XOTclParamWrapper, paramWrapperPtr); } else { Index: tests/parameters.xotcl =================================================================== diff -u -rbc6eb608936be7ce3ab17f64981902a4f51194d1 -r08e94eff6214a9b51f96c9bd14dd521e89589b6e --- tests/parameters.xotcl (.../parameters.xotcl) (revision bc6eb608936be7ce3ab17f64981902a4f51194d1) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision 08e94eff6214a9b51f96c9bd14dd521e89589b6e) @@ -13,19 +13,19 @@ #exit ####################################################### -# valuecheck +# parametercheck ####################################################### Test parameter count 10000 -Test case valuecheck { +Test case parametercheck { Object create o1 Class create C -parameter {a {b:boolean} {c 1}} C create c1 Class create M c1 mixin M - ? {::xotcl::valuecheck object o1} 1 - ? {::xotcl::valuecheck integer 1} 1 + ? {::xotcl::parametercheck object o1} 1 + ? {::xotcl::parametercheck integer 1} 1 ? {::xotcl::objectproperty o1 object} 1 ? {::xotcl::objectproperty c1 type C} 1 @@ -41,47 +41,47 @@ ? {::xotcl::is o object -type C} 0 ? {::xotcl::is o object -hasmixin C} 0 #exit - ? {::xotcl::valuecheck class o1} {expected class but got "o1" for parameter value} - ? {::xotcl::valuecheck -nocomplain class o1} 0 - ? {::xotcl::valuecheck class Test} 1 - ? {::xotcl::valuecheck object,multivalued [list o1 Test]} 1 + ? {::xotcl::parametercheck class o1} {expected class but got "o1" for parameter value} + ? {::xotcl::parametercheck -nocomplain class o1} 0 + ? {::xotcl::parametercheck class Test} 1 + ? {::xotcl::parametercheck object,multivalued [list o1 Test]} 1 - ? {::xotcl::valuecheck integer,multivalued [list 1 2 3]} 1 - ? {::xotcl::valuecheck integer,multivalued [list 1 2 3 a]} \ + ? {::xotcl::parametercheck integer,multivalued [list 1 2 3]} 1 + ? {::xotcl::parametercheck integer,multivalued [list 1 2 3 a]} \ {invalid value in "1 2 3 a": expected integer but got "a" for parameter value} - ? {::xotcl::valuecheck object,type=::C c1} 1 - ? {::xotcl::valuecheck object,type=::C o} \ + ? {::xotcl::parametercheck object,type=::C c1} 1 + ? {::xotcl::parametercheck object,type=::C o} \ {expected object but got "o" for parameter value} \ "object, but different type" - ? {::xotcl::valuecheck object,type=::C c} \ + ? {::xotcl::parametercheck object,type=::C c} \ {expected object but got "c" for parameter value} \ "no object" - ? {::xotcl::valuecheck object,type=::xotcl2::Object c1} 1 "general type" + ? {::xotcl::parametercheck object,type=::xotcl2::Object c1} 1 "general type" - # do not allow "currently unknown" user defined types in valuecheck - ? {::xotcl::valuecheck in1 aaa} {invalid value constraints "in1"} + # do not allow "currently unknown" user defined types in parametercheck + ? {::xotcl::parametercheck in1 aaa} {invalid value constraints "in1"} - ? {::xotcl::valuecheck lower c} 1 "lower case char" - ? {::xotcl::valuecheck lower abc} 1 "lower case chars" - ? {::xotcl::valuecheck lower Abc} {expected lower but got "Abc" for parameter value} + ? {::xotcl::parametercheck lower c} 1 "lower case char" + ? {::xotcl::parametercheck lower abc} 1 "lower case chars" + ? {::xotcl::parametercheck lower Abc} {expected lower but got "Abc" for parameter value} ? {string is lower abc} 1 "tcl command 'string is lower'" - ? {::xotcl::valuecheck {i:integer 1} 2} {invalid value constraints "i:integer 1"} + ? {::xotcl::parametercheck {i:integer 1} 2} {invalid value constraints "i:integer 1"} } ####################################################### -# valuecheck +# parametercheck ####################################################### Test parameter count 10000 -Test case valuecheck { +Test case parametercheck { Object create ::paramManager { :method type=sex {name value} { return "agamous" } } - ? {::xotcl::valuecheck sex,slot=::paramManager female} "1" + ? {::xotcl::parametercheck sex,slot=::paramManager female} "1" } ####################################################### # cononical feature table @@ -104,7 +104,7 @@ # specified value is the first argument unless "noarg" is used # (example: -noinit). # -# parameter type multivalued required noarg type= arg= valueCheck methodParm objectParm +# parameter type multivalued required noarg type= arg= parametercheck methodParm objectParm # initcmd NO YES NO NO NO NO NO/POSSIBLE YES # method NO YES YES NO YES NO NO/POSSIBLE YES # @@ -848,11 +848,11 @@ # values into emtpy strings. } - ? {::xotcl::valuecheck mType,slot=::tmpObj,multivalued {1 0}} \ + ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {1 0}} \ {invalid value in "1 0": expected false but got 1} \ "fail on first value" - ? {::xotcl::valuecheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass" - ? {::xotcl::valuecheck mType,slot=::tmpObj,multivalued {0 1}} \ + ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {0 0 0}} 1 "all pass" + ? {::xotcl::parametercheck mType,slot=::tmpObj,multivalued {0 1}} \ {invalid value in "0 1": expected false but got 1} \ "fail o last value" } @@ -872,7 +872,7 @@ } } - ? {::xotcl::valuecheck integer,slot=::mySlot 1} 1 + ? {::xotcl::parametercheck integer,slot=::mySlot 1} 1 ? {o foo 3} 4 }