Merge ahead commits from fork gustafn/nsf

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"

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;
 

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

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 ""

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"