diff --git a/doc/example-scripts/rosetta-unknown-method.tcl b/doc/example-scripts/rosetta-unknown-method.tcl index 4080d5fc..4f6c714f 100644 --- a/doc/example-scripts/rosetta-unknown-method.tcl +++ b/doc/example-scripts/rosetta-unknown-method.tcl @@ -1,17 +1,17 @@ # -# == Rosetta Example: Respond to an unknown method call +# == Rosetta Example: Respond to an unknown method call # For details see https://rosettacode.org/wiki/Respond_to_an_unknown_method_call # package req nx package req nx::test # -# Define a class Example modelled after the -# Python version of Rosetta: +# Define a class "Example" modeled after the +# Python version in the Rosetta examples. # nx::Class create Example { - + :public method foo {} {return "This is foo."} :public method bar {} {return "This is bar."} @@ -24,7 +24,7 @@ nx::Class create Example { } } -# === Demonstrating the behavior in a shell: +# === Demonstrating the behavior in a shell: # # Create an instance of the class Example: ? {set e [Example new]} "::nsf::__#0" diff --git a/generic/nsf.c b/generic/nsf.c index a28b76f0..1378b4d3 100644 --- a/generic/nsf.c +++ b/generic/nsf.c @@ -10877,7 +10877,7 @@ GuardCheck(Tcl_Interp *interp, Tcl_Obj *guardObj) { result = CheckConditionInScope(interp, guardObj); rst->guardCount--; - /*fprintf(stderr, "checking guard **%s** returned rc=%d\n", ObjStr(guardObj), rc);*/ + /*fprintf(stderr, "checking guard **%s** returned rc=%d\n", ObjStr(guardObj), result);*/ if (likely(result == TCL_OK)) { /* fprintf(stderr, " +++ OK\n"); */ @@ -14295,9 +14295,11 @@ ProcMethodDispatch( * stack, we pass it already to search-and-invoke. */ - /*fprintf(stderr, "... calling nextmethod cscPtr %p\n", (void *)cscPtr);*/ + cscPtr->flags |= NSF_CSC_CALL_IS_GUARD; + /*fprintf(stderr, "... guard fail calling nextmethod for '%s' cscPtr %p\n", methodName, (void *)cscPtr);*/ result = NextSearchAndInvoke(interp, methodName, objc, objv, cscPtr, NSF_FALSE); - /*fprintf(stderr, "... after nextmethod result %d\n", result);*/ + /*fprintf(stderr, "... guard fail nextmethod for '%s' result %d\n", methodName, result);*/ + cscPtr->flags &= ~ NSF_CSC_CALL_IS_GUARD; } /* @@ -14386,6 +14388,7 @@ ProcMethodDispatch( NULL); cscPtr->flags |= NSF_CSC_CALL_IS_NRE; result = TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); + #else ClientData data[3] = { (releasePc ? pcPtr : NULL), @@ -15269,7 +15272,7 @@ ObjectDispatchFinalize(Tcl_Interp *interp, NsfCallStackContent *cscPtr, flags = cscPtr->flags; rst = RUNTIME_STATE(interp); - /*fprintf(stderr, "ObjectDispatchFinalize %p %s flags %.6x (%d) frame %.6x unk %d m %s\n", + /*fprintf(stderr, "ObjectDispatchFinalize %p %s flags %.6x (result %d) frame %.6x unk %d m %s\n", (void*)cscPtr, ObjectName(object), flags, result, cscPtr->frameType, RUNTIME_STATE(interp)->unknown, (cscPtr->cmdPtr != NULL) ? Tcl_GetCommandName(interp, cscPtr->cmdPtr) : "");*/ @@ -15829,7 +15832,7 @@ ObjectDispatch( cmd = FilterSearchProc(interp, object, &object->filterStack->currentCmdPtr, &class); if (cmd != NULL) { - /*fprintf(stderr, "*** filterSearchProc returned cmd %p\n", cmd);*/ + /*fprintf(stderr, "*** filterSearchProc returned cmd %p\n", (void*)cmd);*/ frameType = NSF_CSC_TYPE_ACTIVE_FILTER; methodName = (char *)Tcl_GetCommandName(interp, cmd); flags |= NSF_CM_IGNORE_PERMISSIONS; @@ -16511,8 +16514,10 @@ DispatchUnknownMethod(Tcl_Interp *interp, NsfObject *object, unknownObj = NsfMethodObj(object, NSF_o_unknown_idx); /*fprintf(stderr, "compare unknownObj %p with methodObj %p '%s' %p %p %s -- %s\n", - unknownObj, methodObj, ObjStr(methodObj), callInfoObj, (callInfoObj != NULL) ?objv[1]:NULL, (callInfoObj != NULL) ?ObjStr(objv[1]) : NULL, - methodName);*/ + unknownObj, methodObj, ObjStr(methodObj), callInfoObj, + (callInfoObj != NULL) ? objv[1] : NULL, + (callInfoObj != NULL) ? ObjStr(objv[1]) : NULL, + methodName);*/ if ((unknownObj != NULL) && (methodObj != unknownObj) @@ -17976,7 +17981,7 @@ ParamOptionParse(Tcl_Interp *interp, const char *argString, return TCL_ERROR; } - /*fprintf(stderr, "HAV TYPE converter for <%s> ?\n", option);*/ + /*fprintf(stderr, "HAVE TYPE converter for <%s> ?\n", option);*/ if (Nsf_PointerTypeLookup(Tcl_DStringValue(dsPtr))) { /* @@ -20455,7 +20460,7 @@ NextSearchMethod( endOfChain = NSF_TRUE; *endOfFilterChain = NSF_TRUE; *classPtr = NULL; - /*fprintf(stderr, "EndOfChain resetting cl\n");*/ + /*fprintf(stderr, "EndOfChain resetting cl, new methodName '%s'\n", *methodNamePtr);*/ } } else { *methodNamePtr = (char *) Tcl_GetCommandName(interp, *cmdPtr); @@ -20553,7 +20558,7 @@ NextSearchMethod( (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) != 0u) ? 0 : NSF_CMD_CALL_PRIVATE_METHOD); } else { - *classPtr = NULL; + *classPtr = NULL; } } else { @@ -20823,9 +20828,15 @@ NextSearchAndInvoke( #if 0 Tcl_ResetResult(interp); /* needed for bytecode support */ #endif - if (cmd != NULL) { + + if (likely(cmd != NULL) + || ( endOfFilterChain + && (cscPtr->objv != NULL) + && (cscPtr->flags & NSF_CSC_CALL_IS_GUARD) != 0u ) + ) { unsigned short frameType = NSF_CSC_TYPE_PLAIN; + /* * Change mixin state. */ @@ -20845,9 +20856,10 @@ NextSearchAndInvoke( /* * Change filter state */ + if (object->filterStack != NULL) { if (cscPtr->frameType == NSF_CSC_TYPE_ACTIVE_FILTER) { - /*fprintf(stderr, "next changes filter state\n");*/ + /*fprintf(stderr, "next changes filter state cmd %p\n", (void*)cmd);*/ cscPtr->frameType = NSF_CSC_TYPE_INACTIVE_FILTER; } @@ -20861,6 +20873,19 @@ NextSearchAndInvoke( } } + if (cmd == NULL) { + /* + * The cmd was not found by NextSearchMethod(). In case of + * end-of-filterchain in a filter guard call, we have to call the "unknown" + * method, since otherwise we cannot flag unknown methods behind + * filters. + */ + result = DispatchUnknownMethod(interp, object, + cscPtr->objc, cscPtr->objv, NULL, cscPtr->objv[0], + (cscPtr->flags & NSF_CSC_CALL_NO_UNKNOWN)|NSF_CSC_IMMEDIATE); + goto next_search_and_invoke_cleanup; + } + /* * Now actually call the "next" method. */ @@ -20931,7 +20956,17 @@ NextSearchAndInvoke( /* NsfShowStack(interp);*/ topCscPtr = CallStackGetTopFrame(interp, &varFramePtr); - assert(topCscPtr != NULL); + if (topCscPtr == NULL) { + /* + * This might happen, when the end of the filter chain is reached and + * the method to be called is not found. Also, aside from filter chains, + * the ensemble method lookup requires an existing topCscPtr and would + * crash without it. + */ + /* fprintf(stderr, "no topCscPtr, unknown %d result %d\n", rst->unknown, result);*/ + goto next_search_and_invoke_cleanup; + } + assert(varFramePtr != NULL); /* @@ -31376,7 +31411,9 @@ NsfCurrentCmd(Tcl_Interp *interp, CurrentoptionIdx_t option) { Tcl_SetObjResult(interp, Tcl_NewStringObj(MethodName(cscPtr->filterStackEntry->calledProc), TCL_INDEX_NONE)); } else { - result = NsfPrintError(interp, "called from outside of a filter"); + NsfShowStack(interp); + + result = NsfPrintError(interp, "called from outside of a filter 1"); } break; diff --git a/library/nx/nx.tcl b/library/nx/nx.tcl index 3afc0110..53885552 100644 --- a/library/nx/nx.tcl +++ b/library/nx/nx.tcl @@ -334,7 +334,7 @@ namespace eval ::nx { } } - # Provide a placeholder for objectparameter during the bootup + # Provide a placeholder for objectparameter during the boot-up # process. The real definition is based on slots, which are not # available at this point. @@ -1093,43 +1093,46 @@ namespace eval ::nx { } else { set parameterOptions [string range $spec [expr {$colonPos+1}] end] set name [string range $spec 0 [expr {$colonPos -1}]] - foreach property [split $parameterOptions ,] { - if {$property in [list "required" "convert" "noarg" "nodashalnum"]} { - if {$property eq "convert" } {set class [:requireClass ::nx::VariableSlot $class]} - lappend opts -$property 1 - } elseif {$property eq "noconfig"} { + foreach parameterOption [split $parameterOptions ,] { + if {[string trim $parameterOption] eq ""} { + return -code error "invalid parameter spec '$spec'" + } + if {$parameterOption in [list "required" "convert" "noarg" "nodashalnum"]} { + if {$parameterOption eq "convert" } {set class [:requireClass ::nx::VariableSlot $class]} + lappend opts -$parameterOption 1 + } elseif {$parameterOption eq "noconfig"} { set opt(-configurable) 0 ;# TODO - } elseif {$property eq "incremental"} { + } elseif {$parameterOption eq "incremental"} { return -code error "parameter option incremental must not be used; use non-positional argument -incremental instead" - } elseif {[string match "type=*" $property]} { + } elseif {[string match "type=*" $parameterOption]} { set class [:requireClass ::nx::VariableSlot $class] - set type [string range $property 5 end] + set type [string range $parameterOption 5 end] if {$type eq ""} { unset type } elseif {![string match "::*" $type]} { set type [namespace qualifier $target]::$type } - } elseif {[string match "arg=*" $property]} { - set argument [string range $property 4 end] + } elseif {[string match "arg=*" $parameterOption]} { + set argument [string range $parameterOption 4 end] lappend opts -arg $argument - } elseif {[string match "substdefault*" $property]} { - if {[string match "substdefault=*" $property]} { - set argument [string range $property 13 end] + } elseif {[string match "substdefault*" $parameterOption]} { + if {[string match "substdefault=*" $parameterOption]} { + set argument [string range $parameterOption 13 end] } else { set argument 0b111 } lappend opts -substdefault $argument - } elseif {[string match "method=*" $property]} { - lappend opts -methodname [string range $property 7 end] - } elseif {$property eq "optional"} { + } elseif {[string match "method=*" $parameterOption]} { + lappend opts -methodname [string range $parameterOption 7 end] + } elseif {$parameterOption eq "optional"} { lappend opts -required 0 - } elseif {$property in [list "alias" "forward" "cmd" "initcmd"]} { - lappend opts -disposition $property + } elseif {$parameterOption in [list "alias" "forward" "cmd" "initcmd"]} { + lappend opts -disposition $parameterOption set class [:requireClass ::nx::ObjectParameterSlot $class] - } elseif {[regexp {([01])[.][.]([1n*])} $property _ minOccurrence maxOccurrence]} { - lappend opts -multiplicity $property + } elseif {[regexp {([01])[.][.]([1n*])} $parameterOption _ minOccurrence maxOccurrence]} { + lappend opts -multiplicity $parameterOption } else { - set type $property + set type $parameterOption } } } @@ -1965,8 +1968,9 @@ namespace eval ::nx { if {[info exists :type]} { set type ${:type} - if {$type eq "switch" && !$forInfo && !$forObjectParameter} {set type boolean} - if {$type in {cmd initcmd}} { + if {$type eq "switch" && !$forInfo && !$forObjectParameter} { + set type boolean + } elseif {$type in {cmd initcmd}} { lappend options $type } elseif {[string match ::* $type]} { lappend options [expr {[::nsf::is metaclass $type] ? "class" : "object"}] type=$type diff --git a/library/xotcl/library/comm/Access.xotcl b/library/xotcl/library/comm/Access.xotcl index dcc2d5c8..94563794 100644 --- a/library/xotcl/library/comm/Access.xotcl +++ b/library/xotcl/library/comm/Access.xotcl @@ -1082,7 +1082,7 @@ namespace eval ::xotcl::comm::httpAccess { #my showMsg "c [my set currentsize]== t [[self set totalsize]]" if {$currentsize == $totalsize && [my exists S] && [$S exists persistent]} { - #my showMsg "PERSITENT, end of entity reached" + #my showMsg "PERSISTENT, end of entity reached" #my set state eof my finish set block "" diff --git a/library/xotcl/tests/testx.xotcl b/library/xotcl/tests/testx.xotcl index 7822f619..a2206ecd 100644 --- a/library/xotcl/tests/testx.xotcl +++ b/library/xotcl/tests/testx.xotcl @@ -4403,6 +4403,19 @@ o proc test {} { } o test +o destroy + +Object create o + +o proc f1 {} { return 1 } +o proc f2 {} { return 2 } +o filter {{f1 -guard { + [self calledproc] == "c" +}}} + +errorCheck [o f2] 2 "call existing method after all guards failed" +errorCheck [catch {o XXXXX} errorMsg] 1 "call non-existing method after all guards failed -> error" +errorCheck $errorMsg "::o: unable to dispatch method 'XXXXX'" "call non-existing method after all guards failed -> errorMsg" puts "PASSED ::topLevelCommands"