* tests/info.test (info-9.11-12): tests for [Bug 1577492]

	* tests/apply.test (apply-4.3-5): tests for [Bug 1574835]

3 files changed, 59 insertions, 3 deletions

diff --git a/ChangeLog b/ChangeLog
index c130118..6303dcc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2006-10-24  Miguel Sofer  <msofer@users.sf.net>
 
+	* tests/info.test (info-9.11-12): tests for [Bug 1577492]
+	* tests/apply.test (apply-4.3-5): tests for [Bug 1574835]
+
 	* generic/tclProc.c (ObjInterpProcEx): disable itcl hacks for
 	calls from ApplyObjCmd (islambda==1), as they mess apply's error
 	messages [Bug 1583266]
diff --git a/tests/apply.test b/tests/apply.test
index 563210c..e639638 100644
--- a/tests/apply.test
+++ b/tests/apply.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: apply.test,v 1.7 2006/10/16 20:36:19 msofer Exp $
+# RCS: @(#) $Id: apply.test,v 1.8 2006/10/24 23:13:07 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -123,10 +123,44 @@ test apply-4.1 {error in arguments to lambda expression} {
 
 test apply-4.2 {error in arguments to lambda expression} {
     set lambda [list x {set x 1}]
-    set res [catch {apply $lambda x y} msg]
+    set res [catch {apply $lambda a b} msg]
     list $res $msg
 } {1 {wrong # args: should be "apply {x {set x 1}} x"}}
 
+test apply-4.3 {error in arguments to lambda expression} {
+    set lambda [list x {set x 1}]
+    interp alias {} foo {} ::apply $lambda
+    set res [catch {foo a b} msg]
+    list $res $msg [rename foo {}]
+} {1 {wrong # args: should be "foo x"} {}}
+
+test apply-4.4 {error in arguments to lambda expression} {
+    set lambda [list x {set x 1}]
+    interp alias {} foo {} ::apply $lambda a
+    set res [catch {foo b} msg]
+    list $res $msg [rename foo {}]
+} {1 {wrong # args: should be "foo"} {}}
+
+test apply-4.5 {error in arguments to lambda expression} {
+    set lambda [list x {set x 1}]
+    namespace eval a {
+	namespace ensemble create -command ::bar -map {id {::a::const foo}}
+	proc const val { return $val }
+	proc alias {object slot = command args} {
+	    set map [namespace ensemble configure $object -map]
+	    dict set map $slot [linsert $args 0 $command]
+	    namespace ensemble configure $object -map $map
+	}
+	proc method {object name params body} {
+	    set params [linsert $params 0 self]
+	    alias $object $name = ::apply [list $params $body] $object
+	}
+	method ::bar boo x {return "[expr {$x*$x}] - $self"}
+    }
+    set res [catch {bar boo} msg]
+    list $res $msg [namespace delete ::a]
+} {1 {wrong # args: should be "bar boo x"} {}}
+
 test apply-5.1 {runtime error in lambda expression} {
     set lambda [list {} {error foo}]
     set res [catch {apply $lambda}]
diff --git a/tests/info.test b/tests/info.test
index 8a8417e..1a4f1cd 100644
--- a/tests/info.test
+++ b/tests/info.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: info.test,v 1.37 2006/10/20 15:16:47 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.38 2006/10/24 23:13:07 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -357,6 +357,25 @@ test info-9.10 {info level option, namespaces} {
     namespace delete t
     set msg
 } {namespace eval t {info level 0}}
+test info-9.11 {info level option, aliases} -setup {
+    proc w {x y z} {info level 0}
+    interp alias {} a {} w a b
+} -body {
+    a c
+} -cleanup {
+    rename a {}
+    rename w {}
+} -result {a c}
+test info-9.12 {info level option, ensembles} -setup {
+    proc w {x y z} {info level 0}
+    namespace ensemble create -command a -map {foo ::w}
+} -body {
+    a foo 1 2 3
+} -cleanup {
+    rename a {}
+    rename w {}
+} -result {a foo 1 2 3}
+
 
 set savedLibrary $tcl_library
 test info-10.1 {info library option} {