Index: generic/asm/nsfAssemble.c =================================================================== diff -u -N -r1c21a6f9ab7fe20490ba256cb8cf3759b8498838 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- generic/asm/nsfAssemble.c (.../nsfAssemble.c) (revision 1c21a6f9ab7fe20490ba256cb8cf3759b8498838) +++ generic/asm/nsfAssemble.c (.../nsfAssemble.c) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -435,6 +435,7 @@ /* cmd method::asmcreate NsfAsmMethodCreateCmd { {-argName "object" -required 1 -type object} + {-argName "-checkalways" -required 0 -nrargs 0 -type switch} {-argName "-inner-namespace" -nrargs 0} {-argName "-per-object" -nrargs 0} {-argName "-reg-object" -required 0 -nrargs 1 -type object} @@ -456,7 +457,11 @@ (withPer_object || ! NsfObjectIsClass(defObject)) ? NULL : (NsfClass *)defObject; - // not handled: withInner_namespace, regObject, no pre and post-conditions + // not handled: + // * withInner_namespace, + // * regObject, + // * pre and post-conditions + // * withCheckAlways ? NSF_ARGPARSE_CHECK : 0 if (cl == 0) { RequireObjNamespace(interp, defObject); Index: generic/nsf.c =================================================================== diff -u -N -r3a9753e7ced44933ede02881fc6bb47cf36b559b -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- generic/nsf.c (.../nsf.c) (revision 3a9753e7ced44933ede02881fc6bb47cf36b559b) +++ generic/nsf.c (.../nsf.c) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -98,6 +98,7 @@ ClientData oldDeleteData; Tcl_CmdDeleteProc *oldDeleteProc; NsfParamDefs *paramDefs; + int checkAlwaysFlag; } NsfProcContext; /* @@ -8798,12 +8799,33 @@ FREE(Nsf_Param*, paramsPtr); } +/*---------------------------------------------------------------------- + * ParamDefsGet -- + * + * Obtain parameter definitions for a cmdPtr; Optionally, this command + * returns as well a flag for ProcessMethodArguments to indicate if the + * parameter have to checked always. + * + * Results: + * Parameter definitions or NULL + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ NSF_INLINE static NsfParamDefs * -ParamDefsGet(Tcl_Command cmdPtr) { +ParamDefsGet(Tcl_Command cmdPtr, int *checkAlwaysFlagPtr) { + assert(cmdPtr); + if (likely(Tcl_Command_deleteProc(cmdPtr) == NsfProcDeleteProc)) { - return ((NsfProcContext *)Tcl_Command_deleteData(cmdPtr))->paramDefs; + NsfProcContext *ctx = (NsfProcContext *)Tcl_Command_deleteData(cmdPtr); + + if (checkAlwaysFlagPtr) { *checkAlwaysFlagPtr = ctx->checkAlwaysFlag;} + return ctx->paramDefs; } + return NULL; } @@ -8853,7 +8875,7 @@ *---------------------------------------------------------------------- */ static int -ParamDefsStore(Tcl_Command cmd, NsfParamDefs *paramDefs) { +ParamDefsStore(Tcl_Command cmd, NsfParamDefs *paramDefs, int checkAlwaysFlag) { Command *cmdPtr = (Command *)cmd; if (cmdPtr->deleteProc != NsfProcDeleteProc) { @@ -8862,18 +8884,20 @@ /*fprintf(stderr, "ParamDefsStore %p replace deleteProc %p by %p\n", paramDefs, cmdPtr->deleteProc, NsfProcDeleteProc);*/ - ctxPtr->oldDeleteData = (Proc *)cmdPtr->deleteData; - ctxPtr->oldDeleteProc = cmdPtr->deleteProc; - cmdPtr->deleteProc = NsfProcDeleteProc; - ctxPtr->paramDefs = paramDefs; - cmdPtr->deleteData = ctxPtr; + ctxPtr->oldDeleteData = (Proc *)cmdPtr->deleteData; + ctxPtr->oldDeleteProc = cmdPtr->deleteProc; + cmdPtr->deleteProc = NsfProcDeleteProc; + ctxPtr->paramDefs = paramDefs; + ctxPtr->checkAlwaysFlag = checkAlwaysFlag; + cmdPtr->deleteData = ctxPtr; return TCL_OK; } else { /*fprintf(stderr, "ParamDefsStore cmd %p has already NsfProcDeleteProc deleteData %p\n", cmd, cmdPtr->deleteData);*/ if (cmdPtr->deleteData) { NsfProcContext *ctxPtr = cmdPtr->deleteData; + assert(ctxPtr->paramDefs == NULL); ctxPtr->paramDefs = paramDefs; } @@ -9493,7 +9517,7 @@ ProcMethodDispatch(ClientData cp, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *methodName, NsfObject *object, NsfClass *cl, Tcl_Command cmdPtr, NsfCallStackContent *cscPtr) { - int result, releasePc = 0; + int result, releasePc = 0, checkAlwaysFlag = 0; NsfParamDefs *paramDefs; #if defined(NSF_WITH_ASSERTIONS) NsfObjectOpt *opt = object->opt; @@ -9575,14 +9599,14 @@ * argument parser with the argument definitions obtained from the * proc context from the cmdPtr. */ - paramDefs = ParamDefsGet(cmdPtr); + paramDefs = ParamDefsGet(cmdPtr, &checkAlwaysFlag); if (paramDefs && paramDefs->paramsPtr) { #if defined(NRE) pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext), "parse context"); #endif result = ProcessMethodArguments(pcPtr, interp, object, - NSF_ARGPARSE_METHOD_PUSH|NSF_ARGPARSE_FORCE_REQUIRED, + checkAlwaysFlag|NSF_ARGPARSE_METHOD_PUSH|NSF_ARGPARSE_FORCE_REQUIRED, paramDefs, objv[0], objc, objv); cscPtr->objc = objc; cscPtr->objv = (Tcl_Obj **)objv; @@ -10322,7 +10346,7 @@ * Check the return value if wanted */ if (likely(result == TCL_OK && cscPtr->cmdPtr && Tcl_Command_cmdEpoch(cscPtr->cmdPtr) == 0)) { - NsfParamDefs *paramDefs = ParamDefsGet(cscPtr->cmdPtr); + NsfParamDefs *paramDefs = ParamDefsGet(cscPtr->cmdPtr, NULL); if (paramDefs && paramDefs->returns) { Tcl_Obj *valueObj = Tcl_GetObjResult(interp); @@ -12821,7 +12845,7 @@ MakeProc(Tcl_Namespace *nsPtr, NsfAssertionStore *aStore, Tcl_Interp *interp, Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition, NsfObject *defObject, NsfObject *regObject, - int withPer_object, int withInner_namespace) { + int withPer_object, int withInner_namespace, int checkAlwaysFlag) { Tcl_CallFrame frame, *framePtr = &frame; CONST char *methodName = ObjStr(nameObj); NsfParsedParam parsedParam; @@ -12894,7 +12918,7 @@ procPtr->cmdPtr->nsPtr = ((Command *)regObject->id)->nsPtr; } - ParamDefsStore((Tcl_Command)procPtr->cmdPtr, parsedParam.paramDefs); + ParamDefsStore((Tcl_Command)procPtr->cmdPtr, parsedParam.paramDefs, checkAlwaysFlag); Tcl_SetObjResult(interp, MethodHandleObj(defObject, withPer_object, methodName)); result = TCL_OK; } @@ -12919,7 +12943,7 @@ MakeMethod(Tcl_Interp *interp, NsfObject *defObject, NsfObject *regObject, NsfClass *cl, Tcl_Obj *nameObj, Tcl_Obj *args, Tcl_Obj *body, Tcl_Obj *precondition, Tcl_Obj *postcondition, - int withInner_namespace) { + int withInner_namespace, int checkAlwaysFlag) { CONST char *argsStr = ObjStr(args), *bodyStr = ObjStr(body), *nameStr = ObjStr(nameObj); int result; @@ -12966,7 +12990,8 @@ } result = MakeProc(cl ? cl->nsPtr : defObject->nsPtr, aStore, interp, nameObj, args, body, precondition, postcondition, - defObject, regObject, cl == NULL, withInner_namespace); + defObject, regObject, cl == NULL, withInner_namespace, + checkAlwaysFlag); #else if (precondition) { NsfLog(interp, NSF_LOG_WARN, "Precondition %s provided, but not compiled with assertion enabled", @@ -12977,7 +13002,8 @@ } result = MakeProc(cl ? cl->nsPtr : defObject->nsPtr, NULL, interp, nameObj, args, body, NULL, NULL, - defObject, regObject, cl == NULL, withInner_namespace); + defObject, regObject, cl == NULL, withInner_namespace, + checkAlwaysFlag); #endif } @@ -13193,7 +13219,7 @@ /* If the argument parsing is ok, the shadowed proc will be called */ result = ProcessMethodArguments(pcPtr, interp, NULL, - tcd->with_checkAlways|NSF_ARGPARSE_FORCE_REQUIRED, + tcd->checkAlwaysFlag|NSF_ARGPARSE_FORCE_REQUIRED, tcd->paramDefs, objv[0], objc, tov); @@ -13246,14 +13272,12 @@ CONST char *procName, Tcl_Obj *body, int with_ad, int with_checkAlways) { NsfParamDefs *paramDefs = parsedParamPtr->paramDefs; - Tcl_Namespace *cmdNsPtr; + Nsf_Param *paramPtr; NsfProcClientData *tcd; - Tcl_Obj *argList; - Tcl_Obj *procNameObj; + Tcl_Namespace *cmdNsPtr; + Tcl_Obj *argList, *procNameObj, *ov[4]; Tcl_DString ds, *dsPtr = &ds; - Nsf_Param *paramPtr; - Tcl_Obj *ov[4]; - int result; + int result, checkAlwaysFlag; Tcl_Command cmd; Tcl_DStringInit(dsPtr); @@ -13282,8 +13306,16 @@ return TCL_ERROR; } + checkAlwaysFlag = with_checkAlways ? NSF_ARGPARSE_CHECK : 0; + cmdNsPtr = Tcl_Command_nsPtr(cmd); - ParamDefsStore(cmd, paramDefs); + + /* + * Storing param defs is actually not needed to be stored, since the stub + * receives paramters + flag via client data... but it is needed for + * introspection. + */ + ParamDefsStore(cmd, paramDefs, checkAlwaysFlag); /*fprintf(stderr, "NsfProcAdd procName '%s' define cmd '%s' %p in namespace %s\n", procName, Tcl_GetCommandName(interp, cmd), cmd, cmdNsPtr->fullName);*/ @@ -13319,7 +13351,7 @@ tcd->procName = procNameObj; tcd->paramDefs = paramDefs; tcd->with_ad = with_ad; - tcd->with_checkAlways = with_checkAlways ? NSF_ARGPARSE_CHECK : 0; + tcd->checkAlwaysFlag = checkAlwaysFlag; tcd->cmd = NULL; /*fprintf(stderr, "NsfProcAdd %s tcd %p paramdefs %p\n", @@ -17663,7 +17695,7 @@ assert(methodName); assert(cmd); - paramDefs = ParamDefsGet(cmd); + paramDefs = ParamDefsGet(cmd, NULL); if (paramDefs && paramDefs->paramsPtr) { /* @@ -17877,7 +17909,7 @@ AppendReturnsClause(Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Command cmd) { NsfParamDefs *paramDefs; - paramDefs = ParamDefsGet(cmd); + paramDefs = ParamDefsGet(cmd, NULL); if (paramDefs && paramDefs->returns) { /* TODO: avoid hard-coding the script-level/NX-specific keyword "returns" */ Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj("-returns", -1)); @@ -17946,7 +17978,7 @@ NsfParamDefs *paramDefs; importedCmd = GetOriginalCommand(cmd); - paramDefs = ParamDefsGet(importedCmd); + paramDefs = ParamDefsGet(importedCmd, NULL); if (paramDefs && paramDefs->returns) { Tcl_SetObjResult(interp, paramDefs->returns); } @@ -18998,8 +19030,12 @@ #else static int NsfAsmMethodCreateCmd(Tcl_Interp *interp, NsfObject *defObject, - int withInner_namespace, int withPer_object, NsfObject *regObject, + int with_checkAlways, int withInner_namespace, + int withPer_object, NsfObject *regObject, Tcl_Obj *nameObj, Tcl_Obj *argumentsObj, Tcl_Obj *bodyObj) { + /* + * Dummy stub; used, when compiled without NSF_ASSEMBLE + */ return TCL_OK; } #endif @@ -20029,6 +20065,7 @@ /* cmd method::create NsfMethodCreateCmd { {-argName "object" -required 1 -type object} + {-argName "-checkalways" -required 0 -nrargs 0 -type switch} {-argName "-inner-namespace"} {-argName "-per-object"} {-argName "-reg-object" -required 0 -nrargs 1 -type object} @@ -20041,9 +20078,10 @@ */ static int NsfMethodCreateCmd(Tcl_Interp *interp, NsfObject *defObject, - int withInner_namespace, int withPer_object, NsfObject *regObject, - Tcl_Obj *nameObj, Tcl_Obj *arguments, Tcl_Obj *body, - Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { + int withCheckAlways, int withInner_namespace, + int withPer_object, NsfObject *regObject, + Tcl_Obj *nameObj, Tcl_Obj *arguments, Tcl_Obj *body, + Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition) { NsfClass *cl = (withPer_object || ! NsfObjectIsClass(defObject)) ? NULL : (NsfClass *)defObject; @@ -20054,7 +20092,7 @@ return MakeMethod(interp, defObject, regObject, cl, nameObj, arguments, body, withPrecondition, withPostcondition, - withInner_namespace); + withInner_namespace, withCheckAlways ? NSF_ARGPARSE_CHECK : 0); } /* @@ -20271,7 +20309,7 @@ methodName); } - paramDefs = ParamDefsGet(cmd); + paramDefs = ParamDefsGet(cmd, NULL); /*fprintf(stderr, "MethodProperty, ParamDefsGet cmd %p paramDefs %p returns %p\n", cmd, paramDefs, paramDefs?paramDefs->returns:NULL);*/ @@ -20294,7 +20332,7 @@ if (paramDefs == NULL) { /* acquire new paramDefs */ paramDefs = ParamDefsNew(); - ParamDefsStore(cmd, paramDefs); + ParamDefsStore(cmd, paramDefs, 0); /*fprintf(stderr, "new param definitions %p for cmd %p %s\n", paramDefs, cmd, methodName);*/ } objPtr = Index: generic/nsfAPI.decls =================================================================== diff -u -N -r1c21a6f9ab7fe20490ba256cb8cf3759b8498838 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 1c21a6f9ab7fe20490ba256cb8cf3759b8498838) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -113,6 +113,7 @@ } {-nxdoc 1} cmd "method::create" NsfMethodCreateCmd { {-argName "object" -required 1 -type object} + {-argName "-checkalways" -required 0 -nrargs 0 -type switch} {-argName "-inner-namespace" -nrargs 0} {-argName "-per-object" -required 0 -nrargs 0 -type switch} {-argName "-reg-object" -required 0 -type object} @@ -125,6 +126,7 @@ cmd method::asmcreate NsfAsmMethodCreateCmd { {-argName "object" -required 1 -type object} + {-argName "-checkalways" -required 0 -nrargs 0 -type switch} {-argName "-inner-namespace" -nrargs 0} {-argName "-per-object" -required 0 -nrargs 0 -type switch} {-argName "-reg-object" -required 0 -nrargs 1 -type object} Index: generic/nsfAPI.h =================================================================== diff -u -N -r1c21a6f9ab7fe20490ba256cb8cf3759b8498838 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- generic/nsfAPI.h (.../nsfAPI.h) (revision 1c21a6f9ab7fe20490ba256cb8cf3759b8498838) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -371,7 +371,7 @@ static int NsfClassInfoSlotobjectsMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, int withSource, NsfClass *withType, CONST char *pattern); static int NsfClassInfoSubclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, CONST char *patternString, NsfObject *patternObject); static int NsfClassInfoSuperclassMethod(Tcl_Interp *interp, NsfClass *cl, int withClosure, Tcl_Obj *pattern); -static int NsfAsmMethodCreateCmd(Tcl_Interp *interp, NsfObject *object, int withInner_namespace, int withPer_object, NsfObject *withReg_object, Tcl_Obj *name, Tcl_Obj *arguments, Tcl_Obj *body); +static int NsfAsmMethodCreateCmd(Tcl_Interp *interp, NsfObject *object, int withCheckalways, int withInner_namespace, int withPer_object, NsfObject *withReg_object, Tcl_Obj *name, Tcl_Obj *arguments, Tcl_Obj *body); static int NsfAsmProcCmd(Tcl_Interp *interp, int withAd, int withCheckalways, Tcl_Obj *procName, Tcl_Obj *arguments, Tcl_Obj *body); static int NsfColonCmd(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int NsfConfigureCmd(Tcl_Interp *interp, int option, Tcl_Obj *value); @@ -386,7 +386,7 @@ static int NsfIsCmd(Tcl_Interp *interp, int withComplain, int withConfigure, CONST char *withName, Tcl_Obj *constraint, Tcl_Obj *value); static int NsfMethodAliasCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, CONST char *methodName, int withFrame, Tcl_Obj *cmdName); static int NsfMethodAssertionCmd(Tcl_Interp *interp, NsfObject *object, int subcmd, Tcl_Obj *arg); -static int NsfMethodCreateCmd(Tcl_Interp *interp, NsfObject *object, int withInner_namespace, int withPer_object, NsfObject *withReg_object, Tcl_Obj *methodName, Tcl_Obj *arguments, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); +static int NsfMethodCreateCmd(Tcl_Interp *interp, NsfObject *object, int withCheckalways, int withInner_namespace, int withPer_object, NsfObject *withReg_object, Tcl_Obj *methodName, Tcl_Obj *arguments, Tcl_Obj *body, Tcl_Obj *withPrecondition, Tcl_Obj *withPostcondition); static int NsfMethodDeleteCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *methodName); static int NsfMethodForwardCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *method, Tcl_Obj *withDefault, int withEarlybinding, Tcl_Obj *withMethodprefix, int withObjframe, Tcl_Obj *withOnerror, int withVerbose, Tcl_Obj *target, int nobjc, Tcl_Obj *CONST nobjv[]); static int NsfMethodPropertyCmd(Tcl_Interp *interp, NsfObject *object, int withPer_object, Tcl_Obj *methodName, int methodProperty, Tcl_Obj *value); @@ -1077,15 +1077,16 @@ method_definitions[NsfAsmMethodCreateCmdIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, &pc) == TCL_OK)) { NsfObject *object = (NsfObject *)pc.clientData[0]; - int withInner_namespace = (int )PTR2INT(pc.clientData[1]); - int withPer_object = (int )PTR2INT(pc.clientData[2]); - NsfObject *withReg_object = (NsfObject *)pc.clientData[3]; - Tcl_Obj *name = (Tcl_Obj *)pc.clientData[4]; - Tcl_Obj *arguments = (Tcl_Obj *)pc.clientData[5]; - Tcl_Obj *body = (Tcl_Obj *)pc.clientData[6]; + int withCheckalways = (int )PTR2INT(pc.clientData[1]); + int withInner_namespace = (int )PTR2INT(pc.clientData[2]); + int withPer_object = (int )PTR2INT(pc.clientData[3]); + NsfObject *withReg_object = (NsfObject *)pc.clientData[4]; + Tcl_Obj *name = (Tcl_Obj *)pc.clientData[5]; + Tcl_Obj *arguments = (Tcl_Obj *)pc.clientData[6]; + Tcl_Obj *body = (Tcl_Obj *)pc.clientData[7]; assert(pc.status == 0); - return NsfAsmMethodCreateCmd(interp, object, withInner_namespace, withPer_object, withReg_object, name, arguments, body); + return NsfAsmMethodCreateCmd(interp, object, withCheckalways, withInner_namespace, withPer_object, withReg_object, name, arguments, body); } else { return TCL_ERROR; @@ -1370,17 +1371,18 @@ method_definitions[NsfMethodCreateCmdIdx].nrParameters, 0, NSF_ARGPARSE_BUILTIN, &pc) == TCL_OK)) { NsfObject *object = (NsfObject *)pc.clientData[0]; - int withInner_namespace = (int )PTR2INT(pc.clientData[1]); - int withPer_object = (int )PTR2INT(pc.clientData[2]); - NsfObject *withReg_object = (NsfObject *)pc.clientData[3]; - Tcl_Obj *methodName = (Tcl_Obj *)pc.clientData[4]; - Tcl_Obj *arguments = (Tcl_Obj *)pc.clientData[5]; - Tcl_Obj *body = (Tcl_Obj *)pc.clientData[6]; - Tcl_Obj *withPrecondition = (Tcl_Obj *)pc.clientData[7]; - Tcl_Obj *withPostcondition = (Tcl_Obj *)pc.clientData[8]; + int withCheckalways = (int )PTR2INT(pc.clientData[1]); + int withInner_namespace = (int )PTR2INT(pc.clientData[2]); + int withPer_object = (int )PTR2INT(pc.clientData[3]); + NsfObject *withReg_object = (NsfObject *)pc.clientData[4]; + Tcl_Obj *methodName = (Tcl_Obj *)pc.clientData[5]; + Tcl_Obj *arguments = (Tcl_Obj *)pc.clientData[6]; + Tcl_Obj *body = (Tcl_Obj *)pc.clientData[7]; + Tcl_Obj *withPrecondition = (Tcl_Obj *)pc.clientData[8]; + Tcl_Obj *withPostcondition = (Tcl_Obj *)pc.clientData[9]; assert(pc.status == 0); - return NsfMethodCreateCmd(interp, object, withInner_namespace, withPer_object, withReg_object, methodName, arguments, body, withPrecondition, withPostcondition); + return NsfMethodCreateCmd(interp, object, withCheckalways, withInner_namespace, withPer_object, withReg_object, methodName, arguments, body, withPrecondition, withPostcondition); } else { return TCL_ERROR; @@ -2744,8 +2746,9 @@ {"-closure", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"pattern", 0, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::method::asmcreate", NsfAsmMethodCreateCmdStub, 7, { +{"::nsf::method::asmcreate", NsfAsmMethodCreateCmdStub, 8, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, + {"-checkalways", 0, 0, Nsf_ConvertToBoolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-inner-namespace", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"-per-object", 0, 0, Nsf_ConvertToBoolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-reg-object", 0, 1, Nsf_ConvertToObject, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, @@ -2818,8 +2821,9 @@ {"subcmd", NSF_ARG_REQUIRED|NSF_ARG_IS_ENUMERATION, 1, ConvertToAssertionsubcmd, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"arg", 0, 1, Nsf_ConvertToTclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, -{"::nsf::method::create", NsfMethodCreateCmdStub, 9, { +{"::nsf::method::create", NsfMethodCreateCmdStub, 10, { {"object", NSF_ARG_REQUIRED, 1, Nsf_ConvertToObject, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, + {"-checkalways", 0, 0, Nsf_ConvertToBoolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-inner-namespace", 0, 0, Nsf_ConvertToString, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}, {"-per-object", 0, 0, Nsf_ConvertToBoolean, NULL,NULL,"switch",NULL,NULL,NULL,NULL,NULL}, {"-reg-object", 0, 1, Nsf_ConvertToObject, NULL,NULL,"object",NULL,NULL,NULL,NULL,NULL}, Index: generic/nsfInt.h =================================================================== diff -u -N -r1c21a6f9ab7fe20490ba256cb8cf3759b8498838 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- generic/nsfInt.h (.../nsfInt.h) (revision 1c21a6f9ab7fe20490ba256cb8cf3759b8498838) +++ generic/nsfInt.h (.../nsfInt.h) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -581,7 +581,7 @@ Tcl_Command cmd; NsfParamDefs *paramDefs; int with_ad; - int with_checkAlways; + int checkAlwaysFlag; } NsfProcClientData; typedef enum SystemMethodsIdx { Index: library/nx/nx.tcl =================================================================== diff -u -N -r42ba8471f7620b850b6296f753cbc3079fe5c6cd -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- library/nx/nx.tcl (.../nx.tcl) (revision 42ba8471f7620b850b6296f753cbc3079fe5c6cd) +++ library/nx/nx.tcl (.../nx.tcl) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -223,7 +223,7 @@ ###################################################################### ::nsf::method::create Class method { - name arguments:parameter,0..* -returns body -precondition -postcondition + name arguments:parameter,0..* -checkalways:switch -returns body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} @@ -233,6 +233,7 @@ dict with p { #puts "class method $object.$methodName [list $arguments] {...}" set r [::nsf::method::create $object \ + -checkalways=$checkalways \ {*}[expr {$regObject ne "" ? "-reg-object [list $regObject]" : ""}] \ $methodName $arguments $body {*}$conditions] if {$r ne ""} { @@ -494,14 +495,15 @@ # - "forward" :public method "object method" { - name arguments:parameter,0..* -returns body -precondition -postcondition + name arguments:parameter,0..* -checkalways:switch -returns body -precondition -postcondition } { set conditions [list] if {[info exists precondition]} {lappend conditions -precondition $precondition} if {[info exists postcondition]} {lappend conditions -postcondition $postcondition} array set "" [:__resolve_method_path -per-object $name] # puts "object method $(object).$(methodName) [list $arguments] {...}" set r [::nsf::method::create $(object) \ + -checkalways=$checkalways \ {*}[expr {$(regObject) ne "" ? "-reg-object [list $(regObject)]" : ""}] \ -per-object \ $(methodName) $arguments $body {*}$conditions] @@ -841,7 +843,7 @@ Object method "info info" {} {::nx::internal::infoOptions ::nx::Object::slot::__info} Class method "info info" {} {::nx::internal::infoOptions ::nx::Class::slot::__info} - # finally register method "method" (otherwise, we cannot use "method" above) + # finally register method for "info method" (otherwise, we cannot use "method" above) Class eval { #:alias "info method" ::nsf::methods::class::info::method :method "info method args" {name} {: ::nsf::methods::class::info::method args $name} Index: tests/info-method.test =================================================================== diff -u -N -r45e24b34c85bf0fc3e14db5250550100bd07ff31 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- tests/info-method.test (.../info-method.test) (revision 45e24b34c85bf0fc3e14db5250550100bd07ff31) +++ tests/info-method.test (.../info-method.test) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -109,7 +109,7 @@ } ? {C info method parameters m} {x} ? {nx::Class info method parameters method} \ - {name arguments:parameter,0..* -returns body -precondition -postcondition} + {name arguments:parameter,0..* -checkalways:switch -returns body -precondition -postcondition} ? {nx::Class info method parameters alias} \ {methodName -returns {-frame default} cmd} # raises currently an error @@ -801,7 +801,7 @@ nx::test case parametersyntax { # a true method ? {::nx::Class info method syntax method} \ - "/cls/ method /name/ /arguments/ ?-returns /value/? /body/ ?-precondition /value/? ?-postcondition /value/?" + "/cls/ method /name/ /arguments/ ?-checkalways? ?-returns /value/? /body/ ?-precondition /value/? ?-postcondition /value/?" # a forwarder to ::nsf::relation; definition comes via array ::nsf::parametersyntax ? {::nx::Class info method syntax mixin} "/cls/ mixin ?/class .../?|?add /class/?|?delete /class/?" Index: tests/parameters.test =================================================================== diff -u -N -r45e24b34c85bf0fc3e14db5250550100bd07ff31 -r7c2e28b93b02c29f19dc1f58642c5a29a894d24e --- tests/parameters.test (.../parameters.test) (revision 45e24b34c85bf0fc3e14db5250550100bd07ff31) +++ tests/parameters.test (.../parameters.test) (revision 7c2e28b93b02c29f19dc1f58642c5a29a894d24e) @@ -616,7 +616,7 @@ "query instparams with default, no paramdefs needed" ? {nx::Class info method parameters method} \ - "name arguments:parameter,0..* -returns body -precondition -postcondition" \ + "name arguments:parameter,0..* -checkalways:switch -returns body -precondition -postcondition" \ "query instparams for scripted method 'method'" ? {nx::Object info method parameters ::nsf::method::forward} \ @@ -1727,7 +1727,7 @@ ::nsf::configure checkarguments on # -# nx::test type any (or other typechecker) in combination with +# Test type any (or other typechecker) in combination with # substdefault via object parameter # nx::test case nsf-subdefault { @@ -1741,7 +1741,7 @@ } # -# nx::test argument processing and namespace handling in nsf::procs +# Test argument processing and namespace handling in nsf::procs # nx::test case nsf-proc { @@ -1805,6 +1805,7 @@ ? {::ns1::pass0 -s} "::ns1-1" } + # # Test argument processing and namespace handling in nsf::procs # @@ -2836,4 +2837,71 @@ :foo }} "bow-wow" -} \ No newline at end of file +} + +# +# test argument processing in nsf::proc with checkalways +# + +nx::test case nsf-proc-checkalways { + + # + # one proc with checkalways + # + nsf::proc p1 {-x:integer} { return $x} + nsf::proc -checkalways p2 {-x:integer} { return $x} + + ? {p1 -x 100} 100 + ? {p1 -x a100} {expected integer but got "a100" for parameter "-x"} + + ? {p2 -x 100} 100 + ? {p2 -x a100} {expected integer but got "a100" for parameter "-x"} + + nsf::configure checkarguments off + ? {p1 -x a100} a100 + ? {p2 -x a100} {expected integer but got "a100" for parameter "-x"} + + nsf::configure checkarguments on +} + +# +# test argument processing in methods with checkalways +# + +nx::test case nsf-method-checkalways { + + # + # one method with checkalways + # + + nx::Class create C { + :public method m1 {-x:integer} { return $x} + :public method m2 {-x:integer} -checkalways { return $x} + + :public object method om1 {-x:integer} { return $x} + :public object method om2 {-x:integer} -checkalways { return $x} + + :create c1 + } + + ? {c1 m1 -x 100} 100 + ? {c1 m2 -x 100} 100 + + ? {c1 m1 -x a100} {expected integer but got "a100" for parameter "-x"} + ? {c1 m2 -x a100} {expected integer but got "a100" for parameter "-x"} + + ? {C om1 -x 200} 200 + ? {C om2 -x 200} 200 + + ? {C om1 -x a} {expected integer but got "a" for parameter "-x"} + ? {C om2 -x a} {expected integer but got "a" for parameter "-x"} + + nsf::configure checkarguments off + ? {c1 m1 -x a100} a100 + ? {c1 m2 -x a100} {expected integer but got "a100" for parameter "-x"} + + ? {C om1 -x a} a + ? {C om2 -x a} {expected integer but got "a" for parameter "-x"} + + nsf::configure checkarguments on +}