开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
fileSystem.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：18k
源码类别：

通讯编程

开发平台：

Visual C++

fileSystem.test：源码内容
  1. # This file tests the filesystem and vfs internals.
  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) 2002 Vincent Darley.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. package require tcltest 2
  13. namespace eval ::tcl::test::fileSystem {
  15.     catch {
  16. namespace import ::tcltest::cleanupTests
  17. namespace import ::tcltest::makeDirectory
  18. namespace import ::tcltest::makeFile
  19. namespace import ::tcltest::removeDirectory
  20. namespace import ::tcltest::removeFile
  21. namespace import ::tcltest::test
  22.     }
  23.     
  24.     catch {
  25. file delete -force link.file
  26. file delete -force dir.link
  27. file delete -force [file join dir.file linkinside.file]
  28.     }
  30. cd [tcltest::temporaryDirectory]
  31. makeFile "test file" gorp.file
  32. makeDirectory dir.file
  33. makeFile "test file in directory" [file join dir.file inside.file]
  35. if {[catch {
  36.     file link link.file gorp.file 
  37.     file link 
  38.       [file join dir.file linkinside.file] 
  39.       [file join dir.file inside.file]
  40.     file link dir.link dir.file
  41. }]} {
  42.     tcltest::testConstraint hasLinks 0
  43. } else {
  44.     tcltest::testConstraint hasLinks 1
  45. }
  47. tcltest::testConstraint testsimplefilesystem 
  48.   [string equal testsimplefilesystem [info commands testsimplefilesystem]]
  50. test filesystem-1.0 {link normalisation} {hasLinks} {
  51.    string equal [file normalize gorp.file] [file normalize link.file]
  52. } {0}
  54. test filesystem-1.1 {link normalisation} {hasLinks} {
  55.    string equal [file normalize dir.file] [file normalize dir.link]
  56. } {0}
  58. test filesystem-1.2 {link normalisation} {hasLinks macOrUnix} {
  59.    string equal [file normalize [file join gorp.file foo]] 
  60.      [file normalize [file join link.file foo]]
  61. } {1}
  63. test filesystem-1.3 {link normalisation} {hasLinks} {
  64.    string equal [file normalize [file join dir.file foo]] 
  65.      [file normalize [file join dir.link foo]]
  66. } {1}
  68. test filesystem-1.4 {link normalisation} {hasLinks} {
  69.    string equal [file normalize [file join dir.file inside.file]] 
  70.      [file normalize [file join dir.link inside.file]]
  71. } {1}
  73. test filesystem-1.5 {link normalisation} {hasLinks} {
  74.    string equal [file normalize [file join dir.file linkinside.file]] 
  75.      [file normalize [file join dir.file linkinside.file]]
  76. } {1}
  78. test filesystem-1.6 {link normalisation} {hasLinks} {
  79.    string equal [file normalize [file join dir.file linkinside.file]] 
  80.      [file normalize [file join dir.link inside.file]]
  81. } {0}
  83. test filesystem-1.7 {link normalisation} {hasLinks macOrUnix} {
  84.    string equal [file normalize [file join dir.link linkinside.file foo]] 
  85.      [file normalize [file join dir.file inside.file foo]]
  86. } {1}
  88. test filesystem-1.8 {link normalisation} {hasLinks} {
  89.    string equal [file normalize [file join dir.file linkinside.filefoo]] 
  90.      [file normalize [file join dir.link inside.filefoo]]
  91. } {0}
  93. test filesystem-1.9 {link normalisation} {macOrUnix hasLinks} {
  94.     file delete -force dir.link
  95.     file link dir.link [file nativename dir.file]
  96.     string equal [file normalize [file join dir.file linkinside.file foo]] 
  97.       [file normalize [file join dir.link inside.file foo]]
  98. } {1}
  100. test filesystem-1.10 {link normalisation: double link} {macOrUnix hasLinks} {
  101.     file link dir2.link dir.link
  102.     string equal [file normalize [file join dir.file linkinside.file foo]] 
  103.       [file normalize [file join dir2.link inside.file foo]]
  104. } {1}
  106. makeDirectory dir2.file
  108. test filesystem-1.11 {link normalisation: double link, back in tree} {macOrUnix hasLinks} {
  109.     file link [file join dir2.file dir2.link] dir2.link
  110.     string equal [file normalize [file join dir.file linkinside.file foo]] 
  111.       [file normalize [file join dir2.file dir2.link inside.file foo]]
  112. } {1}
  114. test filesystem-1.12 {file new native path} {} {
  115.     for {set i 0} {$i < 10} {incr i} {
  116. foreach f [lsort [glob -nocomplain -type l *]] {
  117.     catch {file readlink $f}
  118. }
  119.     }
  120.     # If we reach here we've succeeded. We used to crash above.
  121.     expr 1
  122. } {1}
  124. test filesystem-1.13 {file normalisation} {winOnly} {
  125.     # This used to be broken
  126.     file normalize C:/thislongnamedoesntexist
  127. } {C:/thislongnamedoesntexist}
  129. test filesystem-1.14 {file normalisation} {winOnly} {
  130.     # This used to be broken
  131.     file normalize c:/
  132. } {C:/}
  134. file delete -force dir2.file
  135. file delete -force dir2.link
  136. file delete -force link.file dir.link
  137. removeFile [file join dir.file inside.file]
  138. removeDirectory dir.file
  140. test filesystem-2.0 {new native path} {unixOnly} {
  141.    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
  142.        catch {file readlink $f}
  143.    }
  144.    # If we reach here we've succeeded. We used to crash above.
  145.    expr 1
  146. } {1}
  148. if {[catch {package require tcltest 2}]} {
  149.     puts stderr "Skipping tests filesystem-{3,4}.*: tcltest 2 required."
  150. } else {
  151.     namespace import ::tcltest::testConstraint
  153.     # Is the Tcltest package loaded?
  154.     #   - that is, the special C-coded testing commands in tclTest.c
  155.     #   - tests use testing commands introduced in Tcltest 8.4
  156.     testConstraint Tcltest [expr {
  157.         [llength [package provide Tcltest]]
  158.         && [package vsatisfies [package provide Tcltest] 8.4]}]
  160. # Make sure the testfilesystem hasn't been registered.
  161. while {![catch {testfilesystem 0}]} {}
  163. test filesystem-3.0 {Tcl_FSRegister} Tcltest {
  164.     testfilesystem 1
  165. } {registered}
  167. test filesystem-3.1 {Tcl_FSUnregister} Tcltest {
  168.     testfilesystem 0
  169. } {unregistered}
  171. test filesystem-3.2 {Tcl_FSUnregister} Tcltest {
  172.     list [catch {testfilesystem 0} err] $err
  173. } {1 failed}
  175. test filesystem-3.3 {Tcl_FSRegister} Tcltest {
  176.     testfilesystem 1
  177.     testfilesystem 1
  178.     testfilesystem 0
  179.     testfilesystem 0
  180. } {unregistered}
  182. test filesystem-3.4 {Tcl_FSRegister} Tcltest {
  183.     testfilesystem 1
  184.     file system bar
  185. } {reporting}
  187. test filesystem-3.5 {Tcl_FSUnregister} Tcltest {
  188.     testfilesystem 0
  189.     lindex [file system bar] 0
  190. } {native}
  192. test filesystem-4.0 {testfilesystem} {
  193.     -constraints Tcltest
  194.     -match glob
  195.     -body {
  196. testfilesystem 1
  197. set filesystemReport {}
  198. file exists foo
  199. testfilesystem 0
  200. set filesystemReport
  201.     }
  202.     -result {* {access foo}}
  203. }
  205. test filesystem-4.1 {testfilesystem} {
  206.     -constraints Tcltest
  207.     -match glob
  208.     -body {
  209. testfilesystem 1
  210. set filesystemReport {}
  211. catch {file stat foo bar}
  212. testfilesystem 0
  213. set filesystemReport
  214.     }
  215.     -result {* {stat foo}}
  216. }
  218. test filesystem-4.2 {testfilesystem} {
  219.     -constraints Tcltest
  220.     -match glob
  221.     -body {
  222. testfilesystem 1
  223. set filesystemReport {}
  224. catch {file lstat foo bar}
  225. testfilesystem 0
  226. set filesystemReport
  227.     }
  228.     -result {* {lstat foo}}
  229. }
  231. test filesystem-4.3 {testfilesystem} {
  232.     -constraints Tcltest
  233.     -match glob
  234.     -body {
  235. testfilesystem 1
  236. set filesystemReport {}
  237. catch {glob *}
  238. testfilesystem 0
  239. set filesystemReport
  240.     }
  241.     -result {* {matchindirectory *}*}
  242. }
  244. test filesystem-5.1 {cache and ~} {
  245.     -constraints Tcltest
  246.     -match regexp
  247.     -body {
  248. set orig $env(HOME)
  249. set ::env(HOME) /foo/bar/blah
  250. set testdir ~
  251. set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
  252. set ::env(HOME) /a/b/c
  253. set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
  254. set ::env(HOME) $orig
  255. list $res1 $res2
  256.     }
  257.     -result {{Parent of ~ (/foo/bar/blah) is (/foo/bar|foo:bar)} {Parent of ~ (/a/b/c) is (/a/b|a:b)}}
  258. }
  260. test filesystem-6.1 {empty file name} {
  261.     list [catch {open ""} msg] $msg
  262. } {1 {couldn't open "": no such file or directory}}
  264. test filesystem-6.2 {empty file name} {
  265.     list [catch {file stat "" arr} msg] $msg
  266. } {1 {could not read "": no such file or directory}}
  268. test filesystem-6.3 {empty file name} {
  269.     list [catch {file atime ""} msg] $msg
  270. } {1 {could not read "": no such file or directory}}
  272. test filesystem-6.4 {empty file name} {
  273.     list [catch {file attributes ""} msg] $msg
  274. } {1 {could not read "": no such file or directory}}
  276. test filesystem-6.5 {empty file name} {
  277.     list [catch {file copy "" ""} msg] $msg
  278. } {1 {error copying "": no such file or directory}}
  280. test filesystem-6.6 {empty file name} {
  281.     list [catch {file delete ""} msg] $msg
  282. } {0 {}}
  284. test filesystem-6.7 {empty file name} {
  285.     list [catch {file dirname ""} msg] $msg
  286. } {0 .}
  288. test filesystem-6.8 {empty file name} {
  289.     list [catch {file executable ""} msg] $msg
  290. } {0 0}
  292. test filesystem-6.9 {empty file name} {
  293.     list [catch {file exists ""} msg] $msg
  294. } {0 0}
  296. test filesystem-6.10 {empty file name} {
  297.     list [catch {file extension ""} msg] $msg
  298. } {0 {}}
  300. test filesystem-6.11 {empty file name} {
  301.     list [catch {file isdirectory ""} msg] $msg
  302. } {0 0}
  304. test filesystem-6.12 {empty file name} {
  305.     list [catch {file isfile ""} msg] $msg
  306. } {0 0}
  308. test filesystem-6.13 {empty file name} {
  309.     list [catch {file join ""} msg] $msg
  310. } {0 {}}
  312. test filesystem-6.14 {empty file name} {
  313.     list [catch {file link ""} msg] $msg
  314. } {1 {could not read link "": no such file or directory}}
  316. test filesystem-6.15 {empty file name} {
  317.     list [catch {file lstat "" arr} msg] $msg
  318. } {1 {could not read "": no such file or directory}}
  320. test filesystem-6.16 {empty file name} {
  321.     list [catch {file mtime ""} msg] $msg
  322. } {1 {could not read "": no such file or directory}}
  324. test filesystem-6.17 {empty file name} {
  325.     list [catch {file mtime "" 0} msg] $msg
  326. } {1 {could not read "": no such file or directory}}
  328. test filesystem-6.18 {empty file name} {
  329.     list [catch {file mkdir ""} msg] $msg
  330. } {1 {can't create directory "": no such file or directory}}
  332. test filesystem-6.19 {empty file name} {
  333.     list [catch {file nativename ""} msg] $msg
  334. } {0 {}}
  336. test filesystem-6.20 {empty file name} {
  337.     list [catch {file normalize ""} msg] $msg
  338. } {0 {}}
  340. test filesystem-6.21 {empty file name} {
  341.     list [catch {file owned ""} msg] $msg
  342. } {0 0}
  344. test filesystem-6.22 {empty file name} {
  345.     list [catch {file pathtype ""} msg] $msg
  346. } {0 relative}
  348. test filesystem-6.23 {empty file name} {
  349.     list [catch {file readable ""} msg] $msg
  350. } {0 0}
  352. test filesystem-6.24 {empty file name} {
  353.     list [catch {file readlink ""} msg] $msg
  354. } {1 {could not readlink "": no such file or directory}}
  356. test filesystem-6.25 {empty file name} {
  357.     list [catch {file rename "" ""} msg] $msg
  358. } {1 {error renaming "": no such file or directory}}
  360. test filesystem-6.26 {empty file name} {
  361.     list [catch {file rootname ""} msg] $msg
  362. } {0 {}}
  364. test filesystem-6.27 {empty file name} {
  365.     list [catch {file separator ""} msg] $msg
  366. } {1 {Unrecognised path}}
  368. test filesystem-6.28 {empty file name} {
  369.     list [catch {file size ""} msg] $msg
  370. } {1 {could not read "": no such file or directory}}
  372. test filesystem-6.29 {empty file name} {
  373.     list [catch {file split ""} msg] $msg
  374. } {0 {}}
  376. test filesystem-6.30 {empty file name} {
  377.     list [catch {file system ""} msg] $msg
  378. } {1 {Unrecognised path}}
  380. test filesystem-6.31 {empty file name} {
  381.     list [catch {file tail ""} msg] $msg
  382. } {0 {}}
  384. test filesystem-6.32 {empty file name} {
  385.     list [catch {file type ""} msg] $msg
  386. } {1 {could not read "": no such file or directory}}
  388. test filesystem-6.33 {empty file name} {
  389.     list [catch {file writable ""} msg] $msg
  390. } {0 0}
  392. # Make sure the testfilesystem hasn't been registered.
  393. while {![catch {testfilesystem 0}]} {}
  394. }
  396. test filesystem-7.1 {load from vfs} {win testsimplefilesystem} {
  397.     # This may cause a crash on exit
  398.     set dir [pwd]
  399.     cd [file dirname [info nameof]]
  400.     set dde [lindex [glob *dde*[info sharedlib]] 0]
  401.     testsimplefilesystem 1
  402.     # This loads dde via a complex copy-to-temp operation
  403.     load simplefs:/$dde dde
  404.     testsimplefilesystem 0
  405.     cd $dir
  406.     set res "ok"
  407.     # The real result of this test is what happens when Tcl exits.
  408. } {ok}
  410. test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} 
  411.   {testsimplefilesystem} {
  412.     set dir [pwd]
  413.     cd [tcltest::temporaryDirectory]
  414.     # We created this file several tests ago.
  415.     set origtime [file mtime gorp.file]
  416.     testsimplefilesystem 1
  417.     file delete -force theCopy
  418.     file copy simplefs:/gorp.file theCopy
  419.     testsimplefilesystem 0
  420.     set newtime [file mtime theCopy]
  421.     file delete theCopy
  422.     cd $dir
  423.     expr {$origtime == $newtime}
  424. } {1}
  426. removeFile gorp.file
  428. test filesystem-8.1 {relative path objects and caching of pwd} {
  429.     set dir [pwd]
  430.     cd [tcltest::temporaryDirectory]
  431.     makeDirectory abc
  432.     makeDirectory def
  433.     makeFile "contents" [file join abc foo]
  434.     cd abc
  435.     set f "foo"
  436.     set res {}
  437.     lappend res [file exists $f]
  438.     lappend res [file exists $f]
  439.     cd ..
  440.     cd def
  441.     # If we haven't cleared the object's cwd cache, Tcl 
  442.     # will think it still exists.
  443.     lappend res [file exists $f]
  444.     lappend res [file exists $f]
  445.     removeFile [file join abc foo]
  446.     removeDirectory abc
  447.     removeDirectory def
  448.     cd $dir
  449.     set res
  450. } {1 1 0 0}
  452. test filesystem-8.2 {relative path objects and use of pwd} {
  453.     set origdir [pwd]
  454.     cd [tcltest::temporaryDirectory]
  455.     set dir "abc"
  456.     makeDirectory $dir
  457.     makeFile "contents" [file join abc foo]
  458.     cd $dir
  459.     set res [file exists [lindex [glob *] 0]]
  460.     cd ..
  461.     removeFile [file join abc foo]
  462.     removeDirectory abc
  463.     cd $origdir
  464.     set res
  465. } {1}
  467. test filesystem-8.3 {path objects and empty string} {
  468.     set anchor ""
  469.     set dst foo
  470.     set res $dst
  472.     set yyy [file split $anchor]
  473.     set dst [file join  $anchor $dst]
  474.     lappend res $dst $yyy
  475. } {foo foo {}}
  477. proc TestFind1 {d f} {
  478.     set r1 [file exists [file join $d $f]]
  479.     lappend res "[file join $d $f] found: $r1"
  480.     lappend res "is dir a dir? [file isdirectory $d]"
  481.     set r2 [file exists [file join $d $f]]
  482.     lappend res "[file join $d $f] found: $r2"
  483.     set res
  484. }
  485. proc TestFind2 {d f} {
  486.     set r1 [file exists [file join $d $f]]
  487.     lappend res "[file join $d $f] found: $r1"
  488.     lappend res "is dir a dir? [file isdirectory [file join $d]]"
  489.     set r2 [file exists [file join $d $f]]
  490.     lappend res "[file join $d $f] found: $r2"
  491.     set res
  492. }
  494. test filesystem-9.1 {path objects and join and object rep} {
  495.     set origdir [pwd]
  496.     cd [tcltest::temporaryDirectory]
  497.     file mkdir [file join a b c]
  498.     set res [TestFind1 a [file join b . c]]
  499.     file delete -force a
  500.     cd $origdir
  501.     set res
  502. } {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
  504. test filesystem-9.2 {path objects and join and object rep} {
  505.     set origdir [pwd]
  506.     cd [tcltest::temporaryDirectory]
  507.     file mkdir [file join a b c]
  508.     set res [TestFind2 a [file join b . c]]
  509.     file delete -force a
  510.     cd $origdir
  511.     set res
  512. } {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
  514. test filesystem-9.2.1 {path objects and join and object rep} {
  515.     set origdir [pwd]
  516.     cd [tcltest::temporaryDirectory]
  517.     file mkdir [file join a b c]
  518.     set res [TestFind2 a [file join b .]]
  519.     file delete -force a
  520.     cd $origdir
  521.     set res
  522. } {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
  524. test filesystem-9.3 {path objects and join and object rep} {
  525.     set origdir [pwd]
  526.     cd [tcltest::temporaryDirectory]
  527.     file mkdir [file join a b c]
  528.     set res [TestFind1 a [file join b .. b c]]
  529.     file delete -force a
  530.     cd $origdir
  531.     set res
  532. } {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
  534. test filesystem-9.4 {path objects and join and object rep} {
  535.     set origdir [pwd]
  536.     cd [tcltest::temporaryDirectory]
  537.     file mkdir [file join a b c]
  538.     set res [TestFind2 a [file join b .. b c]]
  539.     file delete -force a
  540.     cd $origdir
  541.     set res
  542. } {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
  544. test filesystem-9.5 {path objects and file tail and object rep} {
  545.     set origdir [pwd]
  546.     cd [tcltest::temporaryDirectory]
  547.     file mkdir dgp
  548.     close [open dgp/test w]
  549.     foreach relative [glob -nocomplain [file join * test]] {
  550. set absolute [file join [pwd] $relative]
  551. set res [list [file tail $absolute] "test"]
  552.     }
  553.     file delete -force dgp 
  554.     cd $origdir
  555.     set res
  556. } {test test}
  558. test filesystem-9.6 {path objects and file join and object rep} {winOnly} {
  559.     set res {}
  560.     set p "C:\toto"
  561.     lappend res [file join $p toto]
  562.     file isdirectory $p
  563.     lappend res [file join $p toto]
  564. } {C:/toto/toto C:/toto/toto}
  566. test filesystem-9.7 {path objects and glob and file tail and tilde} {
  567.     set res {}
  568.     set origdir [pwd]
  569.     cd [tcltest::temporaryDirectory]
  570.     file mkdir tilde
  571.     close [open tilde/~testNotExist w]
  572.     cd tilde
  573.     set file [lindex [glob *test*] 0]
  574.     lappend res [file exists $file] [catch {file tail $file} r] $r
  575.     lappend res $file
  576.     lappend res [file exists $file] [catch {file tail $file} r] $r
  577.     lappend res [catch {file tail $file} r] $r
  578.     cd ..
  579.     file delete -force tilde
  580.     cd $origdir
  581.     set res
  582. } {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
  583. test filesystem-9.8 {path objects and glob and file tail and tilde} {
  584.     set res {}
  585.     set origdir [pwd]
  586.     cd [tcltest::temporaryDirectory]
  587.     file mkdir tilde
  588.     close [open tilde/~testNotExist w]
  589.     cd tilde
  590.     set file1 [lindex [glob *test*] 0]
  591.     set file2 "~testNotExist"
  592.     lappend res $file1 $file2
  593.     lappend res [catch {file tail $file1} r] $r
  594.     lappend res [catch {file tail $file2} r] $r
  595.     cd ..
  596.     file delete -force tilde
  597.     cd $origdir
  598.     set res
  599. } {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
  600. test filesystem-9.9 {path objects and glob and file tail and tilde} {
  601.     set res {}
  602.     set origdir [pwd]
  603.     cd [tcltest::temporaryDirectory]
  604.     file mkdir tilde
  605.     close [open tilde/~testNotExist w]
  606.     cd tilde
  607.     set file1 [lindex [glob *test*] 0]
  608.     set file2 "~testNotExist"
  609.     lappend res [catch {file exists $file1} r] $r
  610.     lappend res [catch {file exists $file2} r] $r
  611.     lappend res [string equal $file1 $file2]
  612.     cd ..
  613.     file delete -force tilde
  614.     cd $origdir
  615.     set res
  616. } {0 0 0 0 1}
  618. cleanupTests
  619. }
  620. namespace delete ::tcl::test::fileSystem
  621. return