1# Commands covered: resource 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1996-1997 Sun Microsystems, Inc. 8# Copyright (c) 1998-1999 by Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution 11# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12# 13# RCS: @(#) $Id: resource.test,v 1.7.24.1 2003/10/06 14:30:06 dgp Exp $ 14 15if {[lsearch [namespace children] ::tcltest] == -1} { 16 package require tcltest 17 namespace import -force ::tcltest::* 18} 19 20test resource-1.1 {resource tests} {macOnly} { 21 list [catch {resource} msg] $msg 22} {1 {wrong # args: should be "resource option ?arg ...?"}} 23test resource-1.2 {resource tests} {macOnly} { 24 list [catch {resource _bad_} msg] $msg 25} {1 {bad option "_bad_": must be close, delete, files, list, open, read, types, or write}} 26 27# resource open & close tests 28test resource-2.1 {resource open & close tests} {macOnly} { 29 list [catch {resource open} msg] $msg 30} {1 {wrong # args: should be "resource open fileName ?permissions?"}} 31test resource-2.2 {resource open & close tests} {macOnly} { 32 list [catch {resource open resource.test r extraArg} msg] $msg 33} {1 {wrong # args: should be "resource open fileName ?permissions?"}} 34test resource-2.3 {resource open & close tests} {macOnly} { 35 list [catch {resource open resource.test bad_perms} msg] $msg 36} {1 {illegal access mode "bad_perms"}} 37test resource-2.4 {resource open & close tests} {macOnly} { 38 list [catch {resource open _bad_file_} msg] $msg 39} {1 {file does not exist}} 40test resource-2.5 {resource open & close tests} {macOnly} { 41 testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"} 42 set id [resource open rsrc.file] 43 resource close $id 44 file delete rsrc.file 45} {} 46test resource-2.6 {resource open & close tests} {macOnly} { 47 catch {file delete rsrc.file} 48 testWriteTextResource -rsrc fileRsrcName -file rsrc.file {A test string} 49 set id [resource open rsrc.file] 50 set result [string compare [resource open rsrc.file] $id] 51 lappend result [resource read TEXT fileRsrcName $id] 52 resource close $id 53 file delete rsrc.file 54 set result 55} {0 {A test string}} 56test resource-2.7 {resource open & close tests} {macOnly} { 57 catch {file delete rsrc.file} 58 testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"} 59 set id [resource open rsrc.file r] 60 set result [catch {resource open rsrc.file w} mssg] 61 resource close $id 62 file delete rsrc.file 63 lappend result $mssg 64 set result 65} {1 {Resource already open with different permissions.}} 66test resource-2.8 {resource open & close tests} {macOnly} { 67 list [catch {resource close} msg] $msg 68} {1 {wrong # args: should be "resource close resourceRef"}} 69test resource-2.9 {resource open & close tests} {macOnly} { 70 list [catch {resource close foo bar} msg] $msg 71} {1 {wrong # args: should be "resource close resourceRef"}} 72test resource-2.10 {resource open & close tests} {macOnly} { 73 list [catch {resource close _bad_resource_} msg] $msg 74} {1 {invalid resource file reference "_bad_resource_"}} 75test resource-2.11 {resource open & close tests} {macOnly} { 76 set result [catch {resource close System} mssg] 77 lappend result $mssg 78} {1 {can't close "System" resource file}} 79test resource-2.12 {resource open & close tests} {macOnly} { 80 set result [catch {resource close application} mssg] 81 lappend result $mssg 82} {1 {can't close "application" resource file}} 83 84# Tests for listing resources 85test resource-3.1 {resource list tests} {macOnly} { 86 list [catch {resource list} msg] $msg 87} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}} 88test resource-3.2 {resource list tests} {macOnly} { 89 list [catch {resource list _bad_type_} msg] $msg 90} {1 {expected Macintosh OS type but got "_bad_type_"}} 91test resource-3.3 {resource list tests} {macOnly} { 92 list [catch {resource list TEXT _bad_ref_} msg] $msg 93} {1 {invalid resource file reference "_bad_ref_"}} 94test resource-3.4 {resource list tests} {macOnly} { 95 list [catch {resource list TEXT _bad_ref_ extraArg} msg] $msg 96} {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}} 97test resource-3.5 {resource list tests} {macOnly} { 98 catch {file delete rsrc.file} 99 testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"} 100 set id [resource open rsrc.file] 101 catch "resource list TEXT $id" result 102 resource close $id 103 set result 104} {fileRsrcName} 105test resource-3.6 {resource list tests} {macOnly} { 106 # There should not be any resource of this type 107 resource list XXXX 108} {} 109test resource-3.7 {resource list tests} {macOnly} { 110 set resourceList [resource list STR#] 111 if {[lsearch $resourceList {Tcl Environment Variables}] == -1} { 112 set result {couldn't find resource that should exist} 113 } else { 114 set result ok 115 } 116} {ok} 117 118# Tests for reading resources 119test resource-4.1 {resource read tests} {macOnly} { 120 list [catch {resource read} msg] $msg 121} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}} 122test resource-4.2 {resource read tests} {macOnly} { 123 list [catch {resource read TEXT} msg] $msg 124} {1 {wrong # args: should be "resource read resourceType resourceId ?resourceRef?"}} 125test resource-4.3 {resource read tests} {macOnly} { 126 list [catch {resource read STR# {_non_existant_resource_}} msg] $msg 127} {1 {could not load resource}} 128test resource-4.4 {resource read tests} {macOnly} { 129 # The following resource should exist and load OK without error 130 catch {resource read STR# {Tcl Environment Variables}} 131} {0} 132 133# Tests for getting resource types 134test resource-5.1 {resource types tests} {macOnly} { 135 list [catch {resource types _bad_ref_} msg] $msg 136} {1 {invalid resource file reference "_bad_ref_"}} 137test resource-5.2 {resource types tests} {macOnly} { 138 list [catch {resource types _bad_ref_ extraArg} msg] $msg 139} {1 {wrong # args: should be "resource types ?resourceRef?"}} 140test resource-5.3 {resource types tests} {macOnly} { 141 # This should never cause an error 142 catch {resource types} 143} {0} 144test resource-5.4 {resource types tests} {macOnly} { 145 testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"} 146 set id [resource open rsrc.file] 147 set result [resource types $id] 148 resource close $id 149 set result 150} {TEXT} 151 152# resource write tests 153test resource-6.1 {resource write tests} {macOnly} { 154 list [catch {resource write} msg] $msg 155} {1 {wrong # args: should be "resource write ?-id resourceId? ?-name resourceName? ?-file resourceRef? ?-force? resourceType data"}} 156test resource-6.2 {resource write tests} {macOnly} { 157 list [catch {resource write _bad_type_ data} msg] $msg 158} {1 {expected Macintosh OS type but got "_bad_type_"}} 159test resource-6.3 {resource write tests} {macOnly} { 160 catch {file delete rsrc2.file} 161 set id [resource open rsrc2.file w] 162 resource close $id 163 set id [resource open rsrc2.file r] 164 set result [catch {resource write -file $id -name Hello TEXT foo} errMsg] 165 lappend result [string compare $errMsg "cannot write to resource file \"$id\", it was opened read only"] 166 lappend result [lsearch [resource list TEXT $id] Hello] 167 resource close $id 168 file delete rsrc2.file 169 set result 170} {1 0 -1} 171test resource-6.4 {resource write tests} {macOnly} { 172 catch {file delete rsrc2.file} 173 set id [resource open rsrc2.file w] 174 resource write -file $id -name Hello TEXT {set x "our test data"} 175 source -rsrc Hello rsrc2.file 176 resource close $id 177 file delete rsrc2.file 178 set x 179} {our test data} 180test resource-6.5 {resource write tests} {macOnly} { 181 catch {file delete rsrc2.file} 182 set id [resource open rsrc2.file w] 183 resource write -file $id -id 256 TEXT {HAHAHAHAHAHAHA} 184 set result [catch {resource write -file $id -id 256 TEXT {HOHOHOHOHOHO}} mssg] 185 resource close $id 186 file delete rsrc2.file 187 lappend result $mssg 188} {1 {the resource 256 already exists, use "-force" to overwrite it.}} 189test resource-6.6 {resource write tests} {macOnly} { 190 catch {file delete rsrc2.file} 191 testWriteTextResource -rsrc fileRsrcName -rsrcid 256 -file rsrc2.file -protected {error "don't tread on me"} 192 set id [resource open rsrc2.file w] 193 set result [catch {resource write -id 256 -force -file $id TEXT {NAHNAHNANAHNAH}} mssg] 194 resource close $id 195 file delete rsrc2.file 196 lappend result $mssg 197} {1 {could not write resource id 256 of type TEXT, it was protected.}} 198test resource-6.7 {resource write tests} {macOnly} { 199 catch {file delete rsrc2.file} 200 set id [resource open rsrc2.file w] 201 resource write -file $id -id 256 -name FOO TEXT {set x [list "our first test data"]} 202 resource write -file $id -id 256 -name BAR -force TEXT {set x [list "our second test data"]} 203 source -rsrcid 256 rsrc2.file 204 lappend x [resource list TEXT $id] 205 resource close $id 206 file delete rsrc2.file 207 set x 208} {{our second test data} BAR} 209 210#Tests for listing open resource files 211test resource-7.1 {resource file tests} {macOnly} { 212 catch {resource files foo bar} mssg 213 set mssg 214} {wrong # args: should be "resource files ?resourceId?"} 215test resource-7.2 {resource file tests} {macOnly} { 216 catch {file delete rsrc2.file} 217 set rsrcFiles [resource files] 218 set id [resource open rsrc2.file w] 219 set result [string compare $rsrcFiles [lrange [resource files] 1 end]] 220 lappend result [string compare $id [lrange [resource files] 0 0]] 221 resource close $id 222 file delete rsrc2.file 223 set result 224} {0 0} 225test resource-7.3 {resource file tests} {macOnly} { 226 set result 0 227 foreach file [resource files] { 228 if {[catch {resource types $file}] != 0} { 229 set result 1 230 } 231 } 232 set result 233} {0} 234test resource-7.4 {resource file tests} {macOnly} { 235 catch {resource files __NO_SUCH_RESOURCE__} mssg 236 set mssg 237} {invalid resource file reference "__NO_SUCH_RESOURCE__"} 238test resource-7.5 {resource file tests} {macOnly} { 239 set sys [resource files System] 240 string compare $sys [file join $env(SYS_FOLDER) System] 241} {0} 242test resource-7.6 {resource file tests} {macOnly} { 243 set app [resource files application] 244 string compare $app [info nameofexecutable] 245} {0} 246 247#Tests for the resource delete command 248test resource-8.1 {resource delete tests} {macOnly} { 249 list [catch {resource delete} msg] $msg 250} {1 {wrong # args: should be "resource delete ?-id resourceId? ?-name resourceName? ?-file resourceRef? resourceType"}} 251test resource-8.2 {resource delete tests} {macOnly} { 252 list [catch {resource delete TEXT} msg] $msg 253} {1 {you must specify either "-id" or "-name" or both to "resource delete"}} 254test resource-8.3 {resource delete tests} {macOnly} { 255 set result [catch {resource delete -file ffffff -id 128 TEXT} mssg] 256 lappend result $mssg 257} {1 {invalid resource file reference "ffffff"}} 258test resource-8.4 {resource delete tests} {macOnly} { 259 catch {file delete rsrc2.file} 260 testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff} 261 set id [resource open rsrc2.file r] 262 set result [catch {resource delete -id 128 -file $id TEXT} mssg] 263 resource close $id 264 file delete rsrc2.file 265 lappend result [string compare $mssg "cannot delete from resource file \"$id\", it was opened read only"] 266} {1 0} 267test resource-8.5 {resource delete tests} {macOnly} { 268 catch {file delete rsrc2.file} 269 testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff} 270 set id [resource open rsrc2.file w] 271 set result [catch {resource delete -id 128 -file $id _bad_type_} mssg] 272 resource close $id 273 file delete rsrc2.file 274 lappend result $mssg 275} {1 {expected Macintosh OS type but got "_bad_type_"}} 276test resource-8.5.1 {resource delete tests} {macOnly} { 277 catch {file delete rsrc2.file} 278 set id [resource open rsrc2.file w] 279 set result [catch {resource delete -id 128 -file $id TEXT} mssg] 280 resource close $id 281 file delete rsrc2.file 282 lappend result $mssg 283} {1 {resource not found}} 284test resource-8.6 {resource delete tests} {macOnly} { 285 catch {file delete rsrc2.file} 286 set id [resource open rsrc2.file w] 287 set result [catch {resource delete -name foo -file $id TEXT} mssg] 288 resource close $id 289 file delete rsrc2.file 290 lappend result $mssg 291} {1 {resource not found}} 292test resource-8.7 {resource delete tests} {macOnly} { 293 catch {file delete rsrc2.file} 294 set id [resource open rsrc2.file w] 295 resource write -file $id -name foo -id 128 TEXT {some stuff} 296 resource write -file $id -name bar -id 129 TEXT {some stuff} 297 set result [catch {resource delete -name foo -id 129 -file $id TEXT} mssg] 298 resource close $id 299 file delete rsrc2.file 300 lappend result $mssg 301} {1 {"-id" and "-name" values do not point to the same resource}} 302test resource-8.8 {resource delete tests} {macOnly} { 303 catch {file delete rsrc2.file} 304 testWriteTextResource -rsrc fileRsrcName -rsrcid 256 -file rsrc2.file -protected {error "don't tread on me"} 305 set id [resource open rsrc2.file w] 306 set result [catch {resource delete -id 256 -file $id TEXT } mssg] 307 resource close $id 308 file delete rsrc2.file 309 lappend result $mssg 310} {1 {resource cannot be deleted: it is protected.}} 311test resource-8.9 {resource delete tests} {macOnly} { 312 catch {file delete rsrc2.file} 313 testWriteTextResource -rsrc fileRsrcName -rsrcid 128 -file rsrc2.file {Some stuff} 314 set id [resource open rsrc2.file w] 315 set result [resource list TEXT $id] 316 resource delete -id 128 -file $id TEXT 317 lappend result [resource list TEXT $id] 318 resource close $id 319 file delete rsrc2.file 320 set result 321} {fileRsrcName {}} 322 323# Tests for the Mac version of the source command 324catch {file delete rsrc.file} 325test resource-9.1 {source command} {macOnly} { 326 testWriteTextResource -rsrc fileRsrcName -rsrcid 128 \ 327 -file rsrc.file {set rsrc_foo 1} 328 catch {unset rsrc_foo} 329 source -rsrc fileRsrcName rsrc.file 330 list [catch {set rsrc_foo} msg] $msg 331} {0 1} 332test resource-9.2 {source command} {macOnly} { 333 catch {unset rsrc_foo} 334 list [catch {source -rsrc no_resource rsrc.file} msg] $msg 335} {1 {The resource "no_resource" could not be loaded from rsrc.file.}} 336test resource-9.3 {source command} {macOnly} { 337 catch {unset rsrc_foo} 338 source -rsrcid 128 rsrc.file 339 list [catch {set rsrc_foo} msg] $msg 340} {0 1} 341test resource-9.4 {source command} {macOnly} { 342 catch {unset rsrc_foo} 343 list [catch {source -rsrcid bad_int rsrc.file} msg] $msg 344} {1 {expected integer but got "bad_int"}} 345test resource-9.5 {source command} {macOnly} { 346 catch {unset rsrc_foo} 347 list [catch {source -rsrcid 100 rsrc.file} msg] $msg 348} {1 {The resource "ID=100" could not be loaded from rsrc.file.}} 349 350# cleanup 351catch {file delete rsrc.file} 352::tcltest::cleanupTests 353return 354 355 356 357 358 359 360 361 362 363 364 365 366