OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tk/] [tests/] [clipboard.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test out Tk's clipboard management code,
2 
# especially the "clipboard" command.  It is organized in the standard
3 
# fashion for Tcl tests.
4 
#
5 
# Copyright (c) 1994 Sun Microsystems, Inc.
6 
#
7 
# See the file "license.terms" for information on usage and redistribution
8 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9 
#
10 
# RCS: @(#) $Id: clipboard.test,v 1.1.1.1 2002-01-16 10:25:58 markom Exp $
11 
 
12 
#
13 
# Note: Multiple display clipboard handling will only be tested if the
14 
# environment variable TK_ALT_DISPLAY is set to an alternate display.
15 
#
16 
 
17 
if {[string compare test [info procs test]] == 1} {
18 
    source defs
19 
}
20 
 
21 
eval destroy [winfo child .]
22 
 
23 
# set up a very large buffer to test INCR retrievals
24 
set longValue ""
25 
foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} {
26 
    set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
27 
    append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
28 
}
29 
 
30 
# Now we start the main body of the test code
31 
 
32 
test clipboard-1.1 {ClipboardHandler procedure} {
33 
    clipboard clear
34 
    clipboard append "test"
35 
    selection get -s CLIPBOARD
36 
} {test}
37 
test clipboard-1.2 {ClipboardHandler procedure} {
38 
    clipboard clear
39 
    clipboard append "test"
40 
    clipboard append "ing"
41 
    selection get -s CLIPBOARD
42 
} {testing}
43 
test clipboard-1.3 {ClipboardHandler procedure} {
44 
    clipboard clear
45 
    clipboard append "t"
46 
    clipboard append "e"
47 
    clipboard append "s"
48 
    clipboard append "t"
49 
    selection get -s CLIPBOARD
50 
} {test}
51 
test clipboard-1.4 {ClipboardHandler procedure} {
52 
    clipboard clear
53 
    clipboard append $longValue
54 
    selection get -s CLIPBOARD
55 
} "$longValue"
56 
test clipboard-1.5 {ClipboardHandler procedure} {
57 
    clipboard clear
58 
    clipboard append $longValue
59 
    clipboard append "test"
60 
    selection get -s CLIPBOARD
61 
} "${longValue}test"
62 
test clipboard-1.6 {ClipboardHandler procedure} {
63 
    clipboard clear
64 
    clipboard append -t TEST $longValue
65 
    clipboard append -t STRING "test"
66 
    list [selection get -s CLIPBOARD -t STRING] \
67 
        [selection get -s CLIPBOARD -t TEST]
68 
} [list test $longValue]
69 
test clipboard-1.7 {ClipboardHandler procedure} {
70 
    clipboard clear
71 
    clipboard append -t TEST [string range $longValue 1 4000]
72 
    clipboard append -t STRING "test"
73 
    list [selection get -s CLIPBOARD -t STRING] \
74 
        [selection get -s CLIPBOARD -t TEST]
75 
} [list test [string range $longValue 1 4000]]
76 
test clipboard-1.8 {ClipboardHandler procedure} {
77 
    clipboard clear
78 
    clipboard append ""
79 
    selection get -s CLIPBOARD
80 
} {}
81 
test clipboard-1.9 {ClipboardHandler procedure} {
82 
    clipboard clear
83 
    clipboard append ""
84 
    clipboard append "Test"
85 
    selection get -s CLIPBOARD
86 
} {Test}
87 
 
88 
##############################################################################
89 
 
90 
test clipboard-2.1 {ClipboardAppHandler procedure} {
91 
    set oldAppName [tk appname]
92 
    tk appname UnexpectedName
93 
    clipboard clear
94 
    clipboard append -type NEW_TYPE Data
95 
    set result [selection get -selection CLIPBOARD -type TK_APPLICATION]
96 
    tk appname $oldAppName
97 
    set result
98 
} {UnexpectedName}
99 
 
100 
##############################################################################
101 
 
102 
test clipboard-3.1 {ClipboardWindowHandler procedure} {
103 
    set oldAppName [tk appname]
104 
    tk appname UnexpectedName
105 
    clipboard clear
106 
    clipboard append -type NEW_TYPE Data
107 
    set result [selection get -selection CLIPBOARD -type TK_WINDOW]
108 
    tk appname $oldAppName
109 
    set result
110 
} {.}
111 
 
112 
##############################################################################
113 
 
114 
test clipboard-4.1 {ClipboardLostSel procedure} {
115 
    clipboard clear
116 
    clipboard append "Test"
117 
    selection clear -s CLIPBOARD
118 
    list [catch {selection get -s CLIPBOARD} msg] $msg
119 
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}
120 
test clipboard-4.2 {ClipboardLostSel procedure} {
121 
    clipboard clear
122 
    clipboard append "Test"
123 
    clipboard append -t TEST "Test2"
124 
    selection clear -s CLIPBOARD
125 
    list [catch {selection get -s CLIPBOARD} msg] $msg \
126 
        [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
127 
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
128 
test clipboard-4.3 {ClipboardLostSel procedure} {
129 
    clipboard clear
130 
    clipboard append "Test"
131 
    clipboard append -t TEST "Test2"
132 
    clipboard append "Test3"
133 
    selection clear -s CLIPBOARD
134 
    list [catch {selection get -s CLIPBOARD} msg] $msg \
135 
        [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
136 
} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
137 
 
138 
##############################################################################
139 
 
140 
test clipboard-5.1 {Tk_ClipboardClear procedure} {
141 
    clipboard clear
142 
    clipboard append -t TEST "test"
143 
    set result [lsort [selection get -s CLIPBOARD TARGETS]]
144 
    clipboard clear
145 
    list $result [lsort [selection get -s CLIPBOARD TARGETS]]
146 
} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
147 
test clipboard-5.2 {Tk_ClipboardClear procedure} {
148 
    clipboard clear
149 
    clipboard append -t TEST "test"
150 
    set result [lsort [selection get -s CLIPBOARD TARGETS]]
151 
    selection own -s CLIPBOARD .
152 
    lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
153 
    clipboard clear
154 
    clipboard append -t TEST "test"
155 
    lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
156 
} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
157 
 
158 
##############################################################################
159 
 
160 
test clipboard-6.1 {Tk_ClipboardAppend procedure} {
161 
    clipboard clear
162 
    clipboard append "first chunk"
163 
    selection own -s CLIPBOARD .
164 
    list [catch {
165 
        clipboard append " second chunk"
166 
        selection get -s CLIPBOARD
167 
    } msg] $msg
168 
} {0 {first chunk second chunk}}
169 
test clipboard-6.2 {Tk_ClipboardAppend procedure} {unixOnly} {
170 
    setupbg
171 
    clipboard clear
172 
    clipboard append -f INTEGER -t TEST "16"
173 
    set result [dobg {selection get -s CLIPBOARD TEST}]
174 
    cleanupbg
175 
    set result
176 
} {0x10}
177 
test clipboard-6.3 {Tk_ClipboardAppend procedure} {
178 
    clipboard clear
179 
    clipboard append -f INTEGER -t TEST "16"
180 
    list [catch {clipboard append -t TEST "test"} msg] $msg
181 
} {1 {format "STRING" does not match current format "INTEGER" for TEST}}
182 
 
183 
##############################################################################
184 
 
185 
test clipboard-7.1 {Tk_ClipboardCmd procedure} {
186 
    list [catch {clipboard} msg] $msg
187 
} {1 {wrong # args: should be "clipboard option ?arg arg ...?"}}
188 
test clipboard-7.2 {Tk_ClipboardCmd procedure} {
189 
    clipboard clear
190 
    list [catch {clipboard append --} msg] $msg \
191 
            [selection get -selection CLIPBOARD]
192 
} {0 {} --}
193 
test clipboard-7.3 {Tk_ClipboardCmd procedure} {
194 
    clipboard clear
195 
    list [catch {clipboard append -- information} msg] $msg \
196 
            [selection get -selection CLIPBOARD]
197 
} {0 {} information}
198 
test clipboard-7.4 {Tk_ClipboardCmd procedure} {
199 
    list [catch {clipboard append --x a b} msg] $msg
200 
} {1 {unknown option "--x"}}
201 
test clipboard-7.5 {Tk_ClipboardCmd procedure} {
202 
    list [catch {clipboard append -- a b} msg] $msg
203 
} {1 {wrong # args: should be "clipboard append ?options? data"}}
204 
test clipboard-7.6 {Tk_ClipboardCmd procedure} {
205 
    clipboard clear
206 
    list [catch {clipboard append -format} msg] $msg \
207 
            [selection get -selection CLIPBOARD]
208 
} {0 {} -format}
209 
test clipboard-7.7 {Tk_ClipboardCmd procedure} {
210 
    list [catch {clipboard append -displayofoo f} msg] $msg
211 
} {1 {unknown option "-displayofoo"}}
212 
test clipboard-7.8 {Tk_ClipboardCmd procedure} {
213 
    list [catch {clipboard append -type TEST} msg] $msg
214 
} {1 {wrong # args: should be "clipboard append ?options? data"}}
215 
test clipboard-7.9 {Tk_ClipboardCmd procedure} {
216 
    list [catch {clipboard append -displayof foo "test"} msg] $msg
217 
} {1 {bad window path name "foo"}}
218 
 
219 
test clipboard-7.10 {Tk_ClipboardCmd procedure} {
220 
    list [catch {clipboard clear -displayof} msg] $msg
221 
} {1 {value for "-displayof" missing}}
222 
test clipboard-7.11 {Tk_ClipboardCmd procedure} {
223 
    list [catch {clipboard clear -displayofoo f} msg] $msg
224 
} {1 {unknown option "-displayofoo"}}
225 
test clipboard-7.12 {Tk_ClipboardCmd procedure} {
226 
    list [catch {clipboard clear foo} msg] $msg
227 
} {1 {wrong # args: should be "clipboard clear ?options?"}}
228 
test clipboard-7.13 {Tk_ClipboardCmd procedure} {
229 
    list [catch {clipboard clear -displayof foo} msg] $msg
230 
} {1 {bad window path name "foo"}}
231 
 
232 
test clipboard-7.14 {Tk_ClipboardCmd procedure} {
233 
    list [catch {clipboard error} msg] $msg
234 
} {1 {bad option "error": must be clear or append}}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.