Index: TODO =================================================================== diff -u -ra0fcdf2a37c96ec3d240d52d8906c1cfd5ef4348 -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- TODO (.../TODO) (revision a0fcdf2a37c96ec3d240d52d8906c1cfd5ef4348) +++ TODO (.../TODO) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -5979,14 +5979,6 @@ in most cases. And we gain a more unified interface (stripping away one unique path to Param* machinery)? -- nsf::proc should also have a -returns option, right? - -% ::nsf::proc x -required argument 'arguments' is missing, should be: - ::nsf::proc ?-ad? ?-checkalways? ?-debug? ?-deprecated? /procName/ /arguments/ /body/ -% nsf::proc x {-a:integer} -returns alnum {;} -invalid argument 'alnum', maybe too many arguments; should be "nsf::proc ?-ad? ?-checkalways? ?-debug? ?-deprecated? /procName/ /arguments/ /body/" - - nsf::parseargs would need some more love: * what is the intended behavior, in these edge cases? Index: generic/nsf.c =================================================================== diff -u -r0756410503b3b64d5b057afbdc3acb14278ef379 -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- generic/nsf.c (.../nsf.c) (revision 0756410503b3b64d5b057afbdc3acb14278ef379) +++ generic/nsf.c (.../nsf.c) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -12855,7 +12855,49 @@ return resultObj; } +/*---------------------------------------------------------------------- + * ParamDefsSetReturns -- + * + * Set the "returns" value in a NsfProcContext. If the member is already + * in use, release the old value first. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +NSF_INLINE static void ParamDefsSetReturns( + Tcl_Command cmdPtr, Tcl_Obj *returnsObj +) nonnull(1); +NSF_INLINE static void +ParamDefsSetReturns(Tcl_Command cmd, Tcl_Obj *returnsObj) { + NsfProcContext *pCtx; + const char *valueString; + + nonnull_assert(cmd != NULL); + + pCtx = ProcContextRequire(cmd); + valueString = returnsObj != NULL ? Tcl_GetString(returnsObj) : NULL; + + if (pCtx->returnsObj != NULL) { + DECR_REF_COUNT2("returnsObj", pCtx->returnsObj); + } + if (valueString == NULL || *valueString == '\0') { + /* + * Set returnsObj to NULL + */ + pCtx->returnsObj = NULL; + } else { + pCtx->returnsObj = returnsObj; + INCR_REF_COUNT2("returnsObj", pCtx->returnsObj); + } +} + + /*---------------------------------------------------------------------- * NsfParamDefsNonposLookup -- * @@ -14088,6 +14130,7 @@ ProcDispatchFinalize(ClientData data[], Tcl_Interp *interp, int result) { ParseContext *pcPtr; Tcl_Time *ttPtr; + Tcl_Command wrapperCmd; nonnull_assert(data != NULL); nonnull_assert(interp != NULL); @@ -14097,7 +14140,33 @@ pcPtr = data[1]; ttPtr = data[2]; + assert(pcPtr != NULL); + /* + * Hacking alert: We have just 4 data arguments in Tcl_NRAddCallback for the + * finalize context. Since we do not want to allocate/manage additional + * structures for finalize data, and the pcPtr->object member is unused for + * nsfProcs, we reuse the pcPtr->object member for the wrapperCmd. + */ + + wrapperCmd = (Tcl_Command)pcPtr->object; + + if ((result == TCL_OK) && (Tcl_Command_cmdEpoch(wrapperCmd) == 0)) { + Tcl_Obj *returnsObj = ParamDefsGetReturns(wrapperCmd); + + if (returnsObj != NULL) { + Tcl_Obj *valueObj = Tcl_GetObjResult(interp); + NsfRuntimeState *rst = RUNTIME_STATE(interp); + + Tcl_IncrRefCount(returnsObj); + result = ParameterCheck(interp, returnsObj, valueObj, "return-value:", + rst->doCheckResults, NSF_FALSE, NSF_FALSE, NULL, + NULL); + Tcl_DecrRefCount(returnsObj); + } + } + + if (ttPtr != NULL) { const char *methodName = data[0]; unsigned int cmdFlags = (unsigned int)PTR2UINT(data[3]); @@ -16990,17 +17059,18 @@ nonnull_assert(clientData != NULL); /* - * Try to short_cut common cases to avoid conversion to bignums, since + * Short-cut common cases to avoid conversion to bignums, since * Tcl_GetBignumFromObj returns a value, which has to be freed. */ if (objPtr->typePtr == Nsf_OT_intType || objPtr->typePtr == Nsf_OT_bignumType) { /* * We know already that the value is an int */ result = TCL_OK; - } else if (objPtr->typePtr == Nsf_OT_doubleType) { + + } else if ((objPtr->typePtr == NULL && objPtr->length < 1) || (objPtr->typePtr == Nsf_OT_doubleType)) { /* - * We know already that the value is not an int + * We know that the value is not an integer */ result = TCL_ERROR; } else { @@ -17016,7 +17086,7 @@ /*if (objPtr->typePtr != NULL) { fprintf(stderr, "### type is on call %p %s value %s \n", - objPtr->typePtr, ObjTypeStr(objPtr), ObjStr(objPtr)); + (void*)objPtr->typePtr, ObjTypeStr(objPtr), ObjStr(objPtr)); }*/ if ((result = Tcl_GetLongFromObj(interp, objPtr, &longValue)) == TCL_OK) { @@ -19192,7 +19262,7 @@ fullMethodName = ObjStr(procNameObj); CheckCStack(interp, "nsfProc", fullMethodName); - /* fprintf(stderr, "=== InvokeShadowedProc %s objc %d\n", fullMethodName, objc); */ + /* fprintf(stderr, "=== InvokeShadowedProc %s objc %d cmd %p\n", fullMethodName, objc, (void*)cmd); */ /* * The code below is derived from the scripted method dispatch and just @@ -19210,7 +19280,9 @@ fullMethodName); } if (unlikely(result != TCL_OK)) { - /* todo: really? error msg? */ + /* + * The error message is assumed to be provided by the called cmd + */ return result; } @@ -19241,10 +19313,11 @@ ObjStr(objv[0]), fullMethodName, procNameObj, ObjStr(procNameObj)); */ Tcl_NRAddCallback(interp, ProcDispatchFinalize, - (ClientData)fullMethodName, pcPtr, + (ClientData)fullMethodName, + pcPtr, (ClientData)ttPtr, (ClientData)UINT2PTR(cmdFlags) - ); + ); result = TclNRInterpProcCore(interp, procNameObj, 1, &MakeProcError); #else { @@ -19381,9 +19454,18 @@ NsfDeprecatedCmd(interp, "proc", ObjStr(objv[0]), ""); } + /* + * Hacking alert: We have just 4 data arguments in Tcl_NRAddCallback for the + * finalize context. Since we do not want to allocate/manage additional + * structures for finalize data, and the pcPtr->object member is unused for + * nsfProcs, we reuse the pcPtr->object member for the wrapperCmd. + */ + pcPtr->object = (NsfObject *)tcd->wrapperCmd; + result = InvokeShadowedProc(interp, tcd->procName, tcd->cmd, pcPtr, &trt, cmdFlags, Tcl_Command_nsPtr(cmd)); + } else { /* * Result is already set to TCL_ERROR, the error message should be already @@ -19421,13 +19503,13 @@ *---------------------------------------------------------------------- */ static int NsfProcAdd(Tcl_Interp *interp, NsfParsedParam *parsedParamPtr, - const char *procName, Tcl_Obj *body, + const char *procName, Tcl_Obj *returnsObj, Tcl_Obj *body, int with_ad, int with_checkAlways, int with_Debug, int with_Deprecated) - nonnull(1) nonnull(2) nonnull(3) nonnull(4); + nonnull(1) nonnull(2) nonnull(3) nonnull(5); static int NsfProcAdd(Tcl_Interp *interp, NsfParsedParam *parsedParamPtr, - const char *procName, Tcl_Obj *body, + const char *procName, Tcl_Obj *returnsObj, Tcl_Obj *body, int with_ad, int with_checkAlways, int with_Debug, int with_Deprecated) { NsfParamDefs *paramDefs; NsfProcClientData *tcd; @@ -19482,6 +19564,10 @@ paramDefs = parsedParamPtr->paramDefs; ParamDefsStore(cmd, paramDefs, checkAlwaysFlag, NULL); + if (returnsObj != NULL) { + ParamDefsSetReturns(cmd, returnsObj); + } + /*fprintf(stderr, "NsfProcAdd procName '%s' define cmd '%s' %p in namespace %s\n", procName, Tcl_GetCommandName(interp, cmd), cmd, cmdNsPtr->fullName);*/ @@ -19521,7 +19607,7 @@ tcd->flags = (checkAlwaysFlag != 0u ? NSF_PROC_FLAG_CHECK_ALWAYS : 0u) | (with_ad != 0 ? NSF_PROC_FLAG_AD : 0u); tcd->cmd = NULL; tcd->wrapperCmd = cmd; /* TODO should we preserve? */ - tcd->interp = interp; /* for deleting the shadowed proc */ + tcd->interp = interp; /* For deleting the shadowed proc */ /*fprintf(stderr, "NsfProcAdd %s tcd %p paramdefs %p\n", ObjStr(procNameObj), tcd, tcd->paramDefs);*/ @@ -24506,6 +24592,7 @@ } } else { assert(objPtr == *outObjPtr); + if ((pPtr->flags & NSF_ARG_ALLOW_EMPTY) != 0u && *(ObjStr(objPtr)) == '\0') { result = Nsf_ConvertToString(interp, objPtr, pPtr, clientData, outObjPtr); } else { @@ -24515,7 +24602,7 @@ /*fprintf(stderr, "ArgumentCheck param %s type %s is converter %d flags %.6x " "outObj changed %d (%p %p) isok %d\n", pPtr->name, pPtr->type, pPtr->flags & NSF_ARG_IS_CONVERTER, pPtr->flags, - objPtr != *outObjPtr, objPtr, *outObjPtr, result == TCL_OK);*/ + objPtr != *outObjPtr, (void*)objPtr, (void*)*outObjPtr, result == TCL_OK);*/ if (unlikely((pPtr->flags & NSF_ARG_IS_CONVERTER) != 0u) && objPtr != *outObjPtr) { *flags |= NSF_PC_MUST_DECR; @@ -26325,6 +26412,9 @@ Tcl_DStringLength(dsPtr))); ListCmdParams(interp, cmd, NULL, NULL, Tcl_DStringValue(dsPtr), NSF_PARAMS_PARAMETER); Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp)); + + AppendReturnsClause(interp, resultObj, cmd); + ListProcBody(interp, tProcPtr); Tcl_ListObjAppendElement(interp, resultObj, Tcl_GetObjResult(interp)); Tcl_SetObjResult(interp, resultObj); @@ -29638,27 +29728,7 @@ /* * Set the value of "returns". */ - const char *valueString = ObjStr(valueObj); - - if (pCtx == NULL) { - pCtx = ProcContextRequire(cmd); - } - - /* - * Set a new value; if there is already a value, free it. - */ - if (pCtx->returnsObj != NULL) { - DECR_REF_COUNT2("returnsObj", pCtx->returnsObj); - } - if (*valueString == '\0') { - /* - * Set returnsObj to NULL - */ - pCtx->returnsObj = NULL; - } else { - pCtx->returnsObj = valueObj; - INCR_REF_COUNT2("returnsObj", pCtx->returnsObj); - } + ParamDefsSetReturns(cmd, valueObj); } } break; @@ -30706,12 +30776,13 @@ {-argName "-deprecated" -required 0 -nrargs 0 -type switch} {-argName "procName" -required 1 -type tclobj} {-argName "arguments" -required 1 -type tclobj} + {-argName "-returns" -required 0 -type tclobj} {-argName "body" -required 1 -type tclobj} } */ static int NsfProcCmd(Tcl_Interp *interp, int withAd, int withCheckalways, int withDebug, int withDeprecated, - Tcl_Obj *procNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *bodyObj) { + Tcl_Obj *procNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *returnsObj, Tcl_Obj *bodyObj) { NsfParsedParam parsedParam; int result; @@ -30731,13 +30802,17 @@ return result; } - if (parsedParam.paramDefs != NULL || withDebug != 0 || withDeprecated != 0) { + if (parsedParam.paramDefs != NULL + || withDebug != 0 + || withDeprecated != 0 + || returnsObj != NULL + ) { /* * We need parameter handling. In such cases, a thin C-based layer * is added which handles the parameter passing and calls the proc * later. */ - result = NsfProcAdd(interp, &parsedParam, ObjStr(procNameObj), bodyObj, + result = NsfProcAdd(interp, &parsedParam, ObjStr(procNameObj), returnsObj, bodyObj, withAd, withCheckalways, withDebug, withDeprecated); } else { @@ -31893,10 +31968,11 @@ * doCheckArguments is true. This function is used e.g. by nsf::is, * where only the right-hand side of a parameter specification * (after the colon) is specified. The argument Name (before the - * colon in a parameter spec) is provided via argNamePrefix. The - * converted parameter structure is returned optionally via the - * last argument. + * colon in a parameter spec) is provided via argNamePrefix. * + * The converted parameter structure is returned optionally via the last + * argument. + * * Results: * A standard Tcl result and parsed structure in last argument. * @@ -31924,8 +32000,8 @@ nonnull_assert(paramObjPtr != NULL); nonnull_assert(valueObj != NULL); - /* fprintf(stderr, "ParameterCheck %s value %p %s\n", - ObjStr(paramObjPtr), valueObj, ObjStr(valueObj)); */ + /*fprintf(stderr, "ParameterCheck %s value %p %s refCount %d\n", + ObjStr(paramObjPtr), (void*)valueObj, ObjStr(valueObj), valueObj->refCount); */ if (paramObjPtr->typePtr == ¶mObjType) { paramWrapperPtr = (NsfParamWrapper *) paramObjPtr->internalRep.twoPtrValue.ptr1; Index: generic/nsfAPI.decls =================================================================== diff -u -rb2781b9db53d2d06c1c82a62d8f4140b461ec47e -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision b2781b9db53d2d06c1c82a62d8f4140b461ec47e) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -301,6 +301,7 @@ {-argName "-deprecated" -required 0 -nrargs 0 -type switch} {-argName "procName" -required 1 -type tclobj} {-argName "arguments" -required 1 -type tclobj} + {-argName "-returns" -required 0 -type tclobj} {-argName "body" -required 1 -type tclobj} } {-nxdoc 1} Index: generic/nsfAPI.h =================================================================== diff -u -rb2781b9db53d2d06c1c82a62d8f4140b461ec47e -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- generic/nsfAPI.h (.../nsfAPI.h) (revision b2781b9db53d2d06c1c82a62d8f4140b461ec47e) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -793,8 +793,8 @@ NSF_nonnull(1) NSF_nonnull(4); static int NsfParseArgsCmd(Tcl_Interp *interp, int withAsdict, Tcl_Obj *argspecObj, Tcl_Obj *arglistObj) NSF_nonnull(1) NSF_nonnull(3) NSF_nonnull(4); -static int NsfProcCmd(Tcl_Interp *interp, int withAd, int withCheckalways, int withDebug, int withDeprecated, Tcl_Obj *procNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *bodyObj) - NSF_nonnull(1) NSF_nonnull(6) NSF_nonnull(7) NSF_nonnull(8); +static int NsfProcCmd(Tcl_Interp *interp, int withAd, int withCheckalways, int withDebug, int withDeprecated, Tcl_Obj *procNameObj, Tcl_Obj *argumentsObj, Tcl_Obj *returnsObj, Tcl_Obj *bodyObj) + NSF_nonnull(1) NSF_nonnull(6) NSF_nonnull(7) NSF_nonnull(9); static int NsfProfileClearDataStub(Tcl_Interp *interp) NSF_nonnull(1); static int NsfProfileGetDataStub(Tcl_Interp *interp) @@ -2616,10 +2616,11 @@ int withDeprecated = (int )PTR2INT(pc.clientData[3]); Tcl_Obj *procNameObj = (Tcl_Obj *)pc.clientData[4]; Tcl_Obj *argumentsObj = (Tcl_Obj *)pc.clientData[5]; - Tcl_Obj *bodyObj = (Tcl_Obj *)pc.clientData[6]; + Tcl_Obj *returnsObj = (Tcl_Obj *)pc.clientData[6]; + Tcl_Obj *bodyObj = (Tcl_Obj *)pc.clientData[7]; assert(pc.status == 0); - return NsfProcCmd(interp, withAd, withCheckalways, withDebug, withDeprecated, procNameObj, argumentsObj, bodyObj); + return NsfProcCmd(interp, withAd, withCheckalways, withDebug, withDeprecated, procNameObj, argumentsObj, returnsObj, bodyObj); } else { @@ -4177,13 +4178,14 @@ {"argspec", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"arglist", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::proc", NsfProcCmdStub, 7, { +{"::nsf::proc", NsfProcCmdStub, 8, { {"-ad", 0, 0, Nsf_ConvertTo_Boolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-checkalways", 0, 0, Nsf_ConvertTo_Boolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-debug", 0, 0, Nsf_ConvertTo_Boolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-deprecated", 0, 0, Nsf_ConvertTo_Boolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"procName", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"arguments", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, + {"-returns", 0, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"body", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, {"::nsf::__profile_clear", NsfProfileClearDataStubStub, 0, { Index: tests/nsf-cmd.test =================================================================== diff -u -r982b1e8d84f71b36961ba034754f2e35e1ddb869 -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- tests/nsf-cmd.test (.../nsf-cmd.test) (revision 982b1e8d84f71b36961ba034754f2e35e1ddb869) +++ tests/nsf-cmd.test (.../nsf-cmd.test) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -158,7 +158,7 @@ ? {bar a b} "a-b" # - # redefine bar with debug flag + # redefine "bar" with debug flag # nsf::proc -debug bar {a b} {return $a-$b} set ::handle ::bar @@ -181,27 +181,26 @@ ? {bar a b} "a-b" # - # Define a proc with zero arguments + # redefine "foo" with "-returns" checker. # - nsf::proc -debug zero {} {return 333} - set ::handle ::zero + nsf::proc ::foo {{-x 1} y:optional} -returns integer {return $y} - ? {nsf::cmd::info args $::handle} "" - ? {nsf::cmd::info body $::handle} {return 333} - ? {nsf::cmd::info definition $::handle} {::nsf::proc -debug ::zero {} {return 333}} + set ::handle ::foo + + ? {nsf::cmd::info args $::handle} "x y" + ? {nsf::cmd::info body $::handle} {return $y} + ? {nsf::cmd::info definition $::handle} {::nsf::proc ::foo {{-x 1} y:optional} -returns integer {return $y}} ? {nsf::cmd::info exists $::handle} 1 ? {nsf::cmd::info registrationhandle $::handle} "" ? {nsf::cmd::info definitionhandle $::handle} "" ? {nsf::cmd::info origin $::handle} "" - ? {nsf::cmd::info parameter $::handle} "" - ? {nsf::cmd::info syntax $::handle} {} + ? {nsf::cmd::info parameter $::handle} "{-x 1} y:optional" + ? {nsf::cmd::info syntax $::handle} {?-x /value/? ?/y/?} ? {nsf::cmd::info type $::handle} "nsfproc" ? {nsf::cmd::info precondition $::handle} "" ? {nsf::cmd::info postcondition $::handle} "" ? {nsf::cmd::info submethods $::handle} "" - ? {nsf::cmd::info returns $::handle} "" - ? {nsf::method::property ::nx::Object $handle debug 1} 1 - ? {zero} "333" + ? {nsf::cmd::info returns $::handle} "integer" # # A Tcl cmd implemented in C @@ -293,7 +292,7 @@ {expected object but got "::TestMe" for parameter "object"} nx::Class create ::TestMe - + ? {::nsf::method::property ::TestMe -per-object missing call-protected true} \ {cannot lookup object method 'missing' for ::TestMe} ? {::nsf::method::property ::TestMe missing call-protected true} \ @@ -526,7 +525,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + nsf::proc ::ns1::foo { {-x:required} } { return 1-$x } @@ -549,7 +548,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + namespace eval ::ns1 {} } @@ -559,47 +558,47 @@ ? {info commands ::nsf::procs::ns1::foo} "" ? {info procs ::ns1::foo} "" ? {info procs ::nsf::procs::ns1::foo} "" - + if {${::tcl86}} { ? {::ns1::foo -x ok} {TCL LOOKUP COMMAND ::ns1::foo} {invalid command name "::ns1::foo"} } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + nsf::proc ::ns1::foo { {-x:required} } { return 1-$x } ? {info commands ::ns1::foo} "::ns1::foo" ? {info commands ::nsf::procs::ns1::foo} "::nsf::procs::ns1::foo" ? {info procs ::ns1::foo} "" ? {info procs ::nsf::procs::ns1::foo} "::nsf::procs::ns1::foo" - + ? {::ns1::foo -x ok} "1-ok" - + namespace delete ::ns1 - + ? {info commands ::ns1::foo} "" ? {info commands ::nsf::procs::ns1::foo} "" ? {info procs ::ns1::foo} "" ? {info procs ::nsf::procs::ns1::foo} "" - + if {${::tcl86}} { ? {::ns1::foo -x ok} {TCL LOOKUP COMMAND ::ns1::foo} {invalid command name "::ns1::foo"} } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + } nx::test case nsf-proc-rename-redefine { namespace eval ::ns1 {} - + nsf::proc ns1::foo { {-x:required} } { return 1-$x } ? {ns1::foo -x ok} 1-ok - + rename ns1::foo ns1::foo.orig nsf::proc ns1::foo { @@ -613,13 +612,13 @@ nx::test case nsf-proc-rename-redefine-call { namespace eval ::ns1 {} - + nsf::proc ns1::foo { {-x:required} } { return 1-$x } ? {ns1::foo -x ok} 1-ok - + rename ns1::foo ns1::foo.orig nsf::proc ns1::foo { @@ -645,7 +644,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + nsf::proc ::ns1::foo { {-x:required} } { return 1-$x } @@ -677,7 +676,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + namespace eval ::ns1 {} } @@ -693,7 +692,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + nsf::proc ::ns1::foo { {-x:required} } { return 1-$x } @@ -711,7 +710,7 @@ ? {info commands ::nsf::procs::ns1::foo} "::nsf::procs::ns1::foo" ? {info procs ::ns1::foo} "" ? {info procs ::nsf::procs::ns1::foo} "" - + ? {::ns1::foo -x ok} \ {command '::nsf::procs::ns1::foo' is not a proc} @@ -728,7 +727,7 @@ } else { ? {::ns1::foo -x ok} {invalid command name "::ns1::foo"} } - + namespace eval ::ns1 {} rename ::nsf::procs::ns1::foo "" } @@ -737,12 +736,12 @@ namespace eval ::ns1 {} ? {info commands ::ns1::foo} "" ? {info commands ::nsf::procs::ns1::foo} "" - + proc ::nsf::procs::ns1::foo {x} { return 0-$x} ? {info commands ::ns1::foo} "" ? {info commands ::nsf::procs::ns1::foo} "::nsf::procs::ns1::foo" - + ? {nsf::proc ::ns1::foo { {-x:required} } { return 1-$x }} "" @@ -756,12 +755,12 @@ namespace eval ::ns1 {} ? {info commands ::ns1::foo} "" ? {info commands ::nsf::procs::ns1::foo} "" - + proc ::nsf::procs::ns1::foo.orig {x} { return 0-$x} ? {info commands ::ns1::foo.orig} "" ? {info commands ::nsf::procs::ns1::foo.orig} "::nsf::procs::ns1::foo.orig" - + ? {nsf::proc ::ns1::foo { {-x:required} } { return 1-$x }} "" @@ -773,8 +772,8 @@ } else { ? {rename ns1::foo ns1::foo.orig} {can't rename to "::nsf::procs::ns1::foo.orig": command already exists} } - + namespace delete ::ns1 } Index: tests/returns.test =================================================================== diff -u -r0756410503b3b64d5b057afbdc3acb14278ef379 -rb44ba341aa4dc2d759201f6413dc2ef36eba555d --- tests/returns.test (.../returns.test) (revision 0756410503b3b64d5b057afbdc3acb14278ef379) +++ tests/returns.test (.../returns.test) (revision b44ba341aa4dc2d759201f6413dc2ef36eba555d) @@ -357,8 +357,8 @@ } -::nx::test case int-returns-string-checks { - ::nx::Class create TestOK { +::nx::test case returns-string-checks { + ::nx::Class create C { # # strings test with "string is alpha" checker # @@ -385,6 +385,38 @@ ? {a get6} {expected integer but got "a" as return value} ? {a get7} {1 2 3} ? {a get8} {invalid value in "1 2 a": expected integer but got "a" as return value} + + + nsf::proc ::foo1 {-a:integer} {return ok} + ? ::foo1 "ok" + + nsf::proc ::foo2 {-a:integer} -returns integer {return ok} + ? ::foo2 {expected integer but got "ok" as return value} + + nsf::proc ::foo2b {-a:integer} -returns boolean {return ok} + ? ::foo2b {expected boolean but got "ok" as return value} + + nsf::proc ::foo3 {-a:integer} -returns integer {return 1} + ? ::foo3 1 + + nsf::proc ::foo4 {-a:integer} -returns alpha {return 1} + ? ::foo4 {expected alpha but got "1" as return value} + + nsf::proc ::foo5 {-a:integer} -returns alpha {return abc} + ? ::foo5 abc + + nsf::proc ::foo6 {-a:integer} -returns alpha,1..n {return {a b c}} + ? ::foo6 {a b c} + + nsf::proc ::foo7 {-a:integer} -returns alpha,1..n {return {a 2 c}} + ? ::foo7 {invalid value in "a 2 c": expected alpha but got "2" as return value} + + nsf::proc ::foo8 {-a:integer} -returns integer,1..n {return {1 2}} + ? ::foo8 {1 2} + + nsf::proc ::foo9 {-a:integer} -returns integer,1..n {return {a 2 c}} + ? ::foo9 {invalid value in "a 2 c": expected integer but got "a" as return value} + }