blob: a7470df68db62a4a3d2d49922c4e32054c679e15 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
# This file is a Tcl script to test out the code in tkImgSVGnano.c, which reads
# and write SVG-format image files for photo widgets. The files is organized
# in the standard fashion for Tcl tests.
#
# Copyright (c) 2018 Rene Zaumseil
# All rights reserved.
package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands
imageInit
namespace eval svgnano {
variable data
set data(plus) {<svg xmlns="http://www.w3.org/2000/svg" width="100" height="100">
<path fill="none" stroke="#000000" d="M0 0 h16 v16 h-16 z"/>
<path fill="none" stroke="#000000" d="M8 4 v 8 M4 8 h 8"/>
<circle fill="yellow" stroke="red" cx="10" cy="80" r="10" />
<ellipse fill="none" stroke="blue" stroke-width="3" cx="60" cy="60" rx="10" ry="20" />
<line x1="10" y1="90" x2="50" y2="99"/>
<rect fill="none" stroke="green" x="20" y="20" width="60" height="50" rx="3" ry="3"/>
<polyline fill="red" stroke="purple" points="80,10 90,20 85,40"/>
<polygon fill ="yellow" points="80,80 70,85 90,90"/>
</svg>}
set data(bad) {<svg xmlns="http://www.w3.org/2000/svg" width="0" height="0:w
">
</svg>}
test imgSVGnano-1.1 {reading simple image} -setup {
catch {rename foo ""}
} -body {
image create photo foo -data $data(plus)
list [image width foo] [image height foo]
} -cleanup {
rename foo ""
} -result {100 100}
test imgSVGnano-1.2 {simple image with options} -setup {
catch {rename foo ""}
} -body {
image create photo foo -data $data(plus) -format {svg -dpi 100 -scale 3}
list [image width foo] [image height foo]
} -cleanup {
rename foo ""
} -result {300 300}
# test on crash found by Koen Danckaert
test imgSVGnano-1.3 {reformat image options} -setup {
catch {rename foo ""}
} -body {
image create photo foo -data $data(plus)
catch {foo configure -format {svg -scale}}
list {}
} -cleanup {
rename foo ""
} -result {{}}
test imgSVGnano-1.4 {image options} -setup {
catch {rename foo ""}
} -body {
image create photo foo -data $data(plus)
foo configure -format {svg -scale 2}
foo configure -format {svg -unit pt}
foo configure -format {svg -unit mm}
foo configure -format {svg -unit cm}
foo configure -format {svg -unit in}
foo configure -format {svg -unit px}
foo configure -format {svg -dpi 600}
list [image width foo] [image height foo]
} -cleanup {
rename foo ""
} -result {100 100}
test imgSVGnano-2.1 {reading a bad image} -body {
image create photo foo -format svg -data $data(bad)
} -returnCodes error -result {couldn't recognize image data}
test imgSVGnano-2.2 {using bad option} -body {
image create photo foo -data $data(plus) -format {svg -scale 0}
} -returnCodes error -result {-scale value must be positive}
test imgSVGnano-2.3 {using bad option} -body {
image create photo foo -data $data(plus)
foo configure -format {svg 1.0}
} -cleanup {
rename foo ""
} -returnCodes error -result {bad option "1.0": must be -dpi, -scale, or -unit}
};# end of namespace svgnano
namespace delete svgnano
imageFinish
cleanupTests
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:
|
