diff options
Diffstat (limited to 'tests/text.test')
| -rw-r--r-- | tests/text.test | 191 |
1 files changed, 156 insertions, 35 deletions
diff --git a/tests/text.test b/tests/text.test index 52a21af..8723d3d 100644 --- a/tests/text.test +++ b/tests/text.test @@ -883,7 +883,7 @@ test text-2.7 {Tk_TextCmd procedure} -constraints { } -body { catch {destroy .t} text .t - .t tag cget sel -relief + .t tag cget sel -relief } -cleanup { destroy .t } -result {flat} @@ -892,7 +892,7 @@ test text-2.8 {Tk_TextCmd procedure} -constraints { } -body { catch {destroy .t} text .t - .t tag cget sel -relief + .t tag cget sel -relief } -cleanup { destroy .t } -result {solid} @@ -901,7 +901,7 @@ test text-2.9 {Tk_TextCmd procedure} -constraints { } -body { catch {destroy .t} text .t - .t tag cget sel -relief + .t tag cget sel -relief } -cleanup { destroy .t } -result {raised} @@ -1989,7 +1989,7 @@ Line 7" .t tag configure elide -elide 1 .t tag add elide 5.2 5.4 .t window create 5.4 - .t delete 5.4 + .t delete 5.4 .t tag add elide 5.5 5.6 .t get -displaychars 5.2 5.8 } -cleanup { @@ -2871,7 +2871,7 @@ test text-11.9 {counting with tag priority eliding} -setup { lappend res [.t index "1.0 +1 indices"] lappend res [.t index "1.0 +1 display indices"] lappend res [.t index "1.0 +1 display chars"] - lappend res [.t index end] + lappend res [.t index end] lappend res [.t index "end -1 indices"] lappend res [.t index "end -1 display indices"] lappend res [.t index "end -1 display chars"] @@ -3043,7 +3043,7 @@ test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { vwait res ; # event dealt with by the event loop, with %d==0 i.e. we're out of sync # ensure the test is relevant lappend res "Pending:[.top.yt pendingsync]" - # - <<WidgetViewSync>> fires when sync returns if there was pending syncs + # - <<WidgetViewSync>> fires when sync returns if there was pending syncs # - there is no more any pending sync after running 'sync' .top.yt sync vwait res ; # event dealt with by the event loop, with %d==1 i.e. we're in sync again @@ -3053,6 +3053,25 @@ test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup { destroy .top.yt .top } -result {Sync:0 Pending:1 Sync:1 Pending:0} +test text-11a.51 {<<WidgetViewSync>> calls TkSendVirtualEvent(), + NOT Tk_HandleEvent(). + Bug [b362182e45704dd7bbd6aed91e48122035ea3d16]} -setup { + destroy .top.t .top +} -body { + set res {} + toplevel .top + pack [text .top.t] + for {set i 1} {$i < 10000} {incr i} { + .top.t insert end "Hello world!\n" + } + bind .top.t <<WidgetViewSync>> {destroy .top.t} + .top.t tag add mytag 1.5 8000.8 ; # shall not crash + update + set res "Still doing fine!" +} -cleanup { + destroy .top.t .top +} -result {Still doing fine!} + test text-12.1 {TextWidgetCmd procedure, "index" option} -setup { text .t } -body { @@ -3246,11 +3265,11 @@ test text-14.5 {ConfigureText procedure} -setup { .t configure -tabs {30 foo} } -cleanup { destroy .t -} -returnCodes {error} -result {bad tab alignment "foo": must be left, right, center, or numeric} +} -returnCodes {error} -result {bad tab alignment "foo": must be left, right, center, or numeric} test text-14.6 {ConfigureText procedure} -setup { text .t } -body { - catch {.t configure -tabs {30 foo}} + catch {.t configure -tabs {30 foo}} .t configure -tabs {10 20 30} return $errorInfo } -cleanup { @@ -3269,7 +3288,7 @@ test text-14.7 {ConfigureText procedure} -setup { destroy .t } -result {} test text-14.8 {ConfigureText procedure} -setup { - text .t + text .t } -body { .t configure -wrap bogus } -cleanup { @@ -3295,7 +3314,7 @@ test text-14.10 {ConfigureText procedure} -setup { destroy .t } -result {} test text-14.11 {ConfigureText procedure} -setup { - text .t + text .t } -body { .t configure -selectborderwidth foo } -cleanup { @@ -3385,7 +3404,7 @@ test text-14.18 {ConfigureText procedure} -constraints fonts -setup { toplevel .top text .top.t -font {Courier -12} -borderwidth 2 -highlightthickness 2 } -body { - .top.t configure -width 20 -height 10 + .top.t configure -width 20 -height 10 pack append .top .top.t top update set geom [wm geometry .top] @@ -3474,7 +3493,7 @@ test text-17.1 {TextCmdDeletedProc procedure} -body { test text-17.2 {TextCmdDeletedProc procedure, disabling -setgrid} -constraints { fonts } -body { - toplevel .top + toplevel .top text .top.t -borderwidth 2 -highlightthickness 2 -font {Courier -12 bold} \ -setgrid 1 -width 20 -height 10 pack .top.t @@ -3673,10 +3692,9 @@ Line 4" list [.t tag ranges sel] [.t get 1.0 end] } -cleanup { destroy .t -} -result {{1.0 4.0} {Line 1 +} -result {{1.0 3.5} {Line 1 abcde 12345 - }} test text-19.9 {DeleteChars procedure} -body { text .t @@ -4867,7 +4885,7 @@ test text-22.118 {TextSearchCmd, multiline matching end of window} -body { test text-22.119 {TextSearchCmd, multiline regexp matching} -body { pack [text .t] .t insert 1.0 { Tcl_Obj *objPtr)); -static Tcl_Obj* FSNormalizeAbsolutePath +static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" @@ -4884,7 +4902,7 @@ test text-22.120 {TextSearchCmd, multiline regexp matching} -body { pack [text .t] .t insert 1.0 {static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); -static Tcl_Obj* FSNormalizeAbsolutePath +static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" @@ -4898,7 +4916,7 @@ test text-22.121 {TextSearchCmd, multiline regexp matching} -body { .t insert 1.0 { static int SetFsPathFromAny _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr)); -static Tcl_Obj* FSNormalizeAbsolutePath +static Tcl_Obj* FSNormalizeAbsolutePath _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *pathPtr));} set markExpr "^(\[A-Za-z0-9~_\]+\[ \t\n\r\]*\\(|(\[^ \t\(#\n\r/@:\*\]\[^=\(\r\n\]*\[ \t\]+\\*?)?" append markExpr "(\[A-Za-z0-9~_\]+(<\[^>\]*>)?(::)?(\[A-Za-z0-9~_\]+::)*\[-A-Za-z0-9~_+ <>\|\\*/\]+|\[A-Za-z0-9~_\]+)" @@ -5891,7 +5909,7 @@ test text-23.7 {TkTextGetTabs procedure} -setup { test text-24.1 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump } -cleanup { destroy .t @@ -5899,7 +5917,7 @@ test text-24.1 {TextDumpCmd procedure, bad args} -body { test text-24.2 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump -all } -cleanup { destroy .t @@ -5907,7 +5925,7 @@ test text-24.2 {TextDumpCmd procedure, bad args} -body { test text-24.3 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump -command } -cleanup { destroy .t @@ -5915,7 +5933,7 @@ test text-24.3 {TextDumpCmd procedure, bad args} -body { test text-24.4 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump -bogus } -cleanup { destroy .t @@ -5923,7 +5941,7 @@ test text-24.4 {TextDumpCmd procedure, bad args} -body { test text-24.5 {TextDumpCmd procedure, bad args} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump bogus } -cleanup { destroy .t @@ -5960,7 +5978,7 @@ test text-24.9 {TextDumpCmd procedure, same indices} -body { test text-24.10 {TextDumpCmd procedure, negative range} -body { pack [text .t] .t insert 1.0 "One Line" - .t mark set insert 1.0 + .t mark set insert 1.0 .t dump 1.5 1.0 } -cleanup { destroy .t @@ -6189,7 +6207,7 @@ test text-27.2 {TextEditCmd procedure, argument parsing} -body { .t edit gorp } -cleanup { destroy .t -} -returnCodes {error} -result {bad edit option "gorp": must be modified, redo, reset, separator, or undo} +} -returnCodes {error} -result {bad edit option "gorp": must be canundo, canredo, modified, redo, reset, separator, or undo} test text-27.3 {TextEditUndo procedure, undoing changes} -body { text .t -undo 1 pack .t @@ -6281,7 +6299,7 @@ test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup { # Shouldn't require [update idle] to trigger event [Bug 1809538] lappend ::retval [.t edit modified] .t edit modified 1 - update idletasks + update lappend ::retval [.t edit modified] .t edit modified 1 ; # binding should only fire once [Bug 1799782] update idletasks @@ -6296,6 +6314,7 @@ test text-27.12 {<<Modified>> virtual event} -body { bind .t <<Modified>> "set ::retval modified" update idletasks .t insert end "nothing special\n" + update return $::retval } -cleanup { destroy .t @@ -6306,6 +6325,7 @@ test text-27.13 {<<Modified>> virtual event - insert before Modified} -body { bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] } update idletasks .t insert end "nothing special" + update return $::retval } -cleanup { destroy .t @@ -6318,10 +6338,26 @@ test text-27.14 {<<Modified>> virtual event - delete before Modified} -body { .t insert end "nothing special" .t edit modified 0 .t delete 1.0 1.2 + update set ::retval } -cleanup { destroy .t } -result {thing special} +test text-27.14a {<<Modified>> virtual event - propagation to peers} -body { +# Bug [fd3a4dc111], <<Modified>> event is not always sent to peers + set ::retval 0 + text .t -undo 1 + .t peer create .tt + pack .t .tt + bind .t <<Modified>> {incr ::retval} + bind .tt <<Modified>> {incr ::retval} + .t insert end "This increments ::retval once for each peer, i.e. twice." + .t edit modified 0 ; # shall increment twice as well, not just once + update + set ::retval +} -cleanup { + destroy .t .tt +} -result {4} test text-27.15 {<<Selection>> virtual event} -body { set ::retval no_selection pack [text .t -undo 1] @@ -6329,6 +6365,7 @@ test text-27.15 {<<Selection>> virtual event} -body { update idletasks .t insert end "nothing special\n" .t tag add sel 1.0 1.1 + update set ::retval } -cleanup { destroy .t @@ -6346,6 +6383,21 @@ test text-27.16 {-maxundo configuration option} -body { } -cleanup { destroy .t } -result "line 1\n\n" +test text-27.16a {undo configuration options with peers} -body { + text .t -undo 1 -autoseparators 0 -maxundo 100 + .t peer create .tt + set res [.t cget -undo] + lappend res [.tt cget -undo] + lappend res [.t cget -autoseparators] + lappend res [.tt cget -autoseparators] + lappend res [.t cget -maxundo] + lappend res [.tt cget -maxundo] + .t insert end "The undo stack is common between peers" + lappend res [.t edit canundo] + lappend res [.tt edit canundo] +} -cleanup { + destroy .t +} -result {1 1 0 0 100 100 1 1} test text-27.17 {bug fix 1536735 - undo with empty text} -body { text .t -undo 1 set r [.t edit modified] @@ -6368,7 +6420,7 @@ test text-27.18 {patch 1469210 - inserting after undo} -setup { } -cleanup { destroy .t } -result 1 -test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup { +test text-27.19 {patch 1669632 (i) - undo after <Control-1>} -setup { destroy .t } -body { text .t -undo 1 @@ -6382,7 +6434,7 @@ test text-25.19 {patch 1669632 (i) - undo after <Control-1>} -setup { } -cleanup { destroy .t } -result WORLD -test text-25.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { +test text-27.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { destroy .top .top.t } -body { toplevel .top @@ -6401,7 +6453,7 @@ test text-25.20 {patch 1669632 (iv) - undo after <<SelectNone>>} -setup { } -cleanup { destroy .top.t .top } -result HELLO -test text-25.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup { +test text-27.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -setup { destroy .t } -body { text .t -undo 1 @@ -6417,7 +6469,7 @@ test text-25.21 {patch 1669632 (vii) - <<Undo>> shall not remove separators} -se } -cleanup { destroy .t } -result "This WORLD is an example text" -test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { +test text-27.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { destroy .t } -body { toplevel .top @@ -6437,7 +6489,7 @@ test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { } -cleanup { destroy .top.t .top } -result "This A an example text" - test text-25.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { + test text-27.23 {patch 1669632 (v) - <<Cut>> is atomic} -setup { destroy .t } -body { toplevel .top @@ -6457,6 +6509,75 @@ test text-25.22 {patch 1669632 (v) - <<Clear>> is atomic} -setup { } -cleanup { destroy .top.t .top } -result "This A an example text" +test text-27.24 {TextEditCmd procedure, canundo and canredo} -setup { + destroy .t + set res {} +} -body { + text .t -undo false -autoseparators false + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo true + lappend res [.t edit canundo] [.t edit canredo] + .t insert end "DO\n" + .t edit separator + .t insert end "IT\n" + .t insert end "YOURSELF\n" + .t edit separator + lappend res [.t edit canundo] [.t edit canredo] + .t edit undo + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo false + lappend res [.t edit canundo] [.t edit canredo] + .t configure -undo true + lappend res [.t edit canundo] [.t edit canredo] + .t edit redo + lappend res [.t edit canundo] [.t edit canredo] +} -cleanup { + destroy .t +} -result {0 0 0 0 1 0 1 1 0 0 1 1 1 0} +test text-27.25 {<<UndoStack>> virtual event} -setup { + destroy .t + set res {} + set nbUS 0 +} -body { + text .t -undo false -autoseparators false + bind .t <<UndoStack>> {incr nbUS} + update ; lappend res $nbUS + .t configure -undo true + update ; lappend res $nbUS + .t insert end "DO\n" + .t edit separator + .t insert end "IT\n" + .t insert end "YOURSELF\n" + .t edit separator + .t insert end "MAN\n" + .t edit separator + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit redo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit undo + update ; lappend res $nbUS + .t edit reset + update ; lappend res $nbUS +} -cleanup { + destroy .t +} -result {0 0 1 2 3 4 4 5 6 6 7 8 8 9} + test text-28.1 {bug fix - 624372, ControlUtfProc long lines} -body { pack [text .t -wrap none] @@ -6726,7 +6847,7 @@ test text-31.14 {peer widgets} -setup { for {set i 1} {$i < 20} {incr i} { .t insert end "Line $i\n" } - .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + .t tag add sel 1.0 3.0 5.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 lappend res [.t tag prevrange sel 1.0] .t configure -start 6 -end 12 lappend res [.t tag ranges sel] @@ -6747,7 +6868,7 @@ test text-31.15 {peer widgets} -setup { for {set i 1} {$i < 20} {incr i} { .t insert end "Line $i\n" } - .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0 + .t tag add sel 1.0 3.0 9.0 11.0 13.0 15.0 17.0 19.0 .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -6767,7 +6888,7 @@ test text-31.16 {peer widgets} -setup { for {set i 1} {$i < 20} {incr i} { .t insert end "Line $i\n" } - .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 + .t tag add sel 1.0 7.0 9.0 11.0 13.0 15.0 17.0 19.0 .t configure -start 6 -end 12 lappend res [.t tag ranges sel] lappend res "next" [.t tag nextrange sel 4.0] \ @@ -6812,7 +6933,7 @@ test text-31.18 {peer widgets} -setup { return $res } -cleanup { destroy .t -} -result {1.0 11.0} +} -result {1.0 11.0} test text-31.19 {peer widgets} -body { pack [text .t] for {set i 1} {$i < 20} {incr i} { @@ -6857,7 +6978,7 @@ test text-32.1 {line heights on creation} -setup { update set after [$w count -ypixels 1.0 2.0] destroy .g - expr {$before eq $after} + expr {$before eq $after} } -cleanup { destroy .t } -result {1} |