1# This file is a Tcl script to test out [incr Widgets] Scrolledhtml class. 2# It is organized in the standard fashion for Tcl tests with the following 3# notation for test case labels: 4# 5# 1.x - Construction/Destruction tests 6# 2.x - Configuration option tests 7# 3.x - Method tests 8# 9# Copyright (c) 1995 DSC Technologies Corporation 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14# @(#) $Id: scrolledhtml.test 15 16package require tcltest 17namespace import -force ::tcltest::* 18 19if [catch {package require Iwidgets 4.0}] { 20 # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY 21 # env var is initialized in the Makefile when doing a 'make test'. 22 # If sourcing this file independently, this variable must be set manually. 23 if ![info exists env(IWIDGETS_LIBRARY)] { 24 error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ 25 environment\nvariable to the directory that contains iwidgets.tcl" 26 } 27 lappend auto_path $env(IWIDGETS_LIBRARY) 28 package require Iwidgets 4.0 29} 30 31if {[string compare test [info procs test]] == 1} { 32 source defs 33} 34 35wm geometry . {} 36raise . 37 38set c 1 39set o 1 40set m 1 41 42# 43# Initial construction test 44# 45test Scrolledhtml-1.$c {Scrolledhtml construction} { 46 iwidgets::Scrolledhtml .sh 47 pack .sh -padx 10 -pady 10 -fill both -expand yes 48 update 49} {} 50 51incr c 52 53# 54# Option tests which are successful. 55# 56test Scrolledhtml-2.$o {configuration option} { 57 llength [.sh configure] 58} {60} 59 60incr o 61 62foreach test { 63 {-background #d9d9d9 #d9d9d9} 64 {-borderwidth 3 3} 65 {-cursor gumby gumby} 66 {-exportselection 0 0} 67 {-exportselection 1 1} 68 {-foreground Black Black} 69 {-height 120 120} 70 {-width 500 500} 71 {-insertbackground Black Black} 72 {-insertborderwidth 1 1} 73 {-insertofftime 200 200} 74 {-insertontime 500 500} 75 {-insertwidth 3 3} 76 {-labelmargin 5 5} 77 {-labeltext Label Label} 78 {-labelpos n n} 79 {-labelpos ne ne} 80 {-labelpos e e} 81 {-labelpos se se} 82 {-labelpos s s} 83 {-labelpos sw sw} 84 {-labelpos w w} 85 {-labelpos nw nw} 86 {-relief raised raised} 87 {-relief sunken sunken} 88 {-vscrollmode none none} 89 {-vscrollmode static static} 90 {-vscrollmode dynamic dynamic} 91 {-hscrollmode none none} 92 {-hscrollmode static static} 93 {-hscrollmode dynamic dynamic} 94 {-sbwidth 20 20} 95 {-scrollmargin 5 5} 96 {-selectborderwidth 2 2} 97 {-state disabled disabled} 98 {-state normal normal} 99 {-sticky w w} 100 {-sticky nw nw} 101 {-sticky n n} 102 {-sticky ne ne} 103 {-sticky e e} 104 {-sticky se se} 105 {-sticky s s} 106 {-sticky sw sw} 107 {-sticky news news} 108 {-textbackground GhostWhite GhostWhite} 109 {-visibleitems 72x40 72x40} 110 {-height 0 0} 111 {-width 0 0} 112 {-wrap char char} 113 {-wrap none none} 114 {-feedback puts puts} 115 {-feedback {} {}} 116 {-linkcommand puts puts} 117 {-linkcommand {} {}} 118 {-unknownimage {} {}} 119 {-link blue blue} 120 {-linkhighlight red red} 121 {-fontname times times} 122 {-fixedfont courier courier} 123 {-fontsize medium medium} 124 {-update 1 1}} { 125 set option [lindex $test 0] 126 test Scrolledhtml-2.$o "configuration options, $option" { 127 .sh configure $option [lindex $test 1] 128 lindex [.sh configure $option] 4 129 } [lindex $test 2] 130 update 131 incr o 132} 133 134# 135# Option tests which fail and produce errors. 136# 137foreach test { 138 {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}} 139 {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}} 140 {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}} 141 {-fontname bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}} 142 {-fontsize bogus {bad fontsize option "bogus": should be small, medium, large, or huge}} 143 {-fixedfont bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}} { 144 set option [lindex $test 0] 145 test Scrolledhtml-2.$o "configuration options, $option" { 146 list [catch {.sh configure $option [lindex $test 1]} msg] $msg 147 } [list 1 [lindex $test 2]] 148 incr o 149} 150 151# 152# Method tests which are successful. 153# 154foreach test { 155 {{.sh import ./scrolledhtml.test} {}} 156 {{.sh pwd} {.}} 157 {{.sh export /tmp/scrolledhtml.test} {}} 158 {{.sh render { 159 <title>Test</title> 160 <body bgcolor="#000000" link="#40a0f0" text="#00d0d0" background="notyet.gif"> 161 <h1>This is a test</h1> 162 <strong>of the emergency broadcast system.</strong> 163 <em>This is only a test.</em><p> 164 <tt>If this were a real html document</tt><br> 165 <pre>it would be displayed</pre><br> 166 <center>for more than an instant</center> 167 <blockquote>Four score and seven years ago</blockquote> 168 <code>int main { printf(\"Hello World!\");}</code> 169 <dl><dt>write only memory 170 <dd>the obvious antonym to read-only memory</dl> 171 <ol>reasons this is a short list:<li>it only has one entry</ol> 172 <ul>reasons this is a short list:<li>it only has one entry</ul> 173 <a name="linktome" href="./test.html#linktome"> 174 <img src="invalid.filename" alt="No_image_here" width=100 height=100> 175 </a> 176 </body> 177 }} {}} 178 {{.sh title} {Test}} 179 {{.sh clear} {}}} { 180 set method [lindex [lindex $test 0] 1] 181 test Scrolledhtml-3.$m "object methods, $method" { 182 list [catch {eval [lindex $test 0]} msg] $msg 183 } [list 0 [lindex $test 1]] 184 update 185 incr m 186} 187 188# 189# Conclusion of construction/destruction tests 190# 191test Scrolledhtml-1.$c {Scrolledhtml destruction} { 192 destroy .sh 193 update 194} {} 195 196incr c 197 198test Scrolledhtml-1.$c {Scrolledhtml construction} { 199 iwidgets::scrolledhtml .sh -hscrollmode dynamic -labeltext "Label" \ 200 -labelpos n -labelmargin 5 201 pack .sh -padx 10 -pady 10 -fill both -expand yes 202 update 203} {} 204 205incr c 206 207test Scrolledhtml-1.$c {Scrolledhtml destruction} { 208 destroy .sh 209 update 210} {} 211 212incr c 213 214test Scrolledhtml-1.$c {Scrolledhtml destruction} { 215 iwidgets::scrolledhtml .sh 216 pack .sh 217 destroy .sh 218 update 219} {} 220 221::tcltest::cleanupTests 222exit 223