# -*- tcl -*- # Tests for fileutil commands. 'test'. # # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1998-2000 by Ajuba Solutions. # Copyright (c) 2001 by ActiveState Tool Corp. # Copyright (c) 2005-2007 by Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: test.test,v 1.2 2009/10/06 20:07:18 andreas_kupries Exp $ # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ devtools testutilities.tcl] testsNeedTcl 8.2 testsNeedTcltest 1.0 testing { useLocal fileutil.tcl fileutil } # ------------------------------------------------------------------------- # In 8.3+ we can use symbolic permissions, i.e. strings like u+r, or # ugo-r when invoking 'file attributes'. This feature is however not # available in Tcl 8.2, the lowest revision supported by the # package. So we make do without them and use absolute permissions # instead. # 644 = -rw-r--r-- # 700 = -rwx------ # 600 = -rw------- # 500 = -r-x------ # 300 = --wx------ # ------------------------------------------------------------------------- set xpath [makeFile {} x] ; removeFile x # ------------------------------------------------------------------------- proc makewritable {path enable} { global tcl_platform if {[string equal $tcl_platform(platform) windows]} { set ro [expr {!$enable}] file attributes $path -readonly $ro } else { set mode [expr {$enable ? "700" : "500"}] file attributes $path -permissions 00$mode } return } proc makereadable {path enable} { global tcl_platform if {[string equal $tcl_platform(platform) windows]} { return -code error "Can't do that on Windows" } else { set mode [expr {$enable ? "700" : "300"}] file attributes $path -permissions 00$mode } return } proc makeexecutable {path enable} { global tcl_platform if {[string equal $tcl_platform(platform) windows]} { return -code error "Can't do that on Windows" } else { set mode [expr {$enable ? "700" : "600"}] file attributes $path -permissions 00$mode } return } # ------------------------------------------------------------------------- test test-1.0.0 {test read} {unixOnly} { set path [makeFile {} x] makereadable $path 1 set x PRE set res [list [fileutil::test $path read x TEST] $x] removeFile x set res } {1 PRE} test test-1.0.1 {test read, no variable} {unixOnly} { set path [makeFile {} x] makereadable $path 1 set x PRE set res [list [fileutil::test $path read] $x] removeFile x set res } {1 PRE} test test-1.0.2 {test !read} {unixOnly notRoot} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path read x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Read access is denied"] test test-1.0.3 {test !read, no variable} {unixOnly notRoot} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path read] $x] removeFile x set res } {0 PRE} test test-1.0.4 {test !read, no label} {unixOnly notRead} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path read x] $x] removeFile x set res } [list 0 "\"$xpath\": Read access is denied"] test test-2.0.0 {test write} { set path [makeFile {} x] makewritable $path 1 set x PRE set res [list [fileutil::test $path write x TEST] $x] removeFile x set res } {1 PRE} test test-2.0.1 {test write, no variable} { set path [makeFile {} x] makewritable $path 1 set x PRE set res [list [fileutil::test $path write] $x] removeFile x set res } {1 PRE} test test-2.0.2 {test !write} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path write x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Write access is denied"] test test-2.0.3 {test !write, no variable} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path write] $x] removeFile x set res } {0 PRE} test test-2.0.4 {test !write, no label} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path write x] $x] removeFile x set res } [list 0 "\"$xpath\": Write access is denied"] test test-3.0.0 {test exists} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path exists x TEST] $x] removeFile x set res } {1 PRE} test test-3.0.1 {test exists, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path exists] $x] removeFile x set res } {1 PRE} test test-3.0.2 {test !exists} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path exists x TEST] $x] set res } [list 0 "TEST \"$xpath\": Does not exist"] test test-3.0.3 {test !exists, no variable} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path exists] $x] set res } {0 PRE} test test-3.0.4 {test !exists, no label} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path exists x] $x] set res } [list 0 "\"$xpath\": Does not exist"] test test-4.0.0 {test file} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path file x TEST] $x] removeFile x set res } {1 PRE} test test-4.0.1 {test file, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path file] $x] removeFile x set res } {1 PRE} test test-4.0.2 {test !file} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path file x TEST] $x] removeDirectory x set res } [list 0 "TEST \"$xpath\": Is not a file"] test test-4.0.3 {test !file, no variable} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path file] $x] removeDirectory x set res } {0 PRE} test test-4.0.4 {test !file, no label} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path file x] $x] removeDirectory x set res } [list 0 "\"$xpath\": Is not a file"] test test-5.0.0 {test dir} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path dir x TEST] $x] removeDirectory x set res } {1 PRE} test test-5.0.1 {test dir, no variable} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path dir] $x] removeDirectory x set res } {1 PRE} test test-5.0.2 {test !dir} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path dir x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Is not a directory"] test test-5.0.3 {test !dir, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path dir] $x] removeFile x set res } {0 PRE} test test-5.0.4 {test !dir, no label} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path dir x] $x] removeFile x set res } [list 0 "\"$xpath\": Is not a directory"] test test-6.0.0 {test exec} {unixOnly} { set path [makeFile {} x] makeexecutable $path 1 set x PRE set res [list [fileutil::test $path exec x TEST] $x] removeFile x set res } {1 PRE} test test-6.0.1 {test exec, no variable} {unixOnly} { set path [makeFile {} x] makeexecutable $path 1 set x PRE set res [list [fileutil::test $path exec] $x] removeFile x set res } {1 PRE} test test-6.0.2 {test !exec} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path exec x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Is not executable"] test test-6.0.3 {test !exec, no variable} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path exec] $x] removeFile x set res } {0 PRE} test test-6.0.4 {test !exec, no label} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path exec x] $x] removeFile x set res } [list 0 "\"$xpath\": Is not executable"] test test-1.1.0 {test read} {unixOnly} { set path [makeFile {} x] makereadable $path 1 set x PRE set res [list [fileutil::test $path r x TEST] $x] removeFile x set res } {1 PRE} test test-1.1.1 {test read, no variable} {unixOnly} { set path [makeFile {} x] makereadable $path 1 set x PRE set res [list [fileutil::test $path r] $x] removeFile x set res } {1 PRE} test test-1.1.2 {test !read} {unixOnly notRoot} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path r x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Read access is denied"] test test-1.1.3 {test !read, no variable} {unixOnly notRoot} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path r] $x] removeFile x set res } {0 PRE} test test-1.1.4 {test !read, no label} {unixOnly notRoot} { set path [makeFile {} x] makereadable $path 0 set x PRE set res [list [fileutil::test $path r x] $x] removeFile x set res } [list 0 "\"$xpath\": Read access is denied"] test test-2.1.0 {test write} { set path [makeFile {} x] makewritable $path 1 set x PRE set res [list [fileutil::test $path w x TEST] $x] removeFile x set res } {1 PRE} test test-2.1.1 {test write, no variable} { set path [makeFile {} x] makewritable $path 1 set x PRE set res [list [fileutil::test $path w] $x] removeFile x set res } {1 PRE} test test-2.1.2 {test !write} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path w x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Write access is denied"] test test-2.1.3 {test !write, no variable} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path w] $x] removeFile x set res } {0 PRE} test test-2.1.4 {test !write, no label} notRoot { set path [makeFile {} x] makewritable $path 0 set x PRE set res [list [fileutil::test $path w x] $x] removeFile x set res } [list 0 "\"$xpath\": Write access is denied"] test test-3.1.0 {test exists} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path e x TEST] $x] removeFile x set res } {1 PRE} test test-3.1.1 {test exists, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path e] $x] removeFile x set res } {1 PRE} test test-3.1.2 {test !exists} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path e x TEST] $x] set res } [list 0 "TEST \"$xpath\": Does not exist"] test test-3.1.3 {test !exists, no variable} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path e] $x] set res } {0 PRE} test test-3.1.4 {test !exists, no label} { set path [makeFile {} x] removeFile x set x PRE set res [list [fileutil::test $path e x] $x] set res } [list 0 "\"$xpath\": Does not exist"] test test-4.1.0 {test file} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path f x TEST] $x] removeFile x set res } {1 PRE} test test-4.1.1 {test file, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path f] $x] removeFile x set res } {1 PRE} test test-4.1.2 {test !file} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path f x TEST] $x] removeDirectory x set res } [list 0 "TEST \"$xpath\": Is not a file"] test test-4.1.3 {test !file, no variable} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path f] $x] removeDirectory x set res } {0 PRE} test test-4.1.4 {test !file, no label} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path f x] $x] removeDirectory x set res } [list 0 "\"$xpath\": Is not a file"] test test-5.1.0 {test dir} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path d x TEST] $x] removeDirectory x set res } {1 PRE} test test-5.1.1 {test dir, no variable} { set path [makeDirectory x] set x PRE set res [list [fileutil::test $path d] $x] removeDirectory x set res } {1 PRE} test test-5.1.2 {test !dir} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path d x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Is not a directory"] test test-5.1.3 {test !dir, no variable} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path d] $x] removeFile x set res } {0 PRE} test test-5.1.4 {test !dir, no label} { set path [makeFile {} x] set x PRE set res [list [fileutil::test $path d x] $x] removeFile x set res } [list 0 "\"$xpath\": Is not a directory"] test test-6.1.0 {test exec} {unixOnly} { set path [makeFile {} x] makeexecutable $path 1 set x PRE set res [list [fileutil::test $path x x TEST] $x] removeFile x set res } {1 PRE} test test-6.1.1 {test exec, no variable} {unixOnly} { set path [makeFile {} x] makeexecutable $path 1 set x PRE set res [list [fileutil::test $path x] $x] removeFile x set res } {1 PRE} test test-6.1.2 {test !exec} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path x x TEST] $x] removeFile x set res } [list 0 "TEST \"$xpath\": Is not executable"] test test-6.1.3 {test !exec, no variable} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path x] $x] removeFile x set res } {0 PRE} test test-6.1.4 {test !exec, no label} {unixOnly} { set path [makeFile {} x] makeexecutable $path 0 set x PRE set res [list [fileutil::test $path x x] $x] removeFile x set res } [list 0 "\"$xpath\": Is not executable"] # ------------------------------------------------------------------------- rename makewritable {} rename makereadable {} rename makeexecutable {} catch {unset xpath} catch {unset path} catch {unset res} catch {unset x} testsuiteCleanup return