Artifact
3f726d01c664738cd8b9213d0d2376dbf050eb18:
Attachment "test2.tcl" to
ticket [5bfe3de008]
added by
andy
2017-08-09 20:31:43.
0000: 23 21 2f 62 69 6e 2f 62 61 73 68 0a 23 20 54 68 #!/bin/bash.# Th
0010: 69 73 20 63 6f 6d 6d 65 6e 74 20 68 69 64 65 73 is comment hides
0020: 20 74 68 65 20 6e 65 78 74 20 6c 69 6e 65 20 66 the next line f
0030: 72 6f 6d 20 74 68 65 20 54 63 6c 20 69 6e 74 65 rom the Tcl inte
0040: 72 70 72 65 74 65 72 2e 5c 0a 65 78 65 63 20 22 rpreter.\.exec "
0050: 24 28 64 69 72 6e 61 6d 65 20 22 24 30 22 29 2f $(dirname "$0")/
0060: 75 74 69 6c 2f 74 63 6c 6b 69 74 22 20 22 24 30 util/tclkit" "$0
0070: 22 20 22 24 40 22 0a 0a 6c 61 70 70 65 6e 64 20 " "$@"..lappend
0080: 61 75 74 6f 5f 70 61 74 68 20 6c 69 62 0a 70 61 auto_path lib.pa
0090: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 54 63 ckage require Tc
00a0: 6c 20 38 2e 36 0a 70 61 63 6b 61 67 65 20 72 65 l 8.6.package re
00b0: 71 75 69 72 65 20 76 66 73 0a 0a 70 72 6f 63 20 quire vfs..proc
00c0: 61 74 74 65 6d 70 74 20 7b 63 6f 6d 6d 61 6e 64 attempt {command
00d0: 7d 20 7b 0a 20 20 20 20 70 75 74 73 20 5b 73 74 } {. puts [st
00e0: 72 69 6e 67 20 72 65 70 65 61 74 20 2d 20 38 30 ring repeat - 80
00f0: 5d 5c 6e 24 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 ]\n$command.
0100: 74 61 69 6c 63 61 6c 6c 20 74 72 79 20 24 63 6f tailcall try $co
0110: 6d 6d 61 6e 64 20 6f 6e 20 65 72 72 6f 72 20 7b mmand on error {
0120: 6d 73 67 20 6f 70 74 69 6f 6e 73 7d 20 7b 0a 20 msg options} {.
0130: 20 20 20 20 20 20 20 70 75 74 73 20 73 74 64 65 puts stde
0140: 72 72 20 5b 64 69 63 74 20 67 65 74 20 24 6f 70 rr [dict get $op
0150: 74 69 6f 6e 73 20 2d 65 72 72 6f 72 69 6e 66 6f tions -errorinfo
0160: 5d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 ]. }.}..proc
0170: 62 61 74 74 65 72 79 20 7b 63 68 61 6e 7d 20 7b battery {chan} {
0180: 0a 20 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 . attempt {ch
0190: 61 6e 20 63 6f 6e 66 69 67 75 72 65 20 24 63 68 an configure $ch
01a0: 61 6e 20 2d 65 6f 66 63 68 61 72 20 5a 7d 0a 20 an -eofchar Z}.
01b0: 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 61 6e attempt {chan
01c0: 20 62 6c 6f 63 6b 65 64 20 24 63 68 61 6e 7d 0a blocked $chan}.
01d0: 20 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 61 attempt {cha
01e0: 6e 20 63 6f 6e 66 69 67 75 72 65 20 24 63 68 61 n configure $cha
01f0: 6e 7d 0a 20 20 20 20 61 74 74 65 6d 70 74 20 7b n}. attempt {
0200: 63 68 61 6e 20 63 6f 70 79 20 24 63 68 61 6e 20 chan copy $chan
0210: 24 63 68 61 6e 7d 0a 20 20 20 20 61 74 74 65 6d $chan}. attem
0220: 70 74 20 7b 63 68 61 6e 20 65 6f 66 20 24 63 68 pt {chan eof $ch
0230: 61 6e 7d 0a 20 20 20 20 61 74 74 65 6d 70 74 20 an}. attempt
0240: 7b 63 68 61 6e 20 65 76 65 6e 74 20 24 63 68 61 {chan event $cha
0250: 6e 20 72 65 61 64 61 62 6c 65 7d 0a 20 20 20 20 n readable}.
0260: 61 74 74 65 6d 70 74 20 7b 63 68 61 6e 20 65 76 attempt {chan ev
0270: 65 6e 74 20 24 63 68 61 6e 20 77 72 69 74 61 62 ent $chan writab
0280: 6c 65 7d 0a 20 20 20 20 61 74 74 65 6d 70 74 20 le}. attempt
0290: 7b 63 68 61 6e 20 66 6c 75 73 68 20 24 63 68 61 {chan flush $cha
02a0: 6e 7d 0a 20 20 20 20 61 74 74 65 6d 70 74 20 7b n}. attempt {
02b0: 63 68 61 6e 20 67 65 74 73 20 24 63 68 61 6e 7d chan gets $chan}
02c0: 0a 20 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 . attempt {ch
02d0: 61 6e 20 70 65 6e 64 69 6e 67 20 69 6e 70 75 74 an pending input
02e0: 20 24 63 68 61 6e 7d 0a 20 20 20 20 61 74 74 65 $chan}. atte
02f0: 6d 70 74 20 7b 63 68 61 6e 20 70 65 6e 64 69 6e mpt {chan pendin
0300: 67 20 6f 75 74 70 75 74 20 24 63 68 61 6e 7d 0a g output $chan}.
0310: 20 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 61 attempt {cha
0320: 6e 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e n puts -nonewlin
0330: 65 20 24 63 68 61 6e 20 68 65 6c 6c 6f 7d 0a 20 e $chan hello}.
0340: 20 20 20 61 74 74 65 6d 70 74 20 7b 63 68 61 6e attempt {chan
0350: 20 72 65 61 64 20 24 63 68 61 6e 7d 0a 20 20 20 read $chan}.
0360: 20 61 74 74 65 6d 70 74 20 7b 63 68 61 6e 20 73 attempt {chan s
0370: 65 65 6b 20 24 63 68 61 6e 20 30 7d 0a 20 20 20 eek $chan 0}.
0380: 20 61 74 74 65 6d 70 74 20 7b 63 68 61 6e 20 73 attempt {chan s
0390: 65 65 6b 20 24 63 68 61 6e 20 30 20 63 75 72 72 eek $chan 0 curr
03a0: 65 6e 74 7d 0a 20 20 20 20 61 74 74 65 6d 70 74 ent}. attempt
03b0: 20 7b 63 68 61 6e 20 73 65 65 6b 20 24 63 68 61 {chan seek $cha
03c0: 6e 20 30 20 65 6e 64 7d 0a 20 20 20 20 61 74 74 n 0 end}. att
03d0: 65 6d 70 74 20 7b 63 68 61 6e 20 74 65 6c 6c 20 empt {chan tell
03e0: 24 63 68 61 6e 7d 0a 20 20 20 20 61 74 74 65 6d $chan}. attem
03f0: 70 74 20 7b 63 68 61 6e 20 74 72 75 6e 63 61 74 pt {chan truncat
0400: 65 20 24 63 68 61 6e 7d 0a 20 20 20 20 61 74 74 e $chan}. att
0410: 65 6d 70 74 20 7b 63 68 61 6e 20 63 6c 6f 73 65 empt {chan close
0420: 20 24 63 68 61 6e 7d 0a 7d 0a 0a 70 72 6f 63 20 $chan}.}..proc
0430: 6d 6f 75 6e 74 20 7b 64 69 72 20 7b 6d 6f 64 65 mount {dir {mode
0440: 4f 76 65 72 72 69 64 65 20 7b 7d 7d 7d 20 7b 0a Override {}}} {.
0450: 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 vfs::filesys
0460: 74 65 6d 20 6d 6f 75 6e 74 20 24 64 69 72 20 5b tem mount $dir [
0470: 6c 69 73 74 5c 0a 20 20 20 20 61 70 70 6c 79 20 list\. apply
0480: 7b 7b 6d 6f 64 65 4f 76 65 72 72 69 64 65 20 6f {{modeOverride o
0490: 70 65 72 61 74 69 6f 6e 20 72 6f 6f 74 20 72 65 peration root re
04a0: 6c 61 74 69 76 65 20 61 63 74 75 61 6c 20 61 72 lative actual ar
04b0: 67 73 7d 20 7b 0a 20 20 20 20 20 20 20 20 70 75 gs} {. pu
04c0: 74 73 20 5b 6c 69 73 74 20 76 66 73 20 24 6f 70 ts [list vfs $op
04d0: 65 72 61 74 69 6f 6e 20 24 72 6f 6f 74 20 24 72 eration $root $r
04e0: 65 6c 61 74 69 76 65 20 24 61 63 74 75 61 6c 20 elative $actual
04f0: 7b 2a 7d 24 61 72 67 73 5d 0a 20 20 20 20 20 20 {*}$args].
0500: 20 20 69 66 20 7b 24 6f 70 65 72 61 74 69 6f 6e if {$operation
0510: 20 65 71 20 22 6f 70 65 6e 22 7d 20 7b 0a 20 20 eq "open"} {.
0520: 20 20 20 20 20 20 20 20 20 20 6c 61 73 73 69 67 lassig
0530: 6e 20 24 61 72 67 73 20 6d 6f 64 65 20 70 65 72 n $args mode per
0540: 6d 69 73 73 69 6f 6e 73 0a 20 20 20 20 20 20 20 missions.
0550: 20 20 20 20 20 69 66 20 7b 5b 6c 6c 65 6e 67 74 if {[llengt
0560: 68 20 24 6d 6f 64 65 4f 76 65 72 72 69 64 65 5d h $modeOverride]
0570: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
0580: 20 20 20 20 73 65 74 20 6d 6f 64 65 20 24 6d 6f set mode $mo
0590: 64 65 4f 76 65 72 72 69 64 65 0a 20 20 20 20 20 deOverride.
05a0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05c0: 73 65 74 20 6d 6f 64 65 20 5b 64 69 63 74 20 67 set mode [dict g
05d0: 65 74 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 et {.
05e0: 20 20 20 20 20 20 20 20 20 7b 7d 20 72 65 61 64 {} read
05f0: 20 77 20 77 72 69 74 65 20 61 20 77 72 69 74 65 w write a write
0600: 20 77 2b 20 7b 72 65 61 64 20 77 72 69 74 65 7d w+ {read write}
0610: 20 61 2b 20 7b 72 65 61 64 20 77 72 69 74 65 7d a+ {read write}
0620: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0630: 20 7d 20 24 6d 6f 64 65 5d 0a 20 20 20 20 20 20 } $mode].
0640: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 }.
0650: 20 20 20 20 63 68 61 6e 20 63 72 65 61 74 65 20 chan create
0660: 24 6d 6f 64 65 20 7b 61 70 70 6c 79 20 7b 7b 6f $mode {apply {{o
0670: 70 65 72 61 74 69 6f 6e 20 61 72 67 73 7d 20 7b peration args} {
0680: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0690: 20 70 75 74 73 20 5b 6c 69 73 74 20 72 65 66 63 puts [list refc
06a0: 68 61 6e 20 24 6f 70 65 72 61 74 69 6f 6e 20 7b han $operation {
06b0: 2a 7d 24 61 72 67 73 5d 0a 20 20 20 20 20 20 20 *}$args].
06c0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 24 6f 70 if {$op
06d0: 65 72 61 74 69 6f 6e 20 65 71 20 22 69 6e 69 74 eration eq "init
06e0: 69 61 6c 69 7a 65 22 7d 20 7b 0a 20 20 20 20 20 ialize"} {.
06f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
0700: 65 74 75 72 6e 20 7b 0a 20 20 20 20 20 20 20 20 eturn {.
0710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0720: 69 6e 69 74 69 61 6c 69 7a 65 20 66 69 6e 61 6c initialize final
0730: 69 7a 65 20 77 61 74 63 68 20 72 65 61 64 20 77 ize watch read w
0740: 72 69 74 65 20 73 65 65 6b 20 63 6f 6e 66 69 67 rite seek config
0750: 75 72 65 20 63 67 65 74 0a 20 20 20 20 20 20 20 ure cget.
0760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0770: 20 63 67 65 74 61 6c 6c 20 62 6c 6f 63 6b 69 6e cgetall blockin
0780: 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 g.
0790: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 }.
07a0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 69 66 } elseif
07b0: 20 7b 24 6f 70 65 72 61 74 69 6f 6e 20 65 71 20 {$operation eq
07c0: 22 77 72 69 74 65 22 7d 20 7b 0a 20 20 20 20 20 "write"} {.
07d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l
07e0: 61 73 73 69 67 6e 20 24 61 72 67 73 20 63 68 61 assign $args cha
07f0: 6e 6e 65 6c 49 64 20 64 61 74 61 0a 20 20 20 20 nnelId data.
0800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0810: 72 65 74 75 72 6e 20 5b 73 74 72 69 6e 67 20 6c return [string l
0820: 65 6e 67 74 68 20 24 64 61 74 61 5d 0a 20 20 20 ength $data].
0830: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
0840: 6c 73 65 69 66 20 7b 24 6f 70 65 72 61 74 69 6f lseif {$operatio
0850: 6e 20 65 71 20 22 73 65 65 6b 22 7d 20 7b 0a 20 n eq "seek"} {.
0860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0870: 20 20 20 72 65 74 75 72 6e 20 30 0a 20 20 20 20 return 0.
0880: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 }.
0890: 20 20 20 20 20 20 20 20 20 20 7d 7d 7d 0a 20 20 }}}.
08a0: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 7d 20 24 }. }} $
08b0: 6d 6f 64 65 4f 76 65 72 72 69 64 65 5d 0a 7d 0a modeOverride].}.
08c0: 0a 66 6f 72 65 61 63 68 20 7b 64 69 72 20 6d 6f .foreach {dir mo
08d0: 64 65 4f 76 65 72 72 69 64 65 7d 20 7b 0a 20 20 deOverride} {.
08e0: 20 20 2f 74 65 73 74 2d 6e 6f 72 6d 61 6c 20 7b /test-normal {
08f0: 7d 0a 20 20 20 20 2f 74 65 73 74 2d 72 20 72 65 }. /test-r re
0900: 61 64 0a 20 20 20 20 2f 74 65 73 74 2d 77 20 77 ad. /test-w w
0910: 72 69 74 65 0a 20 20 20 20 2f 74 65 73 74 2d 72 rite. /test-r
0920: 77 20 7b 72 65 61 64 20 77 72 69 74 65 7d 0a 7d w {read write}.}
0930: 20 7b 0a 20 20 20 20 6d 6f 75 6e 74 20 24 64 69 {. mount $di
0940: 72 20 24 6d 6f 64 65 4f 76 65 72 72 69 64 65 0a r $modeOverride.
0950: 20 20 20 20 62 61 74 74 65 72 79 20 5b 61 74 74 battery [att
0960: 65 6d 70 74 20 7b 6f 70 65 6e 20 5b 66 69 6c 65 empt {open [file
0970: 20 6a 6f 69 6e 20 24 64 69 72 20 72 65 61 64 5d join $dir read]
0980: 20 72 7d 5d 0a 20 20 20 20 62 61 74 74 65 72 79 r}]. battery
0990: 20 5b 61 74 74 65 6d 70 74 20 7b 6f 70 65 6e 20 [attempt {open
09a0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 20 [file join $dir
09b0: 77 72 69 74 65 5d 20 77 7d 5d 0a 20 20 20 20 61 write] w}]. a
09c0: 74 74 65 6d 70 74 20 7b 73 6f 75 72 63 65 20 5b ttempt {source [
09d0: 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 20 73 file join $dir s
09e0: 6f 75 72 63 65 5d 7d 0a 20 20 20 20 76 66 73 3a ource]}. vfs:
09f0: 3a 66 69 6c 65 73 79 73 74 65 6d 20 75 6e 6d 6f :filesystem unmo
0a00: 75 6e 74 20 24 64 69 72 0a 7d 0a 0a 23 20 76 69 unt $dir.}..# vi
0a10: 6d 3a 20 73 65 74 20 73 74 73 3d 34 20 73 77 3d m: set sts=4 sw=
0a20: 34 20 74 77 3d 38 30 20 65 74 20 66 74 3d 74 63 4 tw=80 et ft=tc
0a30: 6c 3a 0a l:.
