From 91e563cefe5477b877817b11c00c2e113bcb12b2 Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Tue, 16 Jan 2024 15:04:53 +0100 Subject: [PATCH 1/6] Bug fix: potential crash and swallowed error The change fixes 2 bugs: - When a non-existing method was called in a situation where * a filter with guards is registered, and * all guards are failing, and * the method to be called after the filter does not exist nsf was crashing - There was no code to produce the proper error message in such situations --- generic/nsf.c | 61 ++++++++++++++++++++++++++------- library/xotcl/tests/testx.xotcl | 13 +++++++ 2 files changed, 61 insertions(+), 13 deletions(-) diff --git a/generic/nsf.c b/generic/nsf.c index a28b76f0..f2ca7128 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) @@ -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,15 @@ NextSearchAndInvoke( /* NsfShowStack(interp);*/ topCscPtr = CallStackGetTopFrame(interp, &varFramePtr); - assert(topCscPtr != NULL); + if (topCscPtr == NULL) { + /* + * This might happen, when after a filter chain the method to be called + * is not found. + */ + /* fprintf(stderr, "no topCscPtr, unknown %d result %d\n", rst->unknown, result);*/ + goto next_search_and_invoke_cleanup; + } + assert(varFramePtr != NULL); /* @@ -31376,7 +31409,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/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" From 3234688fdd64b164128db23fc05ea85777e7b2ae Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Tue, 16 Jan 2024 16:59:10 +0100 Subject: [PATCH 2/6] improved spelling --- generic/nsf.c | 2 +- library/nx/nx.tcl | 2 +- library/xotcl/library/comm/Access.xotcl | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/nsf.c b/generic/nsf.c index f2ca7128..24b37da7 100644 --- a/generic/nsf.c +++ b/generic/nsf.c @@ -17981,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))) { /* diff --git a/library/nx/nx.tcl b/library/nx/nx.tcl index 3afc0110..cf463e78 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. 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 "" From f2bfddf1c09ca935f713b2f49bfb2ac6b6444783 Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Sat, 20 Jan 2024 08:50:05 +0100 Subject: [PATCH 3/6] improved comment --- generic/nsf.c | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/generic/nsf.c b/generic/nsf.c index 24b37da7..1378b4d3 100644 --- a/generic/nsf.c +++ b/generic/nsf.c @@ -20958,8 +20958,10 @@ NextSearchAndInvoke( topCscPtr = CallStackGetTopFrame(interp, &varFramePtr); if (topCscPtr == NULL) { /* - * This might happen, when after a filter chain the method to be called - * is not found. + * 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; From 32fd4c6b623a4c4850bd4eef6bdfa76e3b62bcdb Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Sun, 11 Feb 2024 11:40:32 +0100 Subject: [PATCH 4/6] Fixed handling of invalid parameter specs This bug was occuring e.g. with an invalid parameter spec as in :property {fiscalyear:integer, required} where an additional space was introduced. The bug was reported by Maksym Zinchenko on the xotcl mailing list (many thanks for that!) and lead to an attempt of adding an empty parameter option. Now, an error is generated in this case. --- library/nx/nx.tcl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/library/nx/nx.tcl b/library/nx/nx.tcl index cf463e78..19a09200 100644 --- a/library/nx/nx.tcl +++ b/library/nx/nx.tcl @@ -1094,6 +1094,9 @@ namespace eval ::nx { set parameterOptions [string range $spec [expr {$colonPos+1}] end] set name [string range $spec 0 [expr {$colonPos -1}]] foreach property [split $parameterOptions ,] { + if {[string trim $property] eq ""} { + return -code error "invalid parameter spec '$spec'" + } if {$property in [list "required" "convert" "noarg" "nodashalnum"]} { if {$property eq "convert" } {set class [:requireClass ::nx::VariableSlot $class]} lappend opts -$property 1 @@ -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 From 285f60aaeae84fa3978f1d67a27341b42edab1ae Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Sun, 11 Feb 2024 11:49:38 +0100 Subject: [PATCH 5/6] fixed misleading name of variable --- library/nx/nx.tcl | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/library/nx/nx.tcl b/library/nx/nx.tcl index 19a09200..53885552 100644 --- a/library/nx/nx.tcl +++ b/library/nx/nx.tcl @@ -1093,46 +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 {[string trim $property] eq ""} { + foreach parameterOption [split $parameterOptions ,] { + if {[string trim $parameterOption] eq ""} { return -code error "invalid parameter spec '$spec'" } - 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"} { + 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 } } } From e34b17e50024256ee48b6f79826380d0aa88eb52 Mon Sep 17 00:00:00 2001 From: Gustaf Neumann Date: Sun, 11 Feb 2024 11:53:42 +0100 Subject: [PATCH 6/6] improved spelling --- doc/example-scripts/rosetta-unknown-method.tcl | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) 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"