Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/unixFCmd.test@260cb5ec6c19

     1 # This file tests the tclUnixFCmd.c file.

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 Sun Microsystems, Inc.

8 #

     9 # See the file "license.terms" for information on usage and redistribution

    10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    11 #

    12 # RCS: @(#) $Id: unixFCmd.test,v 1.17.2.1 2003/04/14 15:45:57 vincentdarley Exp $

    14 if {[lsearch [namespace children] ::tcltest] == -1} {

    15     package require tcltest

    16     namespace import -force ::tcltest::*

    17 }

    19 # These tests really need to be run from a writable directory, which

    20 # it is assumed [temporaryDirectory] is.

    21 set oldcwd [pwd]

    22 cd [temporaryDirectory]

    24 # Several tests require need to match results against the unix username

    25 set user {}

    26 if {$tcl_platform(platform) == "unix"} {

    27     catch {set user [exec whoami]}

    28     if {$user == ""} {

    29 	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}

    30     }

    31     if {$user == ""} {

    32 	set user "root"

    33     }

    34 }

    36 proc openup {path} {

    37     testchmod 777 $path

    38     if {[file isdirectory $path]} {

    39 	catch {

    40 	    foreach p [glob -directory $path *] {

    41 		openup $p

    42 	    }

    43 	}

    44     }

    45 }

    47 proc cleanup {args} {

    48     foreach p ". $args" {

    49 	set x ""

    50 	catch {

    51 	    set x [glob -directory $p tf* td*]

    52 	}

    53 	foreach file $x {

    54 	    if {[catch {file delete -force -- $file}]} {

    55 		openup $file

    56 		file delete -force -- $file

    57 	    }

    58 	}

    59     }

    60 }

    62 test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {

    63     cleanup

    64     file mkdir td1/td2/td3

    65     file attributes td1/td2 -permissions 0000

    66     set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]

    67     file attributes td1/td2 -permissions 0755

    68     set msg

    69 } {1 {error renaming "td1/td2/td3": permission denied}}

    70 test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {

    71     cleanup

    72     file mkdir td1/td2

    73     file mkdir td2

    74     list [catch {file rename td2 td1} msg] $msg

    75 } {1 {error renaming "td2" to "td1/td2": file already exists}}

    76 test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {

    77     cleanup

    78     file mkdir td1

    79     list [catch {file rename td1 td1} msg] $msg

    80 } {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}

    81 test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {

    82     # can't make it happen

    83 } {}

    84 test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {

    85     cleanup

    86     file mkdir td1

    87     list [catch {file rename td2 td1} msg] $msg

    88 } {1 {error renaming "td2": no such file or directory}}

    89 test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {

    90     # can't make it happen

    91 } {}

    92 test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {

    93     cleanup

    94     file mkdir foo/bar

    95     file attr foo -perm 040555

    96     set catchResult [catch {file rename foo/bar /tmp} msg]

    97     set msg [lindex [split $msg :] end]

    98     catch {file delete /tmp/bar}

    99     catch {file attr foo -perm 040777}

   100     catch {file delete -force foo}

   101     list $catchResult $msg

   102 } {1 { permission denied}}

   103 test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {

   104     testalarm

   105     after 2000

   106     list [testgotsig] [testgotsig]

   107 } {1 0}

   108 test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {

   109     cleanup

   110     set f [open tfalarm w]

   111     puts $f {

   112 	after 2000

   113 	puts "hello world"

   114 	exit 0

   115     }

   116     close $f

   117     testalarm

   118     set pipe [open "|[info nameofexecutable] tfalarm" r+]

   119     set line [read $pipe 1]

   120     catch {close $pipe}

   121     list $line [testgotsig]

   122 } {h 1}

   123 test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \

   124 	{unixOnly notRoot} {

   125     cleanup

   126     close [open tf1 a]

   127     close [open tf2 a]

   128     file copy -force tf1 tf2

   129 } {}

   130 test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unixOnly notRoot dontCopyLinks} {

   131     # copying links should end up with real files

   132     cleanup

   133     close [open tf1 a]

   134     file link -symbolic tf2 tf1

   135     file copy tf2 tf3

   136     file type tf3

   137 } {file}

   138 test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {

   139     # copying links should end up with the links copied

   140     cleanup

   141     close [open tf1 a]

   142     file link -symbolic tf2 tf1

   143     file copy tf2 tf3

   144     file type tf3

   145 } {link}

   146 test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {

   147     cleanup

   148     set null "/dev/null"

   149     while {[file type $null] != "characterSpecial"} {

   150 	set null [file join [file dirname $null] [file readlink $null]]

   151     }

   152     # file copy $null tf1

   153 } {}

   154 test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {

   155     cleanup

   156     if [catch {exec mknod tf1 p}] {

   157 	list 1

   158     } else {

   159 	file copy tf1 tf2

   160 	expr {"[file type tf1]" == "[file type tf2]"}

   161     }

   162 } {1}

   163 test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {

   164     cleanup

   165     close [open tf1 a]

   166     file attributes tf1 -permissions 0472

   167     file copy tf1 tf2

   168     file attributes tf2 -permissions

   169 } 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-

   171 test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {

   172 } {}

   174 test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {

   175 } {}

   177 test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {

   178 } {}

   180 test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {

   181 } {}

   183 test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {

   184 } {}

   186 test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {

   187 } {}

   189 test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {

   190 } {}

   192 test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {

   193 } {}

   195 test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {

   196 } {}

   198 test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {

   199     catch {file delete -force -- foo.test}

   200     list [catch {file attributes foo.test -group} msg] $msg

   201 } {1 {could not read "foo.test": no such file or directory}}

   202 test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {

   203     catch {file delete -force -- foo.test}

   204     close [open foo.test w]

   205     list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]

   206 } {0 {}}

   208 test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {

   209     catch {file delete -force -- foo.test}

   210     list [catch {file attributes foo.test -group} msg] $msg

   211 } {1 {could not read "foo.test": no such file or directory}}

   212 test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {

   213     catch {file delete -force -- foo.test}

   214     close [open foo.test w]

   215     list [catch {file attributes foo.test -owner} msg] \

   216 	    [string compare $msg $user] [file delete -force -- foo.test]

   217 } {0 0 {}}

   219 test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {

   220     catch {file delete -force -- foo.test}

   221     list [catch {file attributes foo.test -permissions} msg] $msg

   222 } {1 {could not read "foo.test": no such file or directory}}

   223 test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {

   224     catch {file delete -force -- foo.test}

   225     close [open foo.test w]

   226     list [catch {file attribute foo.test -permissions}] \

   227 	    [file delete -force -- foo.test]

   228 } {0 {}}

   230 # Find a group that exists on this system, or else skip tests that require

   231 # groups

   232 set ::tcltest::testConstraints(foundGroup) 0

   233 if {$tcl_platform(platform) == "unix"} {

   234     catch {

   235 	set groupList [exec groups]

   236 	set group [lindex $groupList 0]

   237 	set ::tcltest::testConstraints(foundGroup) 1

   238     }

   239 }

   241 #groups hard to test

   242 test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {

   243     catch {file delete -force -- foo.test}

   244     list [catch {file attributes foo.test -group foozzz} msg] \

   245 	    $msg [file delete -force -- foo.test]

   246 } {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}

   247 test unixFCmd-15.2 {SetGroupAttribute - invalid file} \

   248 	{unixOnly notRoot foundGroup} {

   249     catch {file delete -force -- foo.test}

   250     list [catch {file attributes foo.test -group $group} msg] $msg

   251 } {1 {could not set group for file "foo.test": no such file or directory}}

   253 #changing owners hard to do

   254 test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {

   255     catch {file delete -force -- foo.test}

   256     close [open foo.test w]

   257     list [catch {file attributes foo.test -owner $user} msg] \

   258 	    $msg [string compare [file attributes foo.test -owner] $user] \

   259 	    [file delete -force -- foo.test]

   260 } {0 {} 0 {}}

   261 test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {

   262     catch {file delete -force -- foo.test}

   263     list [catch {file attributes foo.test -owner $user} msg] $msg

   264 } {1 {could not set owner for file "foo.test": no such file or directory}}

   265 test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {

   266     catch {file delete -force -- foo.test}

   267     list [catch {file attributes foo.test -owner foozzz} msg] $msg

   268 } {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}

   271 test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {

   272     catch {file delete -force -- foo.test}

   273     close [open foo.test w]

   274     list [catch {file attributes foo.test -permissions 0000} msg] \

   275 	    $msg [file attributes foo.test -permissions] \

   276 	    [file delete -force -- foo.test]

   277 } {0 {} 00000 {}}

   278 test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {

   279     catch {file delete -force -- foo.test}

   280     list [catch {file attributes foo.test -permissions 0000} msg] $msg

   281 } {1 {could not set permissions for file "foo.test": no such file or directory}}

   282 test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {

   283     catch {file delete -force -- foo.test}

   284     close [open foo.test w]

   285     list [catch {file attributes foo.test -permissions foo} msg] $msg \

   286 	    [file delete -force -- foo.test]

   287 } {1 {unknown permission string format "foo"} {}}

   288 test unixFCmd-17.4 {SetPermissionsAttribute} {unixOnly notRoot} {

   289     catch {file delete -force -- foo.test}

   290     close [open foo.test w]

   291     list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \

   292 	    [file delete -force -- foo.test]

   293 } {1 {unknown permission string format "---rwx"} {}}

   295 close [open foo.test w]

   296 set ::i 4

   297 proc permcheck {testnum permstr expected} {

   298     test $testnum {SetPermissionsAttribute} {unixOnly notRoot} {

   299 	file attributes foo.test -permissions $permstr

   300 	file attributes foo.test -permissions

   301     } $expected

   302 }

   303 permcheck unixFCmd-17.5   rwxrwxrwx	00777

   304 permcheck unixFCmd-17.6   r--r---w-	00442

   305 permcheck unixFCmd-17.7   0		00000

   306 permcheck unixFCmd-17.8   u+rwx,g+r	00740

   307 permcheck unixFCmd-17.9   u-w		00540

   308 permcheck unixFCmd-17.10   o+rwx	00547

   309 permcheck unixFCmd-17.11  --x--x--x	00111

   310 permcheck unixFCmd-17.12  a+rwx		00777

   311 file delete -force -- foo.test

   313 test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {

   314     # This test is nonportable because SunOS generates a weird error

   315     # message when the current directory isn't readable.

   316     set cd [pwd]

   317     set nd $cd/tstdir

   318     file mkdir $nd

   319     cd $nd

   320     file attributes $nd -permissions 0000

   321     set r [list [catch {pwd} res] [string range $res 0 36]];

   322     cd $cd;

   323     file attributes $nd -permissions 0755

   324     file delete $nd

   325     set r

   326 } {1 {error getting working directory name:}}

   328 # cleanup

   329 cleanup

   330 cd $oldcwd

   331 ::tcltest::cleanupTests

   332 return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--