1# -*- tcl -*- 2# These tests are in the public domain 3# ------------------------------------------------------------------------- 4 5source [file join \ 6 [file dirname [file dirname [file normalize [info script]]]] \ 7 devtools testutilities.tcl] 8 9testsNeedTcl 8.5 ; # Virt channel support! 10testsNeedTcltest 1.0 11 12# Check if we have TclOO available. 13tcltest::testConstraint tcloo [expr {![catch {package require TclOO}]}] 14 15support { 16 if {[tcltest::testConstraint tcloo]} { 17 use virtchannel_base/memchan.tcl tcl::chan::memchan 18 } 19 useLocalFile tests/support.tcl 20} 21testing { 22 useLocal tar.tcl tar 23} 24 25# ------------------------------------------------------------------------- 26 27test tar-stream {stream} -constraints tcloo -setup { 28 setup1 29} -body { 30 string length [read $chan1] 31} -cleanup { 32 cleanup1 33} -result 128000 34 35test tar-pad {pad} -body { 36 tar::pad 230 37} -result {282} 38 39test tar-skip {skip} -constraints tcloo -setup { 40 setup1 41} -body { 42 tar::skip $chan1 10 43 lappend res [read $chan1 10] 44 tar::skip $chan1 72313 45 lappend res [read $chan1 10] 46} -cleanup { 47 cleanup1 48} -result {{6 7 8 9 10} {07 13908 1}} 49 50test tar-seekorskip-backwards {seekorskip} -constraints tcl8.6plus -setup setup1 -body { 51 # The zlib push stuff is Tcl 8.6+. Properly restrict the test. 52 zlib push gzip $chan1 53 catch {tar::seekorskip $chan1 -10 start} cres 54 lappend res $cres 55 catch {tar::seekorskip $chan1 10 start} cres 56 lappend res $cres 57 catch {tar::seekorskip $chan1 -10 end} cres 58 lappend res $cres 59 catch {tar::seekorskip $chan1 10 end} cres 60 lappend res $cres 61 lappend res [read $chan1 10] 62} -cleanup cleanup1 -match glob \ 63 -result [list \ 64 {WHENCE=start not supported*} \ 65 {WHENCE=start not supported*} \ 66 {WHENCE=end not supported*} \ 67 {WHENCE=end not supported*} \ 68 {1 2 3 4 5 } \ 69 ] 70 71test tar-header {header} -body { 72 set file1 [dict get $filesys Dir1 File1] 73 dict set file1 path /Dir1/File1 74 set header [header_posix $file1] 75 set parsed [string trim [tar::readHeader $header]] 76 set golden "name /Dir1/File1 mode 755 uid 13103 gid 18103 size 100 mtime 5706756101 cksum 3676 type 0 linkname {} magic ustar\0 version 00 uname {} gname {} devmajor 0 devminor 0 prefix {}" 77 set len [string length $parsed] 78 foreach {key value} $golden { 79 if {[set value1 [dict get $parsed $key]] ne $value } { 80 lappend res [list $key $value $value1] 81 } 82 } 83} -result {} 84 85test tar-add {add} -constraints tcloo -setup { 86 setup1 87} -body { 88 tar::create $chan1 [list $tmpdir/one/a $tmpdir/one/two/a $tmpdir/one/three/a] -chan 89 seek $chan1 0 90 lappend res {*}[tar::contents $chan1 -chan] 91 seek $chan1 0 92 lappend res [string trim [tar::get $chan1 $tmpdir/one/two/a -chan]] 93} -cleanup { 94 cleanup1 95} -result {tartest/one/a tartest/one/two/a tartest/one/three/a hello2} 96 97 98test tar-bug-2840180 {Ticket 2840180} -setup { 99 setup2 100} -body { 101 tar::create $chan1 [list $tmpdir/[large-path]/a] -chan 102 seek $chan1 0 103 104 # What the package sees. 105 lappend res {*}[tar::contents $chan1 -chan] 106 close $chan1 107 108 # What a regular tar package sees. 109 lappend res [exec 2> $tmpfile.err tar tvf $tmpfile] 110 join $res \n 111} -cleanup { 112 cleanup2 113} -match glob -result [join [list \ 114 tartest/[large-path]/a \ 115 "* tartest/[large-path]/a" \ 116 ] \n] 117 118# ------------------------------------------------------------------------- 119 120test tar-tkt-9f4c0e3e95-1.0 {Ticket 9f4c0e3e95, A} -setup { 121 set tarfile [setup-tkt-9f4c0e3e95] 122} -body { 123 string trim [tar::get $tarfile 02] 124} -cleanup { 125 cleanup-tkt-9f4c0e3e95 126 unset tarfile 127} -result {zero-two} 128 129test tar-tkt-9f4c0e3e95-1.1 {Ticket 9f4c0e3e95, B, } -setup { 130 set tarfile [setup-tkt-9f4c0e3e95] 131} -body { 132 tar::get $tarfile 0b10 133} -cleanup { 134 cleanup-tkt-9f4c0e3e95 135 unset tarfile 136} -returnCodes error -result {Tar "tartest/t.tar": File "0b10" not found} 137 138# ------------------------------------------------------------------------- 139testsuiteCleanup 140