Index: generic/predefined.h =================================================================== diff -u -r89fec6ccb2d935530a2ab141440ca343deda3338 -rd3aa8e069917e7ba7d69e936ec4e563b7e0dc34d --- generic/predefined.h (.../predefined.h) (revision 89fec6ccb2d935530a2ab141440ca343deda3338) +++ generic/predefined.h (.../predefined.h) (revision d3aa8e069917e7ba7d69e936ec4e563b7e0dc34d) @@ -209,10 +209,10 @@ "-volatile:method,optional,noarg \\\n" "arg:initcmd,optional\n" "return $parameterdefinitions}\n" -"::xotcl2::Class create ::xotcl2::ParameterType\n" -"foreach cmd [info command ::xotcl::cmd::ParameterType::*] {\n" -"::xotcl::alias ::xotcl2::ParameterType [namespace tail $cmd] $cmd}\n" -"::xotcl2::ParameterType create ::xotcl2::parameterType\n" +"::xotcl2::Class create ::xotcl::ParameterSlot\n" +"foreach cmd [info command ::xotcl::cmd::ParameterSlot::*] {\n" +"::xotcl::alias ::xotcl::ParameterSlot [namespace tail $cmd] $cmd}\n" +"::xotcl::ParameterSlot create ::xotcl::parameterSlot\n" "proc createBootstrapAttributeSlots {class definitions} {\n" "if {![::xotcl::is ${class}::slot object]} {\n" "::xotcl2::Object create ${class}::slot}\n" Index: generic/predefined.xotcl =================================================================== diff -u -r89fec6ccb2d935530a2ab141440ca343deda3338 -rd3aa8e069917e7ba7d69e936ec4e563b7e0dc34d --- generic/predefined.xotcl (.../predefined.xotcl) (revision 89fec6ccb2d935530a2ab141440ca343deda3338) +++ generic/predefined.xotcl (.../predefined.xotcl) (revision d3aa8e069917e7ba7d69e936ec4e563b7e0dc34d) @@ -412,14 +412,14 @@ } # -# create class and object for nonpositional argument processing -::xotcl2::Class create ::xotcl2::ParameterType -foreach cmd [info command ::xotcl::cmd::ParameterType::*] { - ::xotcl::alias ::xotcl2::ParameterType [namespace tail $cmd] $cmd +# create class and object for parameter slots +::xotcl2::Class create ::xotcl::ParameterSlot +foreach cmd [info command ::xotcl::cmd::ParameterSlot::*] { + ::xotcl::alias ::xotcl::ParameterSlot [namespace tail $cmd] $cmd } # create an object for dispatching -::xotcl2::ParameterType create ::xotcl2::parameterType +::xotcl::ParameterSlot create ::xotcl::parameterSlot # use low level interface for defining slot values. Normally, this is Index: generic/xotcl.c =================================================================== diff -u -r89fec6ccb2d935530a2ab141440ca343deda3338 -rd3aa8e069917e7ba7d69e936ec4e563b7e0dc34d --- generic/xotcl.c (.../xotcl.c) (revision 89fec6ccb2d935530a2ab141440ca343deda3338) +++ generic/xotcl.c (.../xotcl.c) (revision d3aa8e069917e7ba7d69e936ec4e563b7e0dc34d) @@ -6250,7 +6250,7 @@ Tcl_Obj *ov[5]; int result, oc; - ov[0] = XOTclGlobalObjects[XOTE_PARAMETER_TYPE_OBJ]; + ov[0] = XOTclGlobalObjects[XOTE_PARAMETER_SLOT_OBJ]; ov[1] = pPtr->converterName; ov[2] = pPtr->nameObj; ov[3] = objPtr; @@ -6321,7 +6321,6 @@ static int ParamOptionParse(Tcl_Interp *interp, char *option, int length, int disallowedOptions, XOTclParam *paramPtr) { int result = TCL_OK; - /*fprintf(stderr, "ParamOptionParse name %s, option '%s' (%d) disallowed %.6x\n", paramPtr->name, option, length, disallowedOptions);*/ if (strncmp(option, "required", MAX(3,length)) == 0) { paramPtr->flags |= XOTCL_ARG_REQUIRED; @@ -6375,7 +6374,7 @@ XOTclClass *pcl; Tcl_Command cmd; - result = GetObjectFromObj(interp, XOTclGlobalObjects[XOTE_PARAMETER_TYPE_OBJ], ¶mObj); + result = GetObjectFromObj(interp, XOTclGlobalObjects[XOTE_PARAMETER_SLOT_OBJ], ¶mObj); if (result != TCL_OK) return result; @@ -6386,6 +6385,7 @@ if (cmd == NULL) { fprintf(stderr, "**** could not find checker method %s defined on %s\n", ObjStr(checker), objectName(paramObj)); + paramPtr->flags |= XOTCL_ARG_CURRENTLY_UNKNOWN; /* TODO: for the time being, we do not return an error here */ } result = ParamOptionSetConverter(interp, paramPtr, "usertype", convertViaCmd); @@ -6442,34 +6442,37 @@ /* we found a ':' */ int l, start, end; + /* get parameter name */ NEW_STRING(paramPtr->name, argString, j); paramPtr->nameObj = Tcl_NewStringObj(argName, isNonposArgument ? j-1 : j); INCR_REF_COUNT(paramPtr->nameObj); - /* skip space */ + /* skip space at begin */ for (start = j+1; start0 && isspace((int)argString[end-1]); end--); result = ParamOptionParse(interp, argString+start, end-start, disallowedOptions, paramPtr); if (result != TCL_OK) { goto param_error; } l++; - /* skip space */ + /* skip space from begin */ for (start = l; start0 && isspace((int)argString[end-1]); end--); /* process last option */ result = ParamOptionParse(interp, argString+start, end-start, disallowedOptions, paramPtr); if (result != TCL_OK) { goto param_error; } } else { - /* no ':', the whole arg is the name */ + /* no ':', the whole arg is the name, we have not options */ NEW_STRING(paramPtr->name, argString, length); if (isNonposArgument) { paramPtr->nameObj = Tcl_NewStringObj(argName, length-1); @@ -12147,7 +12150,6 @@ {-argName "value" -required 0 -type tclobj} } */ static int XOTclValuecheckCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *value) { - /* xxxx */ ClientData checkedData; XOTclParam *paramPtr; int result; Index: generic/xotclInt.h =================================================================== diff -u -red15b5be7e88cbbcdf6121f3869722dbc354d76f -rd3aa8e069917e7ba7d69e936ec4e563b7e0dc34d --- generic/xotclInt.h (.../xotclInt.h) (revision ed15b5be7e88cbbcdf6121f3869722dbc354d76f) +++ generic/xotclInt.h (.../xotclInt.h) (revision d3aa8e069917e7ba7d69e936ec4e563b7e0dc34d) @@ -358,6 +358,7 @@ #define XOTCL_ARG_REQUIRED 0x0001 #define XOTCL_ARG_MULTIVALUED 0x0002 #define XOTCL_ARG_NOARG 0x0004 +#define XOTCL_ARG_CURRENTLY_UNKNOWN 0x0008 #define XOTCL_ARG_SUBST_DEFAULT 0x0010 #define XOTCL_ARG_INITCMD 0x0020 #define XOTCL_ARG_METHOD 0x0040 @@ -367,7 +368,7 @@ /* disallowed options */ #define XOTCL_DISALLOWED_ARG_METHOD_PARAMETER (XOTCL_ARG_METHOD|XOTCL_ARG_INITCMD|XOTCL_ARG_RELATION) #define XOTCL_DISALLOWED_ARG_OBJECT_PARAMETER 0 -#define XOTCL_DISALLOWED_ARG_VALUEECHECK (XOTCL_ARG_SUBST_DEFAULT|XOTCL_ARG_METHOD|XOTCL_ARG_INITCMD|XOTCL_ARG_RELATION|XOTCL_ARG_SWITCH) +#define XOTCL_DISALLOWED_ARG_VALUEECHECK (XOTCL_ARG_SUBST_DEFAULT|XOTCL_ARG_METHOD|XOTCL_ARG_INITCMD|XOTCL_ARG_RELATION|XOTCL_ARG_SWITCH|XOTCL_ARG_CURRENTLY_UNKNOWN) /* method types */ @@ -505,7 +506,7 @@ XOTE_AUTONAMES, XOTE_DEFAULTMETACLASS, XOTE_DEFAULTSUPERCLASS, XOTE_ALIAS_ARRAY, /* object/class names */ - XOTE_PARAMETER_TYPE_OBJ, + XOTE_PARAMETER_SLOT_OBJ, /* constants */ XOTE_ALIAS, XOTE_ARGS, XOTE_CMD, XOTE_FILTER, XOTE_FORWARD, XOTE_METHOD, XOTE_OBJECT, XOTE_SETTER, @@ -528,7 +529,7 @@ "__autonames", "__default_metaclass", "__default_superclass", "::xotcl::alias", /* object/class names */ - "::xotcl::parameterType", + "::xotcl::parameterSlot", /* constants */ "alias", "args", "cmd", "filter", "forward", "method", "object", "setter", Index: tests/parameters.xotcl =================================================================== diff -u -r89fec6ccb2d935530a2ab141440ca343deda3338 -rd3aa8e069917e7ba7d69e936ec4e563b7e0dc34d --- tests/parameters.xotcl (.../parameters.xotcl) (revision 89fec6ccb2d935530a2ab141440ca343deda3338) +++ tests/parameters.xotcl (.../parameters.xotcl) (revision d3aa8e069917e7ba7d69e936ec4e563b7e0dc34d) @@ -26,12 +26,14 @@ ? {::xotcl::valuecheck integer 1} 1 ? {::xotcl::valuecheck integer,multivalued [list 1 2 3]} 1 ? {::xotcl::valuecheck integer,multivalued [list 1 2 3 a]} 0 -? {::xotcl::valuecheck in1 aaa} {invalid value constraints "in1"} ? {::xotcl::valuecheck object,type=::C c1} 1 ? {::xotcl::valuecheck object,type=::C o} 0 "object, but different type" ? {::xotcl::valuecheck object,type=::C c} 0 "no object" ? {::xotcl::valuecheck 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"} + # # parameter options # required @@ -62,6 +64,9 @@ # objectOfType YES YES NO NO YES YES YES # userdefined YES YES NO YES YES YES YES +# MetaSlot create ParameterSlot -parameter {type required multivalued noarg arg} + + ####################################################### # objectparameter ####################################################### @@ -369,17 +374,8 @@ ####################################################### Test case user-types -# -# create class and object for nonpositional argument processing -Class create ::xotcl::ParameterType -foreach cmd [info command ::xotcl::cmd::ParameterType::*] { - ::xotcl::alias ::xotcl::ParameterType [namespace tail $cmd] $cmd -} -# create an object for dispatching -::xotcl::ParameterType create ::xotcl::parameterType - # create a userdefined type -::xotcl::parameterType method type=mytype {name value args} { +::xotcl::parameterSlot method type=mytype {name value args} { if {$value < 1 || $value > 3} { error "Value '$value' of parameter $name is not between 1 and 3" } @@ -399,11 +395,11 @@ } ? {d1 foo 10} \ - "::xotcl::parameterType: unable to dispatch method 'type=unknowntype'" \ + "::xotcl::parameterSlot: unable to dispatch method 'type=unknowntype'" \ "missing type checker" # create a userdefined type with a simple argument -::xotcl::parameterType method type=in {name value arg} { +::xotcl::parameterSlot method type=in {name value arg} { if {$value ni [split $arg |]} { error "Value '$value' of parameter $name not in permissible values $arg" } @@ -428,7 +424,7 @@ "Value 'very good' of parameter b not in permissible values good|bad" \ "invalid value (not included)" -::xotcl::parameterType method type=range {name value arg} { +::xotcl::parameterSlot method type=range {name value arg} { foreach {min max} [split $arg -] break if {$value < $min || $value > $max} { error "Value '$value' of parameter $name not between $min and $max" @@ -453,7 +449,7 @@ # # handling of arg with spaces/arg as list # -::xotcl::parameterType method type=list {name value arg} { +::xotcl::parameterSlot method type=list {name value arg} { #puts $value/$arg } @@ -486,17 +482,17 @@ # are already predefined, define the rest. # TODO: should go finally to predefined. -::xotcl::parameterType method type=mixin {name value arg} { +::xotcl::parameterSlot method type=mixin {name value arg} { if {![::xotcl::is $value mixin $arg]} { error "Value '$value' of $name has not mixin $arg" } } -::xotcl::parameterType method type=baseclass {name value} { +::xotcl::parameterSlot method type=baseclass {name value} { if {![::xotcl::is $value baseclass]} { error "Value '$value' of $name is not a baseclass" } } -::xotcl::parameterType method type=metaclass {name value} { +::xotcl::parameterSlot method type=metaclass {name value} { if {![::xotcl::is $value metaclass]} { error "Value '$value' of $name is not a metaclass" }