New tests to demo the remaining flaw in ensemble dispatch revisions.

Itcl 4 also demonstrated these problems.

2 files changed, 19 insertions, 1 deletions

diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index a9698be..818534e 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -1852,7 +1852,13 @@ NsEnsembleImplementationCmdNR(
 
 	Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
 
-	if (objc == 2) {
+	if (0 && objc == 2) {
+	    /*
+ 	     * Branch disabled until it works. See oo-1[67].1.1
+ 	     * 
+ 	     * Key here is the difference between the canonical list invocation
+ 	     * and compilation/execution paths.
+ 	     */
 	    copyPtr = prefixObj;
 	    Tcl_IncrRefCount(copyPtr);
 	    TclNRAddCallback(interp, FreeObj, copyPtr, NULL, NULL, NULL);
diff --git a/tests/oo.test b/tests/oo.test
index 895f7ed..48e093a 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -2017,6 +2017,12 @@ test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
 test oo-16.1 {OO: object introspection} -body {
     info object
 } -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
+test oo-16.1.1 {OO: object introspection} -body {
+    catch {info object} m o
+    dict get $o -errorinfo
+} -result "wrong \# args: should be \"info object subcommand ?arg ...?\"
+    while executing
+\"info object\""
 test oo-16.2 {OO: object introspection} -body {
     info object class NOTANOBJECT
 } -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
@@ -2156,6 +2162,12 @@ test oo-16.14 {OO: object introspection: TIP #436} -setup {
 test oo-17.1 {OO: class introspection} -body {
     info class
 } -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
+test oo-17.1.1 {OO: class introspection} -body {
+    catch {info class} m o
+    dict get $o -errorinfo
+} -result "wrong \# args: should be \"info class subcommand ?arg ...?\"
+    while executing
+\"info class\""
 test oo-17.2 {OO: class introspection} -body {
     info class superclass NOTANOBJECT
 } -returnCodes 1 -result {NOTANOBJECT does not refer to an object}