Merge updates from core 8.5 branch.

9 files changed, 218 insertions, 38 deletions

diff --git a/tests/canvText.test b/tests/canvText.test
index 070011b..20a39b0 100644
--- a/tests/canvText.test
+++ b/tests/canvText.test
@@ -501,7 +501,7 @@ end
 %%EOF
 "
 
-test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
+test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} -body {
     catch {destroy .c}
     canvas .c
     pack .c
@@ -513,7 +513,9 @@ test canvText-18.1 {bug fix 2525, find enclosed on text with newlines} {
     incr y2
     update
     .c find enclosed 99 99 [expr $x2 + $i] [expr $y2 + 1]
-} 1
+} -cleanup {
+    unset -nocomplain bbox x2 y2
+} -result 1
 
 test canvText-19.1 {patch 1006286, leading space caused wrap under Win32} {
     catch {destroy .c}
diff --git a/tests/font.test b/tests/font.test
index 34e4b83..a02cc2e 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -15,9 +15,28 @@ toplevel .b
 wm geom .b +0+0
 update idletasks
 
+set defaultfontlist [font names]
+
+proc getnondefaultfonts {} {
+    global defaultfontlist
+    set nondeffonts [list ]
+    foreach afont [font names] {
+        if {$afont ni $defaultfontlist} {
+            lappend nondeffonts $afont
+        }
+    }
+    set nondeffonts
+}
+
+proc clearnondefaultfonts {} {
+    foreach afont [getnondefaultfonts] {
+        font delete $afont
+    }
+}
+
 proc setup {} {
     catch {destroy .b.f}
-    catch {eval font delete [font names]}
+    clearnondefaultfonts
     label .b.f 
     pack .b.f
     update
@@ -46,10 +65,9 @@ proc csetup {{str ""}} {
 
 setup
 
-case [tk windowingsystem] {
+switch [tk windowingsystem] {
     x11	 	{set fixed "fixed"}
     win32	{set fixed "courier 12"}
-    classic -
     aqua	{set fixed "monaco 9"}
 }
 
@@ -194,20 +212,20 @@ test font-6.1 {font command: create: make up name} {
     # (objc < 3) so name = NULL
     setup
     font create
-    font names
-} {font1}
+    expr {"font1" in [font names]}
+} {1}
 test font-6.2 {font command: create: name specified} {
     # not (objc < 3)
     setup
     font create xyz
-    font names
-} {xyz}
+    expr {"xyz" in [font names]}
+} {1}
 test font-6.3 {font command: create: name not really specified} {
     # (name[0] == '-') so name = NULL
     setup
     font create -family xyz
-    font names
-} {font1}
+    expr {"font1" in [font names]}
+} {1}
 test font-6.4 {font command: create: generate name} {
     # (name == NULL)
     setup
@@ -248,9 +266,9 @@ test font-7.2 {font command: delete: loop test} {
     font create c -underline 1
     font create d -underline 1
     font create e -underline 1
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
     font delete a e c b
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
 } {{a b c d e} d}
 test font-7.3 {font command: delete: loop test} {
     # (namedHashPtr == NULL) in middle of loop
@@ -261,9 +279,9 @@ test font-7.3 {font command: delete: loop test} {
     font create c -underline 1
     font create d -underline 1
     font create e -underline 1
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
     catch {font delete a d q c e b}
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
 } {{a b c d e} {b c e}}
 test font-7.4 {font command: delete: non-existent} {
     # (namedHashPtr == NULL) 
@@ -383,19 +401,19 @@ test font-11.1 {font command: names: arguments} {
 } {1 {wrong # args: should be "font names"}}
 test font-11.2 {font command: names: loop test: no passes} {
     setup
-    font names
+    getnondefaultfonts
 } {}
 test font-11.3 {font command: names: loop test: one pass} {
     setup
     font create
-    font names
+    getnondefaultfonts
 } {font1}
 test font-11.4 {font command: names: loop test: multiple passes} {
     setup
     font create xyz
     font create abc
     font create def
-    lsort [font names]
+    lsort [getnondefaultfonts]
 } {abc def xyz}
 test font-11.5 {font command: names: skip deletePending fonts} {
     # (nfPtr->deletePending == 0)
@@ -403,10 +421,10 @@ test font-11.5 {font command: names: skip deletePending fonts} {
     set x {}
     font create xyz
     font create abc
-    lappend x [lsort [font names]]
+    lappend x [lsort [getnondefaultfonts]]
     .b.f config -font xyz
     font delete xyz
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
 } {{abc xyz} abc}
 
 test font-12.1 {UpdateDependantFonts procedure: no users} {
@@ -433,9 +451,9 @@ test font-13.1 {CreateNamedFont: new named font} {
     # not (new == 0)
     setup
     set x {}
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
     font create xyz
-    lappend x [font names]
+    lappend x [getnondefaultfonts]
 } {{} xyz}
 test font-13.2 {CreateNamedFont: named font already exists} {
     # (new == 0)
@@ -587,8 +605,8 @@ test font-17.4 {Tk_FreeFont procedure: named font} {
     font create xyz
     .b.f config -font xyz
     destroy .b.f
-    font names
-} {xyz}
+    expr {"xyz" in [font names]}
+} {1}
 test font-17.5 {Tk_FreeFont procedure: named font} {
     # not (fontPtr->refCount == 0) 
     setup
@@ -1381,6 +1399,17 @@ setup
 
 destroy .b
 
+test font-47.1 {Bug f214b8ad5b} -body {
+    interp create one
+    interp create two
+    load {} Tk one
+    load {} Tk two
+    one eval menu .menubar
+    two eval menu .menubar
+    interp delete one
+    interp delete two
+} -result {}
+
 # cleanup
 cleanupTests
 return
diff --git a/tests/imgPPM.test b/tests/imgPPM.test
index a9e9dc0..8dec8c2 100644
--- a/tests/imgPPM.test
+++ b/tests/imgPPM.test
@@ -20,7 +20,7 @@ proc put {file data} {
     puts -nonewline $f $data
     close $f
 }
-
+
 test imgPPM-1.1 {FileReadPPM procedure} {
     put test.ppm "P6\n0 256\n255\nabcdef"
     list [catch {image create photo p1 -file test.ppm} msg] $msg
@@ -38,9 +38,9 @@ test imgPPM-1.4 {FileReadPPM procedure} {
     list [catch {image create photo p1 -file test.ppm} msg] $msg
 } {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
 test imgPPM-1.5 {FileReadPPM procedure} {
-    put test.ppm "P6\n10 20\n256\nabcdef"
+    put test.ppm "P6\n10 20\n100000\nabcdef"
     list [catch {image create photo p1 -file test.ppm} msg] $msg
-} {1 {PPM image file "test.ppm" has bad maximum intensity value 256}}
+} {1 {PPM image file "test.ppm" has bad maximum intensity value 100000}}
 test imgPPM-1.6 {FileReadPPM procedure} {
     put test.ppm "P6\n10 20\n0\nabcdef"
     list [catch {image create photo p1 -file test.ppm} msg] $msg
@@ -157,9 +157,78 @@ test imgPPM-4.1 {StringReadPPM procedure, data too short [Bug 1822391]} \
     -returnCodes error \
     -result {truncated PPM data}
 
+test imgPPM-5.1 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n0 256\n255\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.2 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n-2 256\n255\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.3 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n10 0\n255\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.4 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n10 -2\n255\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has dimension(s) <= 0}
+test imgPPM-5.5 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n10 20\n100000\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has bad maximum intensity value 100000}
+test imgPPM-5.6 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n10 20\n0\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {PPM image data has bad maximum intensity value 0}
+test imgPPM-5.7 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n10 10\n255\nabcdef"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {truncated PPM data}
+test imgPPM-5.8 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n5 4\n255\n01234567890123456789012345678901234567890123456789012345678"
+} -returnCodes error -cleanup {
+    image delete ppm
+} -result {truncated PPM data}
+test imgPPM-5.9 {StringReadPPM procedure} -setup {
+    image create photo ppm
+} -body {
+    ppm put "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
+    list [image width ppm] [image height ppm]
+} -cleanup {
+    image delete ppm
+} -result {5 4}
+
 eval image delete [image names]
 
 # cleanup
 catch {file delete test.ppm}
 cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/listbox.test b/tests/listbox.test
index 25bc606..b4046b6 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -2158,6 +2158,17 @@ test listbox-29.1 {listbox selection behavior, -state disabled} {
     lappend out [.l selection includes 2] [.l curselection]
 } {1 1 2}
 
+test listbox-30.1 {Bug 3607326} -setup {
+    destroy .l
+    unset -nocomplain a
+} -body {
+    array set a {}
+    listbox .l -listvariable a
+} -cleanup {
+    destroy .l
+    unset -nocomplain a
+} -result * -match glob -returnCodes error
+
 resetGridInfo
 deleteWindows
 option clear
diff --git a/tests/option.file1 b/tests/option.file1
index e64b6cc..32b4a18 100644
--- a/tests/option.file1
+++ b/tests/option.file1
@@ -14,4 +14,5 @@ ple
 # More comments, this time delimited by hash-marks.
 	# Comment-line with space.
 *x6:	  
+*x9: \ \	\\\101\n
 # comment line as last line of file.
diff --git a/tests/option.test b/tests/option.test
index 49d2975..1bfcb7c 100644
--- a/tests/option.test
+++ b/tests/option.test
@@ -197,13 +197,14 @@ test option-15.3 {database files} appNameIsTktest {option get . x2 color} green
 test option-15.4 {database files} {option get . x3 color} purple
 test option-15.5 {database files} {option get . {x 4} color} brown
 test option-15.6 {database files} {option get . x6 color} {}
-test option-15.7 {database files} {
+test option-15.7 {database files} {option get . x9 color} " \t\\A\n"
+test option-15.8 {database files} {
     list [catch {option read $option1 widget foo} msg] $msg
 } {1 {wrong # args: should be "option readfile fileName ?priority?"}}
 option add *x3 burgundy
 catch {option read $option1 userDefault}
-test option-15.8 {database files} {option get . x3 color} burgundy
-test option-15.9 {database files} {
+test option-15.9 {database files} {option get . x3 color} burgundy
+test option-15.10 {database files} {
     list [catch {option read $option2} msg] $msg
 } {1 {missing colon on line 2}}
 
diff --git a/tests/scale.test b/tests/scale.test
index 657f668..f8e58bb 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -387,6 +387,11 @@ test scale-6.20 {ComputeFormat procedure} {
     .s set 1001.23456789
     .s get
 } {1001.235}
+test scale-6.21 {ComputeFormat procedure} {
+    .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 200
+    .s set 1001.23456789
+    .s get
+} {1001.235}
 
 test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
     catch {destroy .s}
@@ -862,6 +867,40 @@ test scale-18.3 {Scale button 2 events [Bug 787065]} \
     } \
     -result {0 {}}
 
+test scale-19 {Bug [3529885fff] - Click in through goes in wrong direction} \
+    -setup {
+        catch {destroy .s}
+        catch {destroy .s1 .s2 .s3 .s4}
+        unset -nocomplain x1 x2 x3 x4 x y
+        scale .s1 -from 0 -to 100 -resolution 1  -variable x1 -digits 4 -orient horizontal -length 100
+        scale .s2 -from 0 -to 100 -resolution -1 -variable x2 -digits 4 -orient horizontal -length 100
+        scale .s3 -from 100 -to 0 -resolution 1  -variable x3 -digits 4 -orient horizontal -length 100
+        scale .s4 -from 100 -to 0 -resolution -1 -variable x4 -digits 4 -orient horizontal -length 100
+        pack .s1 .s2 .s3 .s4 -side left
+        update
+    } \
+    -body {
+        foreach {x y} [.s1 coord 50] {}
+        event generate .s1 <1> -x $x -y $y
+        event generate .s1 <ButtonRelease-1> -x $x -y $y
+        foreach {x y} [.s2 coord 50] {}
+        event generate .s2 <1> -x $x -y $y
+        event generate .s2 <ButtonRelease-1> -x $x -y $y
+        foreach {x y} [.s3 coord 50] {}
+        event generate .s3 <1> -x $x -y $y
+        event generate .s3 <ButtonRelease-1> -x $x -y $y
+        foreach {x y} [.s4 coord 50] {}
+        event generate .s4 <1> -x $x -y $y
+        event generate .s4 <ButtonRelease-1> -x $x -y $y
+        update
+        list $x1 $x2 $x3 $x4
+    } \
+    -cleanup {
+        unset x1 x2 x3 x4 x y
+        destroy .s1 .s2 .s3 .s4
+    } \
+    -result {1.0 1.0 1.0 1.0}
+
 catch {destroy .s}
 option clear
 
diff --git a/tests/textDisp.test b/tests/textDisp.test
index 8e99eff..70c7208 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -27,9 +27,10 @@ proc scrollError args {
 
 # Create entries in the option database to be sure that geometry options
 # like border width have predictable values.
-
-option add *Text.borderWidth 2
-option add *Text.highlightThickness 2
+set twbw 2
+set twht 2
+option add *Text.borderWidth $twbw
+option add *Text.highlightThickness $twht
 
 # The frame .f is needed to make sure that the overall window is always
 # fairly wide, even if the text window is very narrow.  This is needed
@@ -3366,7 +3367,7 @@ test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {textfonts
     .t2.t window create 1.1 -window .t2.t.f
     update
     list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list 0.0 [expr {14.0/30}]] 300x50+5+[expr {$fixedDiff + 18}] [list 12 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list 0.0 [expr {20.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
 test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts} {
     catch {destroy .t2}
     toplevel .t2
@@ -3379,10 +3380,11 @@ test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {textfonts
     .t2.t insert end 123
     frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
     .t2.t window create 1.1 -window .t2.t.f
+    update
     .t2.t xview scroll 1 unit
     update
     list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list [expr {1.0*$fixedWidth/300}] [expr {21.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - $fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - $fixedWidth}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
 test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfonts} {
     catch {destroy .t2}
     toplevel .t2
@@ -3394,6 +3396,7 @@ test textDisp-29.2.1 {miscellaneous: lines wrap but are still too long} {textfon
     pack .t2.s -side bottom -fill x
     .t2.t insert end 1\n
     .t2.t insert end [string repeat "abc" 30]
+    update
     .t2.t xview scroll 5 unit
     update
     .t2.t xview
@@ -3410,10 +3413,11 @@ test textDisp-29.2.2 {miscellaneous: lines wrap but are still too long} {textfon
     .t2.t insert end 123
     frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
     .t2.t window create 1.1 -window .t2.t.f
+    update
     .t2.t xview scroll 2 unit
     update
     list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {14.0/300}] [expr {154.0/300}]] 300x50+-9+[expr {$fixedDiff + 18}] {}]
+} [list [list [expr {2.0*$fixedWidth/300}] [expr {22.0*$fixedWidth/300}]] 300x50+[expr {$twbw + $twht + 1 - 2*$fixedWidth}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}]
 test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfonts} {
     catch {destroy .t2}
     toplevel .t2
@@ -3426,10 +3430,11 @@ test textDisp-29.2.3 {miscellaneous: lines wrap but are still too long} {textfon
     .t2.t insert end 123
     frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
     .t2.t window create 1.1 -window .t2.t.f
+    update
     .t2.t xview scroll 7 pixels
     update
     list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {7.0/300}] 0.49] 300x50+-2+[expr {$fixedDiff + 18}] [list 5 [expr {$fixedDiff + 68}] 7 $fixedHeight]]
+} [list [list [expr {7.0/300}] [expr {(20.0*$fixedWidth + 7)/300}]] 300x50+[expr {$twbw + $twht + 1 - 7}]+[expr {$twbw + $twht + $fixedHeight + 1}] [list [expr {$twbw + $twht + $fixedWidth + 1 - 7}] [expr {$twbw + $twht + $fixedHeight + 50 + 1}] $fixedWidth $fixedHeight]]
 test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfonts} {
     catch {destroy .t2}
     toplevel .t2
@@ -3442,10 +3447,11 @@ test textDisp-29.2.4 {miscellaneous: lines wrap but are still too long} {textfon
     .t2.t insert end 123
     frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
     .t2.t window create 1.1 -window .t2.t.f
+    update
     .t2.t xview scroll 17 pixels
     update
     list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
-} [list [list [expr {17.0/300}] [expr {157.0/300}]] 300x50+-12+[expr {$fixedDiff + 18}] {}]
+} [list [list [expr {17.0/300}] [expr {(20.0*$fixedWidth + 17)/300}]] 300x50+[expr {$twbw + $twht + 1 - 17}]+[expr {$twbw + $twht + $fixedHeight + 1}] {}]
 test textDisp-29.2.5 {miscellaneous: can show last character} {
     catch {destroy .t2}
     toplevel .t2
diff --git a/tests/textIndex.test b/tests/textIndex.test
index 6341b6d..28dc0df 100644
--- a/tests/textIndex.test
+++ b/tests/textIndex.test
@@ -214,9 +214,31 @@ set weirdTag "funny . +- 22.1\n\t{"
 set weirdMark "asdf \n{-+ 66.2\t"
 .t mark set $weirdMark 4.0
 .t tag config y -relief raised
+set weirdImage "foo-1"
+.t image create 2.1 -image [image create photo $weirdImage]
+set weirdEmbWin ".t.bar-1"
+entry $weirdEmbWin
+.t window create 3.1 -window $weirdEmbWin
 test textIndex-3.1 {TkTextGetIndex, weird mark names} {
     list [catch {.t index $weirdMark} msg] $msg
 } {0 4.0}
+test textIndex-3.2 {TkTextGetIndex, weird mark names} knownBug {
+    list [catch {.t index "$weirdMark -1char"} msg] $msg
+} {0 4.0}
+test textIndex-3.3 {TkTextGetIndex, weird embedded window names} {
+    list [catch {.t index $weirdEmbWin} msg] $msg
+} {0 3.1}
+test textIndex-3.4 {TkTextGetIndex, weird embedded window names} knownBug {
+    list [catch {.t index "$weirdEmbWin -1char"} msg] $msg
+} {0 3.0}
+test textIndex-3.5 {TkTextGetIndex, weird image names} {
+    list [catch {.t index $weirdImage} msg] $msg
+} {0 2.1}
+test textIndex-3.6 {TkTextGetIndex, weird image names} knownBug {
+    list [catch {.t index "$weirdImage -1char"} msg] $msg
+} {0 2.0}
+.t delete 3.1  ; # remove the weirdEmbWin
+.t delete 2.1  ; # remove the weirdImage
 
 test textIndex-4.1 {TkTextGetIndex, tags} {
     list [catch {.t index x.first} msg] $msg