# This file tests the filesystem and vfs internals. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 2002 Vincent Darley. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } makeFile "test file" gorp.file makeDirectory dir.file makeFile "test file in directory" [file join dir.file inside.file] # It would be good to be able to make these work on MacOS too. # If we added 'file link from to' we could easily do that. catch {exec ln -s gorp.file link.file} catch {exec ln -s inside.file dir.file/linkinside.file} catch {exec ln -s dir.file dir.link} test filesystem-1.0 {link normalisation} {unixOnly} { string equal [file normalize gorp.file] [file normalize link.file] } {0} test filesystem-1.1 {link normalisation} {unixOnly} { string equal [file normalize dir.file] [file normalize dir.link] } {0} test filesystem-1.2 {link normalisation} {unixOnly} { string equal [file normalize gorp.file/foo] [file normalize link.file/foo] } {1} test filesystem-1.3 {link normalisation} {unixOnly} { string equal [file normalize dir.file/foo] [file normalize dir.link/foo] } {1} test filesystem-1.4 {link normalisation} {unixOnly} { string equal [file normalize dir.file/inside.file] [file normalize dir.link/inside.file] } {1} test filesystem-1.5 {link normalisation} {unixOnly} { string equal [file normalize dir.file/linkinside.file] [file normalize dir.file/linkinside.file] } {1} test filesystem-1.6 {link normalisation} {unixOnly} { string equal [file normalize dir.file/linkinside.file] [file normalize dir.link/inside.file] } {0} test filesystem-1.7 {link normalisation} {unixOnly} { string equal [file normalize dir.link/linkinside.file/foo] [file normalize dir.file/inside.file/foo] } {1} test filesystem-1.8 {link normalisation} {unixOnly} { string equal [file normalize dir.file/linkinside.filefoo] [file normalize dir.link/inside.filefoo] } {0} file delete -force gorp.file link.file dir.file dir.link test filesystem-2.0 {new native path} {unixOnly} { foreach f [lsort [glob -nocomplain /usr/bin/c*]] { catch {file readlink $f} } # If we reach here we've succeeded. We used to crash above. expr 1 } {1} # Make sure the testfilesystem hasn't been registered. while {![catch {testfilesystem 0}]} {} test filesystem-3.0 {Tcl_FSRegister} { testfilesystem 1 } {registered} test filesystem-3.1 {Tcl_FSUnregister} { testfilesystem 0 } {unregistered} test filesystem-3.2 {Tcl_FSUnregister} { list [catch {testfilesystem 0} err] $err } {1 failed} test filesystem-3.3 {Tcl_FSRegister} { testfilesystem 1 testfilesystem 1 testfilesystem 0 testfilesystem 0 } {unregistered} test filesystem-3.4 {Tcl_FSRegister} { testfilesystem 1 file system bar } {reporting} test filesystem-3.5 {Tcl_FSUnregister} { testfilesystem 0 file system bar } {native} test filesystem-4.0 {testfilesystem} { -match glob -body { testfilesystem 1 set filesystemReport {} file exists foo testfilesystem 0 set filesystemReport } -result {* {access foo}} } test filesystem-4.1 {testfilesystem} { -match glob -body { testfilesystem 1 set filesystemReport {} catch {file stat foo bar} testfilesystem 0 set filesystemReport } -result {* {stat foo}} } test filesystem-4.2 {testfilesystem} { -match glob -body { testfilesystem 1 set filesystemReport {} catch {file lstat foo bar} testfilesystem 0 set filesystemReport } -result {* {lstat foo}} } test filesystem-4.3 {testfilesystem} { -match glob -body { testfilesystem 1 set filesystemReport {} catch {glob *} testfilesystem 0 set filesystemReport } -result {* {matchindirectory *}*} } # cleanup catch {unset filesystemReport} # Make sure the testfilesystem hasn't been registered. while {![catch {testfilesystem 0}]} {} ::tcltest::cleanupTests return