Index: TODO =================================================================== diff -u -N -r7c10b8187153bffacc90607079a382f5ff98727d -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- TODO (.../TODO) (revision 7c10b8187153bffacc90607079a382f5ff98727d) +++ TODO (.../TODO) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -3252,8 +3252,12 @@ - library/mongodb:updated to current interface in git HEAD +-nsf.c: + * move to greedy assert to an inner scope ("info method ...") + * allow testwise "switch" as object parameter (when it is used, + accessors are deactivated for this attribute) + * extended regression test - TODO: - strange refcounting bug in 8.6b2 bug-is-86.tcl Index: generic/nsf.c =================================================================== diff -u -N -rad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98 -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- generic/nsf.c (.../nsf.c) (revision ad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98) +++ generic/nsf.c (.../nsf.c) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -10380,6 +10380,8 @@ "invalid parameter type \"switch\" for argument \"%s\"; " "type \"switch\" only allowed for non-positional arguments", paramPtr->name); + } else if (paramPtr->flags & NSF_ARG_METHOD_INVOCATION) { + return NsfPrintError(interp, "Parameter invocation types cannot be used with option 'switch'"); } result = ParamOptionSetConverter(interp, paramPtr, "switch", Nsf_ConvertToSwitch); paramPtr->flags |= NSF_ARG_SWITCH; @@ -10509,12 +10511,12 @@ if ((paramPtr->flags & NSF_ARG_METHOD_INVOCATION) && (paramPtr->flags & NSF_ARG_NOCONFIG)) { return NsfPrintError(interp, "Option 'noconfig' cannot used together with this type of object parameter"); } else if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) == (NSF_ARG_ALIAS|NSF_ARG_FORWARD)) { - return NsfPrintError(interp, "Parameter types 'alias' and 'forward' can be not used together"); + return NsfPrintError(interp, "Parameter types 'alias' and 'forward' cannot be used together"); } else if ((paramPtr->flags & (NSF_ARG_ALIAS|NSF_ARG_INITCMD)) == (NSF_ARG_ALIAS|NSF_ARG_INITCMD)) { - return NsfPrintError(interp, "Parameter types 'alias' and 'initcmd' can be not used together"); + return NsfPrintError(interp, "Parameter types 'alias' and 'initcmd' cannot be used together"); } else if ((paramPtr->flags & (NSF_ARG_FORWARD|NSF_ARG_INITCMD)) == (NSF_ARG_FORWARD|NSF_ARG_INITCMD)) { - return NsfPrintError(interp, "Parameter types 'forward' and 'initcmd' can be not used together"); - } + return NsfPrintError(interp, "Parameter types 'forward' and 'initcmd' cannot be used together"); + } return result; } @@ -15756,7 +15758,6 @@ CONST char *methodName, Tcl_Command cmd, int subcmd, int withPer_object) { - assert(methodName); Tcl_ResetResult(interp); if (!cmd) { @@ -15768,6 +15769,7 @@ int outputPerObject = 0; Tcl_Obj *resultObj; + assert(methodName); if (!NsfObjectIsClass(regObject)) { withPer_object = 1; /* don't output "object" modifier, if regObject is not a class */ @@ -19119,7 +19121,7 @@ result = CallMethod(class, interp, methodObj, 2, 0, NSF_CM_NO_PROTECT|NSF_CSC_IMMEDIATE); - if (result == TCL_OK) { + if (likely(result == TCL_OK)) { rawConfArgs = Tcl_GetObjResult(interp); /*fprintf(stderr, ".... rawConfArgs for %s => '%s'\n", ClassName(class), ObjStr(rawConfArgs));*/ @@ -19132,7 +19134,7 @@ result = ParamDefsParse(interp, procNameObj, rawConfArgs, NSF_DISALLOWED_ARG_OBJECT_PARAMETER, 1, parsedParamPtr); - if (result == TCL_OK) { + if (likely(result == TCL_OK)) { NsfParsedParam *ppDefPtr = NEW(NsfParsedParam); ppDefPtr->paramDefs = parsedParamPtr->paramDefs; ppDefPtr->possibleUnknowns = parsedParamPtr->possibleUnknowns; @@ -19332,33 +19334,23 @@ } /* - Uplevel awareness: - - The effective call site of the configure() method (e.g., a proc or a - method) can result from upleveling the object creation procedure; and, - thus, the *effective* call site can deviate from the *declaring* call - site (e.g. as in XOTcl2's unknown indirection). In such a scenario, the - configure() dispatch finds itself in a particular callstack - configuration: The top-most frame reflects the declaring call site - (interp->framePtr), while the effective call site (interp->varFramePtr) - is identified by a lower callstack level. In this case, the interp - signals two different call frame contexts at this point (interp->framePtr - != interp->varFramePtr). - - At the time of writing, the configure() method is to introduce one or - even two special-purpose frames: an object and a CSC/CMETHOD frame. By - pushing these two frames using the Tcl Callstack API, the interp state - concerning the call frame contexts is updated, effectively losing the - info about any preceding uplevel. This loss would result in misbehaviour - when crawling the callstack, with the callstack traversals taking the - current variable frame as starting point. - - Therefore, we record a) whether there was a preceding uplevel - (identifiable through deviating interp->framePtr and interp->varFramePtr) - and, in case, b) the ruling variable frame context. The preserved call - frame reference can later be used to restore the uplevel'ed call frame - context. + * The effective call site of the configure() method (e.g., a proc or a + * method) can result from upleveling the object creation procedure; + * therefore, the *effective* call site can deviate from the *declaring* + * call site (e.g. as in XOTcl2's unknown method). In such a scenario, the + * configure() dispatch finds itself in a particular callstack + * configuration: The top-most frame reflects the declaring call site + * (interp->framePtr), while the effective call site (interp->varFramePtr) + * is identified by a lower callstack level. + * + * Since configure pushes an object frame (for accessing the instance + * variables) and sometimes a CMETHOD frame (for method invocations) we + * record a) whether there was a preceding uplevel (identifiable through + * deviating interp->framePtr and interp->varFramePtr) and, in case, b) the + * ruling variable frame context. The preserved callframe reference can + * later be used to restore the uplevel'ed call frame context. */ + uplevelVarFramePtr = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp) != Tcl_Interp_framePtr(interp) ? Tcl_Interp_varFramePtr(interp) @@ -19398,10 +19390,10 @@ * avoid overwriting with default values when e.g. "o configure" * is called lated without arguments. */ - /*fprintf(stderr, "[%d] param %s, object init called %d is default %d value = '%s'\n", + /*fprintf(stderr, "[%d] param %s, object init called %d is default %d value = '%s' nrArgs %d\n", i, paramPtr->name, (object->flags & NSF_INIT_CALLED), (pc.flags[i-1] & NSF_PC_IS_DEFAULT), - ObjStr(pc.full_objv[i]));*/ + ObjStr(pc.full_objv[i]), paramPtr->nrArgs);*/ if ((object->flags & NSF_INIT_CALLED) && (pc.flags[i-1] & NSF_PC_IS_DEFAULT)) { Tcl_Obj *varObj; Index: generic/nsfInt.h =================================================================== diff -u -N -rd4f9e4f92fc05047b816dfbdccd7e1eed97b725a -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- generic/nsfInt.h (.../nsfInt.h) (revision d4f9e4f92fc05047b816dfbdccd7e1eed97b725a) +++ generic/nsfInt.h (.../nsfInt.h) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -427,7 +427,8 @@ /* Disallowed parameter options */ #define NSF_DISALLOWED_ARG_METHOD_PARAMETER (NSF_ARG_METHOD_INVOCATION|NSF_ARG_NOCONFIG) #define NSF_DISALLOWED_ARG_SETTER (NSF_ARG_SWITCH|NSF_ARG_SUBST_DEFAULT|NSF_DISALLOWED_ARG_METHOD_PARAMETER) -#define NSF_DISALLOWED_ARG_OBJECT_PARAMETER (NSF_ARG_SWITCH) +/*#define NSF_DISALLOWED_ARG_OBJECT_PARAMETER (NSF_ARG_SWITCH)*/ +#define NSF_DISALLOWED_ARG_OBJECT_PARAMETER 0 #define NSF_DISALLOWED_ARG_VALUECHECK (NSF_ARG_SUBST_DEFAULT|NSF_ARG_METHOD_INVOCATION|NSF_ARG_SWITCH|NSF_ARG_CURRENTLY_UNKNOWN) Index: library/nx/nx.tcl =================================================================== diff -u -N -rad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98 -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- library/nx/nx.tcl (.../nx.tcl) (revision ad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98) +++ library/nx/nx.tcl (.../nx.tcl) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -775,7 +775,8 @@ spec default:optional } { - set opts $defaultopts + array set opt $defaultopts + set opts "" set colonPos [string first : $spec] if {$colonPos == -1} { set name $spec @@ -790,7 +791,7 @@ } lappend opts -$property 1 } elseif {[string match accessor=* $property]} { - lappend opts -accessor [string range $property 9 end] + set opt(-accessor) [string range $property 9 end] } elseif {[string match type=* $property]} { set class [:requireClass ::nx::Attribute $class] set type [string range $property 5 end] @@ -815,9 +816,11 @@ } if {[info exists type]} { - if {$type eq "switch"} {error "switch is not allowed as type for object parameter $name"} + #if {$type eq "switch"} {error "switch is not allowed as type for object parameter $name"} + if {$type eq "switch"} {set opt(-accessor) false} lappend opts -type $type } + lappend opts {*}[array get opt] return [list $name $parameterOptions $class $opts] } @@ -1418,7 +1421,8 @@ lappend options [expr {[::nsf::is metaclass ${:type}] ? "class" : "object"}] type=${:type} } else { lappend options ${:type} - if {${:type} ni [list "" "boolean" "integer" "object" "class" \ + if {${:type} ni [list "" "switch" \ + "boolean" "integer" "object" "class" \ "metaclass" "baseclass" "parameter" \ "alnum" "alpha" "ascii" "control" "digit" "double" \ "false" "graph" "lower" "print" "punct" "space" "true" \ @@ -1469,6 +1473,7 @@ } ::nx::Attribute public method makeAccessor {} { + if {!${:accessor}} { #puts stderr "Do not register forwarder ${:domain} ${:name}" return 0 Index: tests/disposition.test =================================================================== diff -u -N -r9d0fec2bda60c9541c31cc726737129cec0d1350 -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- tests/disposition.test (.../disposition.test) (revision 9d0fec2bda60c9541c31cc726737129cec0d1350) +++ tests/disposition.test (.../disposition.test) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -273,7 +273,7 @@ array set script {alias "method=baz" forward "method=%self %method"} foreach disposition [list alias forward] { C setObjectParams [list [list -foo:$disposition,switch]] - ? {C new} "Parameter option 'switch' not allowed" \ + ? {C new} "Parameter invocation types cannot be used with option 'switch'" \ "switch not allowed for $disposition" C setObjectParams [list [list -baz:$disposition,mytype,$script($disposition)]] @@ -306,16 +306,16 @@ ? {C new} "Parameter option 'method=' only allowed for parameter types 'alias' and 'forward'" C setObjectParams [list [list -foo:alias,forward]] - ? {C new} "Parameter types 'alias' and 'forward' can be not used together" + ? {C new} "Parameter types 'alias' and 'forward' cannot be used together" C setObjectParams [list [list -foo:forward,alias]] - ? {C new} "Parameter types 'alias' and 'forward' can be not used together" + ? {C new} "Parameter types 'alias' and 'forward' cannot be used together" C setObjectParams [list [list -foo:alias,initcmd]] - ? {C new} "Parameter types 'alias' and 'initcmd' can be not used together" + ? {C new} "Parameter types 'alias' and 'initcmd' cannot be used together" C setObjectParams [list [list -foo:forward,initcmd]] - ? {C new} "Parameter types 'forward' and 'initcmd' can be not used together" + ? {C new} "Parameter types 'forward' and 'initcmd' cannot be used together" } nx::Test case dispo-multiplicities { Index: tests/parameters.test =================================================================== diff -u -N -rad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98 -r9ab7249b16aeb0ea906e3d614fee429edab1cfda --- tests/parameters.test (.../parameters.test) (revision ad4acf8e7b3c2279b4711aa9cfd5aed6d86e2b98) +++ tests/parameters.test (.../parameters.test) (revision 9ab7249b16aeb0ea906e3d614fee429edab1cfda) @@ -499,7 +499,7 @@ {d "literal $d"} } - ? {Bar attribute ss:switch} "switch is not allowed as type for object parameter ss" + ? {Bar attribute ss:switch} "" Bar create bar1 #puts stderr [bar1 objectparameter] @@ -2062,4 +2062,46 @@ # Both instance variables are unset ? {lsort [o info vars]} {} +} + +# +# Testing object parameter switch +# + +nx::Test case object-parameter-switch { + + ? {::nx::Class create C { + :attribute foo:switch + :create c1 + }} "::C" + + # when the parameter is not specified, the default is false, an + # instance variable is set + ? {lsort [c1 info vars]} {foo} + ? {c1 eval {set :foo}} {0} + + # when the parameter is specified, the instance variable has a value + # of true (i.e. 1) + C create c2 -foo + ? {lsort [c2 info vars]} {foo} + ? {c2 eval {set :foo}} {1} + + # One can pass false as well + C create c3 -foo=false + ? {lsort [c3 info vars]} {foo} + ? {c3 eval {set :foo}} {false} + + # The inverted case, + C attribute {foo2:switch true} + C create c4 + ? {lsort [c4 info vars]} {foo foo2} + ? {c4 eval {set :foo2}} {true} + C create c5 -foo2 + ? {lsort [c5 info vars]} {foo foo2} + ? {c5 eval {set :foo2}} {0} + + # Object case, not very useful, boolean would be perfectly fine. + ? {::nx::Object create o1 { + :variable bar:switch 0 + }} {invalid value constraints "switch"} } \ No newline at end of file