Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Fix for [Bug 1533748] (./ prefixed file names) and tests for [Bug 1011492] (zip files with preface data) |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
0a72685718a8a7ba692b7340473074e6 |
| User & Date: | patthoyts 2009-01-22 15:15:19 |
Context
|
2009-01-22
| ||
| 15:24 | [Bug 2482573] improve handling of glob for tclprocvfs check-in: 85d3b01734 user: patthoyts tags: trunk | |
| 15:15 | Fix for [Bug 1533748] (./ prefixed file names) and tests for [Bug 1011492] (zip files with preface data) check-in: 0a72685718 user: patthoyts tags: trunk | |
| 15:10 | Make use of the core zlib and reflected channels to implement memchan and zip file support with Tcl 8.6. check-in: 9f07054c71 user: patthoyts tags: trunk | |
Changes
Changes to library/zipvfs.tcl.
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
set sb(mtime) [DosTime $date $time]
set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }]
if { ( $sb(atx) & 0xff ) & 16 } {
set sb(type) directory
} else {
set sb(type) file
}
set sb(name) [read $fd [u_short $flen]]
set sb(extra) [read $fd [u_short $elen]]
set sb(comment) [read $fd [u_short $clen]]
if {$sb(flags) & (1 << 10)} {
foreach thing {name extra comment} {
set sb($thing) [encoding convertfrom utf8 $sb($thing)]
}
}
|
| |
446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 |
set sb(mtime) [DosTime $date $time]
set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }]
if { ( $sb(atx) & 0xff ) & 16 } {
set sb(type) directory
} else {
set sb(type) file
}
set sb(name) [string trimleft [read $fd [u_short $flen]] "./"]
set sb(extra) [read $fd [u_short $elen]]
set sb(comment) [read $fd [u_short $clen]]
if {$sb(flags) & (1 << 10)} {
foreach thing {name extra comment} {
set sb($thing) [encoding convertfrom utf8 $sb($thing)]
}
}
|
Changes to tests/vfsZip.test.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
makeFile {File one} zipfs.test/One.txt
makeFile {File two} zipfs.test/Two.txt
file mkdir zipfs.test/Aleph
makeFile {File aleph one} zipfs.test/Aleph/One.txt
makeFile {File aleph two} zipfs.test/Aleph/Two.txt
eval exec [auto_execok zip] [list -r zipfs.zip zipfs.test]
eval exec [auto_execok zip] [list zipnest.zip zipfs.zip]
}
test vfsZip-1.1 "mount non-existent zip file" -constraints {zipfs} -setup {
set file [makeFile {} vfszip.zip]
} -body {
set mnt [vfs::zip::Mount $file localmount]
} -cleanup {
................................................................................
fconfigure $f -translation binary
set data [read $f]
close $f
expr {[string length $data] == [file size vfszip31/articles/c_5498.xml]}
} -cleanup {
vfs::unmount vfszip31
} -result {1}
test vfsZip-9.0 "attempt to delete mounted file" -constraints {zipfs zipexe} -setup {
vfs::zip::Mount zipfs.zip local
} -body {
file delete zipfs.zip
} -cleanup {
vfs::unmount local
} -returnCodes {error} -result {error deleting "zipfs.zip": permission denied}
# cleanup
if {[testConstraint zipfs] && [testConstraint zipexe]} {
file delete -force zipfs.test
file delete zipfs.zip
file delete zipnest.zip
}
tcltest::cleanupTests
return
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
...
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
makeFile {File one} zipfs.test/One.txt
makeFile {File two} zipfs.test/Two.txt
file mkdir zipfs.test/Aleph
makeFile {File aleph one} zipfs.test/Aleph/One.txt
makeFile {File aleph two} zipfs.test/Aleph/Two.txt
eval exec [auto_execok zip] [list -r zipfs.zip zipfs.test]
eval exec [auto_execok zip] [list zipnest.zip zipfs.zip]
testConstraint zipcat [expr {![catch {
makeFile {} zipcat.zip
set f [open zipcat.zip w] ; fconfigure $f -translation binary
set fin [open zipfs.zip r] ; fconfigure $fin -translation binary
puts -nonewline $f "[string repeat # 4095]\xff"
fcopy $fin $f
close $fin ; close $f
eval exec [auto_execok zip] [list -A zipcat.zip]
}]}]
}
test vfsZip-1.1 "mount non-existent zip file" -constraints {zipfs} -setup {
set file [makeFile {} vfszip.zip]
} -body {
set mnt [vfs::zip::Mount $file localmount]
} -cleanup {
................................................................................
fconfigure $f -translation binary
set data [read $f]
close $f
expr {[string length $data] == [file size vfszip31/articles/c_5498.xml]}
} -cleanup {
vfs::unmount vfszip31
} -result {1}
test vfsZip-4.0 "zip with preface code" -constraints {zipfs zipcat} -body {
vfs::zip::Mount zipcat.zip local
set r [glob -nocomplain -directory local -tails *]
vfs::unmount local
set r
} -result {zipfs.test}
test vfsZip-4.1 "zip with preface code" -constraints {zipfs zipcat} -setup {
vfs::zip::Mount zipcat.zip local
} -body {
set f [open local/zipfs.test/Aleph/One.txt r]
set r [string trim [read $f]]
close $f
set r
} -cleanup {
vfs::unmount local
} -result {File aleph one}
test vfsZip-9.0 "attempt to delete mounted file" -constraints {zipfs zipexe} -setup {
vfs::zip::Mount zipfs.zip local
} -body {
file delete zipfs.zip
} -cleanup {
vfs::unmount local
} -returnCodes {error} -result {error deleting "zipfs.zip": permission denied}
# cleanup
if {[testConstraint zipfs] && [testConstraint zipexe]} {
file delete -force zipfs.test
file delete zipfs.zip
file delete zipnest.zip
}
tcltest::cleanupTests
return
|