os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/resource.test
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
     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 
    15 if {[lsearch [namespace children] ::tcltest] == -1} {
    16     package require tcltest
    17     namespace import -force ::tcltest::*
    18 }
    19 
    20 test resource-1.1 {resource tests} {macOnly} {
    21     list [catch {resource} msg] $msg
    22 } {1 {wrong # args: should be "resource option ?arg ...?"}}
    23 test 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
    28 test 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?"}}
    31 test 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?"}}
    34 test 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"}}
    37 test resource-2.4 {resource open & close tests} {macOnly} {
    38     list [catch {resource open _bad_file_} msg] $msg
    39 } {1 {file does not exist}}
    40 test 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 } {}
    46 test 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}}
    56 test 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.}}
    66 test resource-2.8 {resource open & close tests} {macOnly} {
    67     list [catch {resource close} msg] $msg
    68 } {1 {wrong # args: should be "resource close resourceRef"}}
    69 test 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"}}
    72 test 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_"}}
    75 test 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}}
    79 test 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
    85 test resource-3.1 {resource list tests} {macOnly} {
    86     list [catch {resource list} msg] $msg
    87 } {1 {wrong # args: should be "resource list resourceType ?resourceRef?"}}
    88 test 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_"}}
    91 test 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_"}}
    94 test 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?"}}
    97 test 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}
   105 test resource-3.6 {resource list tests} {macOnly} {
   106     # There should not be any resource of this type
   107     resource list XXXX
   108 } {}
   109 test 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
   119 test 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?"}}
   122 test 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?"}}
   125 test resource-4.3 {resource read tests} {macOnly} {
   126     list [catch {resource read STR# {_non_existant_resource_}} msg] $msg
   127 } {1 {could not load resource}}
   128 test 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
   134 test resource-5.1 {resource types tests} {macOnly} {
   135     list [catch {resource types _bad_ref_} msg] $msg
   136 } {1 {invalid resource file reference "_bad_ref_"}}
   137 test 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?"}}
   140 test resource-5.3 {resource types tests} {macOnly} {
   141     # This should never cause an error
   142     catch {resource types}
   143 } {0}
   144 test 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
   153 test 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"}}
   156 test 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_"}}
   159 test 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}
   171 test 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}
   180 test 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.}}
   189 test 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.}}
   198 test 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
   211 test 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?"}
   215 test 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}
   225 test 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}
   234 test 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__"}
   238 test 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}
   242 test 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
   248 test 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"}}
   251 test 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"}}
   254 test 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"}}    
   258 test 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}
   267 test 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_"}}
   276 test 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}}
   284 test 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}}
   292 test 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}}
   302 test 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.}}
   311 test 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
   324 catch {file delete rsrc.file}
   325 test 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}
   332 test 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.}}
   336 test 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}
   341 test 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"}}
   345 test 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
   351 catch {file delete rsrc.file}
   352 ::tcltest::cleanupTests
   353 return
   354 
   355 
   356 
   357 
   358 
   359 
   360 
   361 
   362 
   363 
   364 
   365