Allow ensembles to rewrite their subcommands' error messages to be more

relevant to users. [Patch 1056864]
Also patches to core to take advantage of this
Also other general cleaning up of Tcl_WrongNumArgs usage

5 files changed, 45 insertions, 14 deletions

diff --git a/tests/clock.test b/tests/clock.test
index 746e26a..20fec79 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: clock.test,v 1.49 2004/10/28 00:04:33 dgp Exp $
+# RCS: @(#) $Id: clock.test,v 1.50 2004/10/29 15:39:07 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -35223,7 +35223,7 @@ test clock-35.1 {clock seconds tests} {
 } {}
 test clock-35.2 {clock seconds tests} {
     list [catch {clock seconds foo} msg] $msg
-} {1 {wrong # args: should be "::tcl::clock::seconds "}}
+} {1 {wrong # args: should be "clock seconds"}}
 test clock-35.3 {clock seconds tests} {
     set start [clock seconds]
     after 2000
diff --git a/tests/config.test b/tests/config.test
index 8c05a7e..2023d9c 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: config.test,v 1.3 2004/05/19 12:22:13 dkf Exp $
+# RCS: @(#) $Id: config.test,v 1.4 2004/10/29 15:39:10 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -35,7 +35,7 @@ test pkgconfig-1.3 {query value multiple times} {
 test pkgconfig-2.0 {error: missing subcommand} {
     catch {::tcl::pkgconfig} msg
     set msg
-} {wrong # args: should be "list | get key"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
 test pkgconfig-2.1 {error: illegal subcommand} {
     catch {::tcl::pkgconfig foo} msg
     set msg
@@ -43,11 +43,11 @@ test pkgconfig-2.1 {error: illegal subcommand} {
 test pkgconfig-2.2 {error: list with arguments} {
     catch {::tcl::pkgconfig list foo} msg
     set msg
-} {wrong # args: should be "list"}
+} {wrong # args: should be "::tcl::pkgconfig list"}
 test pkgconfig-2.3 {error: get without arguments} {
     catch {::tcl::pkgconfig get} msg
     set msg
-} {wrong # args: should be "get key"}
+} {wrong # args: should be "::tcl::pkgconfig get key"}
 test pkgconfig-2.4 {error: query unknown key} {
     catch {::tcl::pkgconfig get foo} msg
     set msg
@@ -55,7 +55,7 @@ test pkgconfig-2.4 {error: query unknown key} {
 test pkgconfig-2.5 {error: query with to many arguments} {
     catch {::tcl::pkgconfig get foo bar} msg
     set msg
-} {wrong # args: should be "list | get key"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/namespace.test b/tests/namespace.test
index 4180ca5..9341ecf 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: namespace.test,v 1.42 2004/10/28 00:04:39 dgp Exp $
+# RCS: @(#) $Id: namespace.test,v 1.43 2004/10/29 15:39:10 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1925,6 +1925,37 @@ test namespace-49.1 {ensemble subcommand caching} -body {
     rename x {}
 }
 
+test namespace-50.1 {ensembles affect proc arguments error messages} -body {
+    namespace ens cre -command a -map {b {bb foo}}
+    proc bb {c d {e f} args} {list $c $args}
+    a b
+} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup {
+    rename a {}
+    rename bb {}
+}
+test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body {
+    namespace ens cre -command a -map {b {string is}}
+    a b boolean
+} -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup {
+    rename a {}
+}
+test namespace-50.3 {chained ensembles affect error messages} -body {
+    namespace ens cre -command a -map {b c}
+    namespace ens cre -command c -map {d e}
+    proc e f {}
+    a b d
+} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup {
+    rename a {}
+}
+test namespace-50.4 {chained ensembles affect error messages} -body {
+    namespace ens cre -command a -map {b {c d}}
+    namespace ens cre -command c -map {d {e f}}
+    proc e f {}
+    a b d
+} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup {
+    rename a {}
+}
+
 # cleanup
 catch {rename cmd1 {}}
 catch {unset l}
diff --git a/tests/proc-old.test b/tests/proc-old.test
index 8203601..860279e 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -14,7 +14,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: proc-old.test,v 1.12 2004/05/19 12:56:54 dkf Exp $
+# RCS: @(#) $Id: proc-old.test,v 1.13 2004/10/29 15:39:10 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -233,7 +233,7 @@ test proc-old-30.12 {arguments and defaults} {
 	return [list $x $y $args]
     }
     list [catch {tproc} msg] $msg
-} {1 {wrong # args: should be "tproc x ?y? args"}}
+} {1 {wrong # args: should be "tproc x ?y? ..."}}
 
 test proc-old-4.1 {variable numbers of arguments} {
     proc tproc args {return $args}
@@ -258,7 +258,7 @@ test proc-old-4.5 {variable numbers of arguments} {
 test proc-old-4.6 {variable numbers of arguments} {
     proc tproc {x missing args} {return $args}
     list [catch {tproc 1} msg] $msg
-} {1 {wrong # args: should be "tproc x missing args"}}
+} {1 {wrong # args: should be "tproc x missing ..."}}
 
 test proc-old-5.1 {error conditions} {
     list [catch {proc} msg] $msg
diff --git a/tests/tm.test b/tests/tm.test
index 91329a2..9327530 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -6,7 +6,7 @@
 # Copyright (c) 2004 by Donal K. Fellows.
 # All rights reserved.
 #
-# RCS: @(#) $Id: tm.test,v 1.3 2004/10/27 17:01:46 andreas_kupries Exp $
+# RCS: @(#) $Id: tm.test,v 1.4 2004/10/29 15:39:10 dkf Exp $
 
 package require Tcl 8.5
 if {"::tcltest" ni [namespace children]} {
@@ -23,10 +23,10 @@ test tm-1.2 {tm: path command syntax} -returnCodes error -body {
 } -result {unknown or ambiguous subcommand "foo": must be add, list, or remove}
 test tm-1.3 {tm: path command syntax} -returnCodes error -body {
     ::tcl::tm::path add
-} -result "wrong # args: should be \"::tcl::tm::path add path ?path ...?\""
+} -result "wrong # args: should be \"::tcl::tm::path add path ...\""
 test tm-1.4 {tm: path command syntax} -returnCodes error -body {
     ::tcl::tm::path remove
-} -result "wrong # args: should be \"::tcl::tm::path remove path ?path ...?\""
+} -result "wrong # args: should be \"::tcl::tm::path remove path ...\""
 test tm-1.5 {tm: path command syntax} -returnCodes error -body {
     ::tcl::tm::path list foobar
 } -result "wrong # args: should be \"::tcl::tm::path list\""