1 | # Commands covered: |
---|
2 | # Rappture::GeoMapLayer |
---|
3 | # |
---|
4 | # This file contains a collection of tests for one of the Rappture Tcl |
---|
5 | # commands. Sourcing this file into Tcl runs the tests and |
---|
6 | # generates output for errors. No output means no errors were found. |
---|
7 | # |
---|
8 | # ====================================================================== |
---|
9 | # AUTHOR: Derrick Kearney, Purdue University |
---|
10 | # Copyright (c) 2004-2015 HUBzero Foundation, LLC |
---|
11 | # |
---|
12 | # See the file "license.terms" for information on usage and redistribution |
---|
13 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
14 | |
---|
15 | |
---|
16 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
17 | package require tcltest |
---|
18 | package require RapptureGUI |
---|
19 | namespace import -force ::tcltest::* |
---|
20 | } |
---|
21 | catch {unset lib} |
---|
22 | |
---|
23 | proc check {var size} { |
---|
24 | set l [llength $var] |
---|
25 | if {$l != $size} { |
---|
26 | return "length mismatch: should have been $size, was $l" |
---|
27 | } |
---|
28 | for {set i 0} {$i < $size} {set i [expr $i+1]} { |
---|
29 | set j [lindex $var $i] |
---|
30 | if {$j != "item $i"} { |
---|
31 | return "element $i should have been \"item $i\", was \"$j\"" |
---|
32 | } |
---|
33 | } |
---|
34 | return ok |
---|
35 | } |
---|
36 | |
---|
37 | set provider [Rappture::GeoMapDataProviderXYZ #auto {http://myurl.com/}] |
---|
38 | |
---|
39 | #---------------------------------------------------------- |
---|
40 | #---------------------------------------------------------- |
---|
41 | # constructor command |
---|
42 | # Rappture::GeoMapLayer <name> <provider> \ |
---|
43 | # ?-label <label>? \ |
---|
44 | # ?-description <desc>? \ |
---|
45 | # ?-attribution <attrib>? \ |
---|
46 | # ?-visibility <visibility>? \ |
---|
47 | # ?-opacity <opacity>? \ |
---|
48 | # ?-placardattributes <attributes>? \ |
---|
49 | # ?-placardstyle <style>? \ |
---|
50 | # ?-placardpadding <padding>? |
---|
51 | #---------------------------------------------------------- |
---|
52 | test geomaplayer-1.1 {Rappture::GeoMapLayer, 0 arguments} { |
---|
53 | list [catch {Rappture::GeoMapLayer} msg] $msg |
---|
54 | } {0 {}} |
---|
55 | |
---|
56 | test geomaplayer-1.2 {Rappture::GeoMapLayer, 1 arguments} { |
---|
57 | list [catch {Rappture::GeoMapLayer name $provider} msg] $msg |
---|
58 | } {0 name} |
---|
59 | |
---|
60 | |
---|
61 | #---------------------------------------------------------- |
---|
62 | # export command |
---|
63 | #---------------------------------------------------------- |
---|
64 | |
---|
65 | set l1 [Rappture::GeoMapLayer #auto $provider] |
---|
66 | |
---|
67 | test geomaplayer-11.0 {Rappture::GeoMapLayer, export (default format)} { |
---|
68 | set t [$l1 export] |
---|
69 | list [catch {lindex [$t dump 0] 3} msg] $msg |
---|
70 | } {0 {type image driver xyz cache true attribution {} xyz.url http://myurl.com/ label {} description {} visible true opacity 1.0 placard {attrlist {} style {fill: #B6B6B688; text-fill: #000000; text-size: 12.0;} padding 5}}} |
---|
71 | |
---|
72 | test geomaplayer-11.1 {Rappture::GeoMapLayer, export bad format} { |
---|
73 | list [catch {$l1 export -format blahh} msg] $msg |
---|
74 | } {1 {bad format "blahh": should be one of blt_tree}} |
---|
75 | |
---|
76 | test geomaplayer-11.2 {Rappture::GeoMapLayer, export -format blt_tree} { |
---|
77 | set t [$l1 export -format blt_tree] |
---|
78 | list [catch {lindex [$t dump 0] 3} msg] $msg |
---|
79 | } {0 {type image driver xyz cache true attribution {} xyz.url http://myurl.com/ label {} description {} visible true opacity 1.0 placard {attrlist {} style {fill: #B6B6B688; text-fill: #000000; text-size: 12.0;} padding 5}}} |
---|
80 | |
---|
81 | |
---|
82 | #---------------------------------------------------------- |
---|
83 | # -placardattributes flag validation |
---|
84 | #---------------------------------------------------------- |
---|
85 | |
---|
86 | set l2 [Rappture::GeoMapLayer #auto $provider] |
---|
87 | |
---|
88 | test geomaplayer-12.1 {-placardattributes string} { |
---|
89 | set err [catch {$l2 configure -placardattributes {name Name aland "Land Area"}} msg] |
---|
90 | catch {$l2 cget -placardattributes} stored |
---|
91 | list $err $msg $stored |
---|
92 | } {0 {} {name Name aland "Land Area"}} |
---|
93 | |
---|
94 | test geomaplayer-12.2 {-placardattributes string with extra spaces} { |
---|
95 | set err [catch {$l2 configure -placardattributes "name Name\naland LandArea"} msg] |
---|
96 | catch {$l2 cget -placardattributes} stored |
---|
97 | list $err $msg $stored |
---|
98 | } {0 {} {name Name aland LandArea}} |
---|
99 | |
---|
100 | |
---|
101 | |
---|
102 | #---------------------------------------------------------- |
---|
103 | # -placardstyle flag validation |
---|
104 | #---------------------------------------------------------- |
---|
105 | |
---|
106 | test geomaplayer-13.1 {-placardstyle string} { |
---|
107 | set err [catch {$l2 configure -placardstyle {fill: #00FF0088;}} msg] |
---|
108 | catch {$l2 cget -placardstyle} stored |
---|
109 | list $err $msg $stored |
---|
110 | } {0 {} {fill: #00FF0088;}} |
---|
111 | |
---|
112 | test geomaplayer-13.2 {-placardstyle string with extra spaces} { |
---|
113 | set err [catch {$l2 configure -placardstyle "fill:\t#00FF0088;"} msg] |
---|
114 | catch {$l2 cget -placardstyle} stored |
---|
115 | list $err $msg $stored |
---|
116 | } {0 {} {fill: #00FF0088;}} |
---|
117 | |
---|
118 | test geomaplayer-13.3 {-placardstyle empty string sets widget default} { |
---|
119 | set err [catch {$l2 configure -placardstyle ""} msg] |
---|
120 | catch {$l2 cget -placardstyle} stored |
---|
121 | list $err $msg $stored |
---|
122 | } {0 {} {fill: #B6B6B688; text-fill: #000000; text-size: 12.0;}} |
---|
123 | |
---|
124 | |
---|
125 | #---------------------------------------------------------- |
---|
126 | # -placardpadding flag validation |
---|
127 | #---------------------------------------------------------- |
---|
128 | |
---|
129 | test geomaplayer-14.1 {-placardpadding integer} { |
---|
130 | set err [catch {$l2 configure -placardpadding 7} msg] |
---|
131 | catch {$l2 cget -placardpadding} stored |
---|
132 | list $err $msg $stored |
---|
133 | } {0 {} 7} |
---|
134 | |
---|
135 | test geomaplayer-14.2 {-placardpadding double} { |
---|
136 | list [catch {$l2 configure -placardpadding 8.0} msg] $msg |
---|
137 | } {1 {bad value "8.0": placardpadding should be a positive integer}} |
---|
138 | |
---|
139 | test geomaplayer-14.3 {-placardpadding negative integer} { |
---|
140 | list [catch {$l2 configure -placardpadding -5} msg] $msg |
---|
141 | } {1 {bad value "-5": placardpadding should be a positive integer}} |
---|
142 | |
---|
143 | |
---|
144 | |
---|
145 | |
---|
146 | # TODO: |
---|
147 | |
---|
148 | ::tcltest::cleanupTests |
---|
149 | return |
---|
150 | |
---|