merge novem

4 files changed, 172 insertions, 25 deletions

diff --git a/tests/compile.test b/tests/compile.test
index 2b9ea51..c76bd82 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -678,7 +678,7 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
 # change without warning.
 
 set disassemblables [linsert [join {
-    lambda method objmethod proc script
+    constructor destructor lambda method objmethod proc script
 } ", "] end-1 or]
 test compile-18.1 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble
@@ -872,6 +872,103 @@ test compile-18.39 {disassembler - basics} -setup {
 } -cleanup {
     foo destroy
 } -result "$bytecodekeys initiallinenumber sourcefile"
+test compile-18.40 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.41 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble constructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.42 {disassembler - basics} -returnCodes error -setup {
+    oo::object create justanobject
+} -body {
+    tcl::unsupported::disassemble constructor justanobject
+} -cleanup {
+    justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.43 {disassembler - basics} -returnCodes error -setup {
+    oo::class create constructorless
+} -body {
+    tcl::unsupported::disassemble constructor constructorless
+} -cleanup {
+    constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.44 {disassembler - basics} -setup {
+    oo::class create foo {constructor {} {set x 1}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble constructor foo
+} -cleanup {
+    foo destroy
+} -match glob -result *
+test compile-18.45 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::getbytecode constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.46 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::getbytecode constructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.47 {disassembler - basics} -returnCodes error -setup {
+    oo::class create constructorless
+} -body {
+    tcl::unsupported::getbytecode constructor constructorless
+} -cleanup {
+    constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.48 {disassembler - basics} -setup {
+    oo::class create foo {constructor {} {set x 1}}
+} -body {
+    dict keys [tcl::unsupported::getbytecode constructor foo]
+} -cleanup {
+    foo destroy
+} -result "$bytecodekeys"
+# There is no compile-18.49
+test compile-18.50 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.51 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble destructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.52 {disassembler - basics} -returnCodes error -setup {
+    oo::object create justanobject
+} -body {
+    tcl::unsupported::disassemble destructor justanobject
+} -cleanup {
+    justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.53 {disassembler - basics} -returnCodes error -setup {
+    oo::class create constructorless
+} -body {
+    tcl::unsupported::disassemble destructor constructorless
+} -cleanup {
+    constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.54 {disassembler - basics} -setup {
+    oo::class create foo {destructor {set x 1}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble destructor foo
+} -cleanup {
+    foo destroy
+} -match glob -result *
+test compile-18.55 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::getbytecode destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.56 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::getbytecode destructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.57 {disassembler - basics} -returnCodes error -setup {
+    oo::class create constructorless
+} -body {
+    tcl::unsupported::getbytecode destructor constructorless
+} -cleanup {
+    constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.58 {disassembler - basics} -setup {
+    oo::class create foo {destructor {set x 1}}
+} -body {
+    dict keys [tcl::unsupported::getbytecode destructor foo]
+} -cleanup {
+    foo destroy
+} -result "$bytecodekeys"
 
 test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
     # This will panic in a --enable-symbols=compile build, unless bug is fixed.
diff --git a/tests/for.test b/tests/for.test
index 8e701d6..c8a8187 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -451,7 +451,7 @@ proc formatMail {} {
 		    set c [string length $line]
 		}
 	    }
-	    set newline [string range $line 0 $c]
+	    set newline [string trimright [string range $line 0 $c]]
 	    if {! $continuation} {
 		append result $newline $NL
 	    } else {
@@ -507,7 +507,7 @@ releases of the Tcl scripting language and the Tk toolk
 it. The first beta versions of these
 releases were released on August 30, 1996. These releas
 es contain only minor changes,
-so we hope to have only a single beta release and to 
+so we hope to have only a single beta release and to
 go final in early October, 1996.
 
 
@@ -519,34 +519,34 @@ and changes files in the distributions for more complet
 e information on what has
 changed, including both feature changes and bug fixes.
 
-     There are new options to the file command for 
+     There are new options to the file command for
 copying files (file copy),
-     deleting files and directories (file delete), 
+     deleting files and directories (file delete),
 creating directories (file
      mkdir), and renaming files (file rename).
      The implementation of exec has been improved great
 ly for Windows 95 and
      Windows NT.
-     There is a new memory allocator for the Macintosh 
+     There is a new memory allocator for the Macintosh
 version, which should be
      more efficient than the old one.
-     Tk's grid geometry manager has been completely 
+     Tk's grid geometry manager has been completely
 rewritten. The layout
      algorithm produces much better layouts than before
 , especially where rows or
      columns were stretchable.
-     There are new commands for creating common dialog 
+     There are new commands for creating common dialog
 boxes:
      tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
-     tk_messageBox. These use native dialog boxes if 
+     tk_messageBox. These use native dialog boxes if
 they are available.
      There is a new virtual event mechanism for handlin
 g events in a more portable
-     way. See the new command event. It also allows 
+     way. See the new command event. It also allows
 events (both physical and
      virtual) to be generated dynamically.
 
-Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 
+Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
 7.5 and Tk 4.1 except for
 changes in the C APIs for custom channel drivers. Scrip
 ts written for earlier releases
@@ -556,27 +556,27 @@ Obtaining The Releases
 
 Binary Releases
 
-Pre-compiled releases are available for the following 
+Pre-compiled releases are available for the following
 platforms:
 
      Windows 3.1, Windows 95, and Windows NT: Fetch
-     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 
+     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
 execute it. The file is a
-     self-extracting executable. It will install the 
+     self-extracting executable. It will install the
 Tcl and Tk libraries, the wish and
      tclsh programs, and documentation.
      Macintosh (both 68K and PowerPC): Fetch
-     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 
+     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
 The file is in binhex format,
-     which is understood by Fetch, StuffIt, and many 
+     which is understood by Fetch, StuffIt, and many
 other Mac utilities. The
-     unpacked file is a self-installing executable: 
+     unpacked file is a self-installing executable:
 double-click on it and it will create a
-     folder containing all that you need to run Tcl 
+     folder containing all that you need to run Tcl
 and Tk.
-        UNIX (Solaris 2.* and SunOS, other systems 
+        UNIX (Solaris 2.* and SunOS, other systems
 soon to follow). Easy to install
-     binary packages are now for sale at the Sun Labs 
+     binary packages are now for sale at the Sun Labs
 Tcl/Tk Shop. Check it out!
 }
 
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 646cb02..f4d3dc6 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -107,11 +107,6 @@ test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
 test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
     testwrongnumargs 2 "" mycmd foo
 } "wrong # args: should be \"mycmd foo\""
-# Contrast this with test proc-3.6; they have to be like this because
-# of [Bug 1066837] so Itcl won't break.
-test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj {
-    testwrongnumargs 2 "fee fi" "fo fum" foo bar
-} "wrong # args: should be \"fo fum foo fee fi\""
 
 test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
     set x a
diff --git a/tests/namespace.test b/tests/namespace.test
index fc74d73..2a5f308 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -2107,6 +2107,61 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
     rename a {}
     rename c {}
 }
+test namespace-50.5 {[4402cfa58c]} -setup {
+    proc bar {ev} {}
+    proc bingo {xx} {}
+    namespace ensemble create -command launch -map {foo bar event bingo}
+    set result {}
+} -body {
+    catch {launch foo} m; lappend result $m
+    catch {launch ev} m; lappend result $m
+    catch {launch foo} m; lappend result $m
+} -cleanup {
+    rename launch {}
+    rename bingo {}
+    rename bar {}
+} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}}
+test namespace-50.6 {[4402cfa58c]} -setup {
+    proc target {x y} {}
+    namespace ensemble create -command e2 -map {s2 target}
+    namespace ensemble create -command e1 -map {s1 e2}
+    set result {}
+} -body {
+    set s s
+    catch {e1 s1 s2 a} m; lappend result $m
+    catch {e1 $s s2 a} m; lappend result $m
+    catch {e1 s1 $s a} m; lappend result $m
+    catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+    rename e1 {}
+    rename e2 {}
+    rename target {}
+} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}}
+test namespace-50.7 {[4402cfa58c]} -setup {
+    proc target {x y} {}
+    namespace ensemble create -command e2 -map {s2 target}
+    namespace ensemble create -command e1 -map {s1 e2} -parameters foo
+    set result {}
+} -body {
+    set s s
+    catch {e1 s2 s1 a} m; lappend result $m
+    catch {e1 $s s1 a} m; lappend result $m
+    catch {e1 s2 $s a} m; lappend result $m
+    catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+    rename e1 {}
+    rename e2 {}
+    rename target {}
+} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
+test namespace-50.8 {[f961d7d1dd]} -setup {
+    proc target {} {}
+    namespace ensemble create -command e -map {s target} -parameters {{a b}}
+} -body {
+    e
+} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup {
+    rename e {}
+    rename target {}
+}
 
 test namespace-51.1 {name resolution path control} -body {
     namespace eval ::test_ns_1 {