Merged trunk

5 files changed, 155 insertions, 25 deletions

diff --git a/tests/compile.test b/tests/compile.test
index cf552e2..72eef5e 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -827,6 +827,7 @@ test compile-18.19 {disassembler - basics} -setup {
 # There never was a compile-18.20.
 # The keys of the dictionary produced by [getbytecode] are defined.
 set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth exceptdepth}
+set allbytecodekeys [list {*}$bytecodekeys initiallinenumber sourcefile]
 test compile-18.21 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode
 } -match glob -result {wrong # args: should be "*"}
@@ -841,7 +842,7 @@ test compile-18.24 {disassembler - basics} -returnCodes error -body {
 } -result "can't interpret \"\{\" as a lambda expression"
 test compile-18.25 {disassembler - basics} -body {
     dict keys [tcl::unsupported::getbytecode lambda {{} {}}]
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.26 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode proc
 } -match glob -result {wrong # args: should be "* proc procName"}
@@ -854,7 +855,7 @@ test compile-18.28 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode proc chewonthis]
 } -cleanup {
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.28.1 {disassembler - tricky bit} -setup {
     eval [list proc chewonthis {} {}]
 } -body {
@@ -868,7 +869,7 @@ test compile-18.28.2 {disassembler - tricky bit} -setup {
     dict keys [tcl::unsupported::getbytecode proc chewonthis]
 } -cleanup {
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.28.3 {disassembler - tricky bit} -setup {
     proc Proc {n a b} {
 	proc $n $a $b
@@ -890,7 +891,7 @@ test compile-18.28.4 {disassembler - tricky bit} -setup {
 } -cleanup {
     rename Proc {}
     rename chewonthis {}
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.29 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode script
 } -match glob -result {wrong # args: should be "* script script"}
@@ -919,7 +920,7 @@ test compile-18.35 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode method foo bar]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.36 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::getbytecode objmethod
 } -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
@@ -936,7 +937,7 @@ test compile-18.39 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode objmethod foo bar]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys initiallinenumber sourcefile"
+} -result $allbytecodekeys
 test compile-18.40 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble constructor
 } -match glob -result {wrong # args: should be "* constructor className"}
@@ -984,7 +985,7 @@ test compile-18.48 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode constructor foo]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys"
+} -result $allbytecodekeys
 # There is no compile-18.49
 test compile-18.50 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble destructor
@@ -1033,7 +1034,7 @@ test compile-18.58 {disassembler - basics} -setup {
     dict keys [tcl::unsupported::getbytecode destructor foo]
 } -cleanup {
     foo destroy
-} -result "$bytecodekeys"
+} -result $allbytecodekeys
 
 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/encoding.test b/tests/encoding.test
index e18e0f1..58f0956 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -1176,7 +1176,17 @@ test encoding-bug-66ffafd309-2-replace {Bug [66ffafd309] - invalid DBCS} -body {
     encoding convertfrom -profile replace jis0208 \x78\x79
 } -result \uFFFD\uFFFD
 
+test encoding-bug-201c7a3aa6-strict {Crash encoding non-BMP to iso2022} -body {
+    encoding convertto -profile strict iso2022 \U1f600
+} -result {unexpected character at index 0: 'U+01F600'} -returnCodes error
 
+test encoding-bug-201c7a3aa6-replace {Crash encoding non-BMP to iso2022} -body {
+    encoding convertto -profile replace iso2022 \U1f600
+} -result ?
+
+test encoding-bug-201c7a3aa6-tcl8 {Crash encoding non-BMP to iso2022} -body {
+    encoding convertto -profile tcl8 iso2022 \U1f600
+} -result ?
 
 # cleanup
 namespace delete ::tcl::test::encoding
diff --git a/tests/icu.test b/tests/icu.test
index bc29312..eabe3df 100644
--- a/tests/icu.test
+++ b/tests/icu.test
@@ -7,45 +7,54 @@ if {"::tcltest" ni [namespace children]} {
 
 # Force late loading of ICU if present
 catch {::tcl::unsupported::icu}
-testConstraint icu [expr {[info commands ::tcl::unsupported::icu::detect] ne ""}]
+testConstraint icu [llength [info commands ::tcl::unsupported::icu::detect]]
 
 namespace eval icu {
+    namespace path {::tcl::unsupported ::tcl::mathop}
+
     test icu-detect-0 {Return list of ICU encodings} -constraints icu -body {
-	set encoders [::tcl::unsupported::icu detect]
-	list [::tcl::mathop::in UTF-8 $encoders] [::tcl::mathop::in ISO-8859-1 $encoders]
+	set encoders [icu detect]
+	list [in UTF-8 $encoders] [in ISO-8859-1 $encoders]
     } -result {1 1}
-
     test icu-detect-1 {Guess encoding} -constraints icu -body {
-	::tcl::unsupported::icu detect [readFile [info script]]
+	icu detect [readFile [info script]]
     } -result ISO-8859-1
-
     test icu-detect-2 {Get all possible encodings} -constraints icu -body {
-	set encodings [::tcl::unsupported::icu detect [readFile [info script]] -all]
-	list [::tcl::mathop::in UTF-8 $encodings] [::tcl::mathop::in ISO-8859-1 $encodings]
+	set encodings [icu detect [readFile [info script]] -all]
+	list [in UTF-8 $encodings] [in ISO-8859-1 $encodings]
     } -result {1 1}
+    test icu-detect-3 {error case} -constraints icu -returnCodes error -body {
+	icu detect gorp gorp gorp
+    } -result {wrong # args: should be "icu detect ?bytes ?-all??"}
 
     test icu-tclToIcu-0 {Map Tcl encoding} -constraints icu -body {
 	# tis-620 because it is ambiguous in ICU on some platforms
 	# but should return the preferred encoding
-	list [::tcl::unsupported::icu tclToIcu utf-8] [::tcl::unsupported::icu tclToIcu tis-620] [::tcl::unsupported::icu tclToIcu shiftjis]
+	lmap enc {utf-8 tis-620 shiftjis} {
+	    icu tclToIcu $enc
+	}
     } -result {UTF-8 TIS-620 ibm-943_P15A-2003}
-
     test icu-tclToIcu-1 {Map Tcl encoding - no map} -constraints icu -body {
 	# Should not raise an error
-	::tcl::unsupported::icu tclToIcu dummy
+	icu tclToIcu dummy
     } -result {}
+    test icu-tclToIcu-2 {error case} -constraints icu -returnCodes error -body {
+	icu tclToIcu gorp gorp
+    } -result {wrong # args: should be "icu tclToIcu tclName"}
 
     test icu-icuToTcl-0 {Map ICU encoding} -constraints icu -body {
-       list [::tcl::unsupported::icu icuToTcl UTF-8] [::tcl::unsupported::icu icuToTcl TIS-620] [::tcl::unsupported::icu icuToTcl ibm-943_P15A-2003]
+	lmap enc {UTF-8 TIS-620 ibm-943_P15A-2003} {
+	    icu icuToTcl $enc
+	}
     } -result {utf-8 tis-620 cp932}
-
     test icu-icuToTcl-1 {Map ICU encoding - no map} -constraints icu -body {
 	# Should not raise an error
-	::tcl::unsupported::icu icuToTcl dummy
+	icu icuToTcl dummy
     } -result {}
-
+    test icu-icuToTcl-2 {error case} -constraints icu -returnCodes error -body {
+	icu icuToTcl gorp gorp
+    } -result {wrong # args: should be "icu icuToTcl icuName"}
 }
 
-
 namespace delete icu
 ::tcltest::cleanupTests
diff --git a/tests/oo.test b/tests/oo.test
index 769a96b..64d3d2a 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1753,6 +1753,19 @@ test oo-11.6.4 {OO: cleanup ReleaseClassContents() where class is mixed into one
     rename obj1 {}
 }
 
+test oo-11.7 {Bug 154f0982f2: createWithNamespace and an existing namespace} -setup {
+    oo::class create Aclass {
+	self export createWithNamespace
+	method ns {} {namespace current}
+    }
+} -body {
+    namespace eval test_oo117 {variable name [namespace current]}
+    list [Aclass createWithNamespace aInstance $test_oo117::name] [aInstance ns]
+} -returnCodes error -cleanup {
+    Aclass destroy
+    catch {namespace delete test_oo117}
+} -result {can't create namespace "::test_oo117": already exists}
+
 test oo-12.1 {OO: filters} {
     oo::class create Aclass
     Aclass create Aobject
@@ -3103,6 +3116,18 @@ test oo-19.4 {OO: varname ghosts [Bug 74b6110204]} -setup {
 } -cleanup {
     testClass destroy
 } -result {::testoo19_4::foo 0 ::testoo19_4::foo}
+test oo-19.5 {OO: varname array elements [Bug 2da1cb0c80]} -setup {
+    set obj [oo::object new]
+    oo::objdefine $obj export eval varname
+} -body {
+    $obj eval {
+	namespace upvar :: tcl_platform(platform) foo
+    }
+    $obj varname foo
+} -cleanup {
+    $obj destroy
+} -result ::tcl_platform(platform)
+# Test oo-19.5.1 is no longer relevant
 
 test oo-20.1 {OO: variable method} -body {
     oo::class create testClass {
@@ -3620,6 +3645,76 @@ test oo-22.6 {OO and coroutines and info frame: Bug 87271f7cd6} -body {
     catch {B destroy}
 } -match glob -result {{* method Work class ::A *} {* method Work class ::A *}}
 WorkerBase destroy
+test oo-22.7 {oo::define and info frame: correct argument line} -setup {
+    oo::class create C {
+	variable base
+	constructor {info} {set base [dict get $info line]}
+	method Relative {} {
+	    set info [next]
+	    if {![dict exists $info file]} {
+		error "no file-relative line info: $info"
+	    }
+	    expr {[dict get $info line] - $base}
+	}
+	filter Relative
+    }
+} -body {
+    C create o [info frame 0]
+    oo::define C {
+	method line1 {} {info frame 0}
+	method line2 {
+	} {info frame 0}
+	method line3 {
+	} {
+	    info frame 0
+	}
+    }
+    oo::define C method line4 {} {info frame 0}
+    oo::define C method line5 {
+    } {info frame 0}
+    oo::define C method line6 {
+    } {
+	info frame 0
+    }
+    list [o line1] [o line2] [o line3] [o line4] [o line5] [o line6]
+} -cleanup {
+    C destroy
+} -result {2 4 7 10 12 15}
+test oo-22.8 {oo::objdefine and info frame: correct argument line} -setup {
+    oo::class create C {
+	variable base
+	constructor {info} {set base [dict get $info line]}
+	method Relative {} {
+	    set info [next]
+	    if {![dict exists $info file]} {
+		error "no file-relative line info: $info"
+	    }
+	    expr {[dict get $info line] - $base}
+	}
+	filter Relative
+    }
+} -body {
+    C create o [info frame 0]
+    oo::objdefine o {
+	method line1 {} {info frame 0}
+	method line2 {
+	} {info frame 0}
+	method line3 {
+	} {
+	    info frame 0
+	}
+    }
+    oo::objdefine o method line4 {} {info frame 0}
+    oo::objdefine o method line5 {
+    } {info frame 0}
+    oo::objdefine o method line6 {
+    } {
+	info frame 0
+    }
+    list [o line1] [o line2] [o line3] [o line4] [o line5] [o line6]
+} -cleanup {
+    C destroy
+} -result {2 4 7 10 12 15}
 
 # Prove that the issue in [Bug 1865054] isn't an issue any more
 test oo-23.1 {Self-like derivation; complex case!} -setup {
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 3bbe1e9..899779c 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -96,11 +96,26 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
 } -cleanup {
     unset -nocomplain env(LANG)
 } -match regexp -result {^(iso8859-15?|utf-8)$}
+
+# unixInit-3.2 depends on the *spawned* [interpreter] being able to locate
+# tcl_library without setting of TCL_LIBRARY env. This in turn depends on
+# Tcl's "library" directory being under the parent or grandparent of the
+# executable directory (the initScript search path in tclInterp.c).
+# Thus this constraint. On GiuHub CI, the only time this is not true
+# is for the XCode builds.
+if {[string match [zipfs root]* [info library]] ||
+    [file isfile [file normalize [file join [info nameofexecutable] .. .. library init.tcl]]] ||
+    [file isfile [file normalize [file join [info nameofexecutable] .. .. .. library init.tcl]]]
+} {
+    tcltest::testConstraint enableUnixInit32 1
+} else {
+    tcltest::testConstraint enableUnixInit32 0
+}
 test unixInit-3.2 {TclpSetInitialEncodings} -setup {
     catch {set oldlc_all $env(LC_ALL)}
     catch {set oldtcl_library $env(TCL_LIBRARY)}
     unset -nocomplain env(TCL_LIBRARY)
-} -constraints {unix stdio knownBug} -body {
+} -constraints {unix stdio enableUnixInit32} -body {
     set env(LANG) japanese
     set env(LC_ALL) japanese
     set f [open "|[list [interpreter]]" w+]