Tcl Library Source Code

Changes On Branch tkt-5465d70388-ak-virt-seek-end
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Hide Diff Patch Unified Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tkt-5465d70388-ak-virt-seek-end Excluding Merge-Ins

This is equivalent to a diff from 4cee7d176d to bdce7f7a76

2017-08-08
01:21
Merged fixes for ticket [5465d70388] check-in: 501a905042 user: aku tags: trunk
01:19
Fixed issue with seeking from end. Bumped versions (patchlevel). Closed-Leaf check-in: bdce7f7a76 user: aku tags: tkt-5465d70388-ak-virt-seek-end
01:16
More testsuites check-in: 334aafb9ed user: aku tags: tkt-5465d70388-ak-virt-seek-end
00:29
Create new branch named "tkt-5465d70388-ak-virt-seek-end" check-in: f0cafcb40c user: aku tags: tkt-5465d70388-ak-virt-seek-end
00:25
Ticket [f1192d2035]. Updated IBAN definitions. Bumped to Version 1.7. Updated tests. check-in: 4cee7d176d user: aku tags: trunk
00:00
Ticket [b9cc3f892d]. Fixed, i.e. disabled plethora of rogue debugging output. check-in: 232ea3ae18 user: aku tags: trunk

Changes to modules/virtchannel_base/memchan.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# Variable string channel (in-memory r/w file, internal variable).
# Seekable beyond the end of the data, implies appending of 0x00
# bytes.

# @@ Meta Begin
# Package tcl::chan::memchan 1.0.2
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Re-implementation of Memchan's memchan
# Meta description channel. Based on Tcl 8.5's channel
# Meta description reflection support. Exports a single
# Meta description command for the creation of new










|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# Variable string channel (in-memory r/w file, internal variable).
# Seekable beyond the end of the data, implies appending of 0x00
# bytes.

# @@ Meta Begin
# Package tcl::chan::memchan 1.0.4
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Re-implementation of Memchan's memchan
# Meta description channel. Based on Tcl 8.5's channel
# Meta description reflection support. Exports a single
# Meta description command for the creation of new
︙︙
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152

	}

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset    }] }
	    end     { set newloc [expr {$max + $offset - 1}] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc >= $max} {
	    # We can seek beyond the end of the current contents, add
	    # a block of zeros.

	    append content [binary format @[expr {$newloc - $max}]]
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc

	my Events








|
|







|


>








127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

	}

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset }] }
	    end     { set newloc [expr {$max + $offset }] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc > $max} {
	    # We can seek beyond the end of the current contents, add
	    # a block of zeros.
	    #puts XXX.PAD.[expr {$newloc - $max}]
	    append content [binary format @[expr {$newloc - $max}]]
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc

	my Events
︙︙
160
161
162
163
164
165
166
167
168

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::memchan 1.0.3
return








|


161
162
163
164
165
166
167
168
169

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::memchan 1.0.4
return

Added modules/virtchannel_base/memchan.test. 



























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92

# -------------------------------------------------------------------------
# memchan.test -*- tcl -*-
# (C) 2017 Andreas Kupries. BSD licensed.
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0
testsNeed        TclOO 1

support {
    use virtchannel_core/core.tcl   tcl::chan::core
    use virtchannel_core/events.tcl tcl::chan::events
}
testing {
    useLocal memchan.tcl tcl::chan::memchan
}

# -------------------------------------------------------------------------

test tcl-chan-memchan-1.0 {constructor wrong\#args} -body {
    tcl::chan::memchan X
} -returnCodes error \
    -result {wrong # args: should be "tcl::chan::memchan"}

# -------------------------------------------------------------------------

test tcl-chan-memchan-2.0 {tell, initial, empty} -setup {
    set c [tcl::chan::memchan]
} -body {
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

test tcl-chan-memchan-2.1 {seek from start, expand, tell} -setup {
    set c [tcl::chan::memchan]
} -body {
    seek $c 10
    tell $c
} -cleanup {
    close $c
    unset c
} -result 10

test tcl-chan-memchan-2.2 {seek from end, eof, empty, tell} -setup {
    set c [tcl::chan::memchan]
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

test tcl-chan-memchan-2.3 {seek from end, eof, non-empty, tell} -setup {
    set c [tcl::chan::memchan]
    puts $c Hello
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 6

test tcl-chan-memchan-2.4 {seek from end, non-eof, non-empty, tell} -setup {
    set c [tcl::chan::memchan]
    puts $c Hello
} -body {
    seek $c -6 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

# -------------------------------------------------------------------------
# Explicit cleanup of loaded support classes.
rename tcl::chan::events {}
rename tcl::chan::core   {}
testsuiteCleanup
return

# Local Variables:
#  mode: tcl
#  indent-tabs-mode: nil
# End:

Changes to modules/virtchannel_base/pkgIndex.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

if {![package vsatisfies [package provide Tcl] 8.5]} {return}

package ifneeded tcl::chan::cat 1.0.2      [list source [file join $dir cat.tcl]]
package ifneeded tcl::chan::facade 1.0.1   [list source [file join $dir facade.tcl]]
package ifneeded tcl::chan::fifo 1         [list source [file join $dir fifo.tcl]]
package ifneeded tcl::chan::fifo2 1        [list source [file join $dir fifo2.tcl]]
package ifneeded tcl::chan::halfpipe 1     [list source [file join $dir halfpipe.tcl]]
package ifneeded tcl::chan::memchan 1.0.3  [list source [file join $dir memchan.tcl]]
package ifneeded tcl::chan::null 1         [list source [file join $dir null.tcl]]
package ifneeded tcl::chan::nullzero 1     [list source [file join $dir nullzero.tcl]]
package ifneeded tcl::chan::random 1       [list source [file join $dir random.tcl]]
package ifneeded tcl::chan::std 1.0.1      [list source [file join $dir std.tcl]]
package ifneeded tcl::chan::string 1.0.2   [list source [file join $dir string.tcl]]
package ifneeded tcl::chan::textwindow 1   [list source [file join $dir textwindow.tcl]]
package ifneeded tcl::chan::variable 1.0.3 [list source [file join $dir variable.tcl]]
package ifneeded tcl::chan::zero 1         [list source [file join $dir zero.tcl]]
package ifneeded tcl::randomseed 1         [list source [file join $dir randseed.tcl]]








|




|

|



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

if {![package vsatisfies [package provide Tcl] 8.5]} {return}

package ifneeded tcl::chan::cat 1.0.2      [list source [file join $dir cat.tcl]]
package ifneeded tcl::chan::facade 1.0.1   [list source [file join $dir facade.tcl]]
package ifneeded tcl::chan::fifo 1         [list source [file join $dir fifo.tcl]]
package ifneeded tcl::chan::fifo2 1        [list source [file join $dir fifo2.tcl]]
package ifneeded tcl::chan::halfpipe 1     [list source [file join $dir halfpipe.tcl]]
package ifneeded tcl::chan::memchan 1.0.4  [list source [file join $dir memchan.tcl]]
package ifneeded tcl::chan::null 1         [list source [file join $dir null.tcl]]
package ifneeded tcl::chan::nullzero 1     [list source [file join $dir nullzero.tcl]]
package ifneeded tcl::chan::random 1       [list source [file join $dir random.tcl]]
package ifneeded tcl::chan::std 1.0.1      [list source [file join $dir std.tcl]]
package ifneeded tcl::chan::string 1.0.3   [list source [file join $dir string.tcl]]
package ifneeded tcl::chan::textwindow 1   [list source [file join $dir textwindow.tcl]]
package ifneeded tcl::chan::variable 1.0.4 [list source [file join $dir variable.tcl]]
package ifneeded tcl::chan::zero 1         [list source [file join $dir zero.tcl]]
package ifneeded tcl::randomseed 1         [list source [file join $dir randseed.tcl]]

Changes to modules/virtchannel_base/string.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# @@ Meta Begin
# Package tcl::chan::string 1
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a channel representing
# Meta description an in-memory read-only random-access
# Meta description file. Based on using Tcl 8.5's channel
# Meta description reflection support. Exports a single






|








1
2
3
4
5
6
7
8
9
10
11
12
13

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# @@ Meta Begin
# Package tcl::chan::string 1.0.3
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a channel representing
# Meta description an in-memory read-only random-access
# Meta description file. Based on using Tcl 8.5's channel
# Meta description reflection support. Exports a single
︙︙
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

	}

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset    }] }
	    end     { set newloc [expr {$max + $offset - 1}] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc >= $max} {
	    return -code error "Cannot seek after the end of the channel"
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc

	my Events








|
|







|








85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

	}

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset }] }
	    end     { set newloc [expr {$max + $offset }] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc > $max} {
	    return -code error "Cannot seek after the end of the channel"
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc

	my Events
︙︙
116
117
118
119
120
121
122
123
124

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::string 1.0.2
return








|


116
117
118
119
120
121
122
123
124

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::string 1.0.3
return

Added modules/virtchannel_base/string.test. 































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94

# -------------------------------------------------------------------------
# string.test -*- tcl -*-
# (C) 2017 Andreas Kupries. BSD licensed.
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0
testsNeed        TclOO 1

support {
    use virtchannel_core/core.tcl   tcl::chan::core
    use virtchannel_core/events.tcl tcl::chan::events
}
testing {
    useLocal string.tcl tcl::chan::string
}

# -------------------------------------------------------------------------

test tcl-chan-string-1.0 {constructor wrong\#args} -body {
    tcl::chan::string
} -returnCodes error \
    -result {wrong # args: should be "tcl::chan::string content"}

test tcl-chan-string-1.1 {constructor wrong\#args} -body {
    tcl::chan::string C X
} -returnCodes error \
    -result {wrong # args: should be "tcl::chan::string content"}

# -------------------------------------------------------------------------

test tcl-chan-string-2.0 {tell, initial, empty} -setup {
    set c [tcl::chan::string ""]
} -body {
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

test tcl-chan-string-2.1 {seek from start beyond eof is error} -setup {
    set c [tcl::chan::string ""]
} -body {
    seek $c 10
} -cleanup {
    close $c
    unset c
} -returnCodes error -result {Cannot seek after the end of the channel}

test tcl-chan-string-2.2 {seek from end, eof, empty, tell} -setup {
    set c [tcl::chan::string ""]
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

test tcl-chan-string-2.3 {seek from end, eof, non-empty, tell} -setup {
    set c [tcl::chan::string Hello\n]
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 6

test tcl-chan-string-2.4 {seek from end, non-eof, non-empty, tell} -setup {
    set c [tcl::chan::string Hello\n]
} -body {
    seek $c -6 end
    tell $c
} -cleanup {
    close $c
    unset c
} -result 0

# -------------------------------------------------------------------------
# Explicit cleanup of loaded support classes.
rename tcl::chan::events {}
rename tcl::chan::core   {}
testsuiteCleanup
return

# Local Variables:
#  mode: tcl
#  indent-tabs-mode: nil
# End:

Changes to modules/virtchannel_base/tcllib_memchan.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::memchan n 1]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {In-memory channel}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::memchan [opt 1]]
[description]
[para]

The [package tcl::chan::memchan] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable. This is equivalent to the memchan channels provided by
the package [package Memchan], except that this is written in pure Tcl,

>

|




|






|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

[vset VERSION 1.0.4]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::memchan n [vset VERSION]]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009-2017 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {In-memory channel}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::memchan [opt [vset VERSION]]]
[description]
[para]

The [package tcl::chan::memchan] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable. This is equivalent to the memchan channels provided by
the package [package Memchan], except that this is written in pure Tcl,
︙︙

Changes to modules/virtchannel_base/tcllib_string.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::string n 1]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {Read-only in-memory channel}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::string [opt 1]]
[description]
[para]

The [package tcl::chan::string] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable.


>

|











|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

[vset VERSION 1.0.3]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::string n [vset VERSION]]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {Read-only in-memory channel}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::string [opt [vset VERSION]]]
[description]
[para]

The [package tcl::chan::string] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable.
︙︙

Changes to modules/virtchannel_base/tcllib_variable.man. 


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::variable n 1]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {In-memory channel using variable for storage}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::variable [opt 1]]
[description]
[para]

The [package tcl::chan::variable] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable.


>

|











|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

[vset VERSION 1.0.4]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin tcl::chan::variable n [vset VERSION]]
[keywords {in-memory channel}]
[keywords {reflected channel}]
[keywords {tip 219}]
[keywords {virtual channel}]
[copyright {2009 Andreas Kupries <[email protected]>}]
[moddesc   {Reflected/virtual channel support}]
[category  Channels]
[titledesc {In-memory channel using variable for storage}]
[require Tcl 8.5]
[require TclOO]
[require tcl::chan::events [opt 1]]
[require tcl::chan::variable [opt [vset VERSION]]]
[description]
[para]

The [package tcl::chan::variable] package provides a command creating
channels which live purely in memory. They provide random-access,
i.e. are seekable.
︙︙

Changes to modules/virtchannel_base/variable.tcl. 

1
2
3
4
5
6
7
8
9
10
11
12
13

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# @@ Meta Begin
# Package tcl::chan::variable 1.0.2
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a channel representing
# Meta description an in-memory read-write random-access
# Meta description file. Based on Tcl 8.5's channel reflection
# Meta description support. Exports a single command for the






|








1
2
3
4
5
6
7
8
9
10
11
12
13

# -*- tcl -*-
# # ## ### ##### ######## #############
# (C) 2009 Andreas Kupries

# @@ Meta Begin
# Package tcl::chan::variable 1.0.4
# Meta as::author {Andreas Kupries}
# Meta as::copyright 2009
# Meta as::license BSD
# Meta description Implementation of a channel representing
# Meta description an in-memory read-write random-access
# Meta description file. Based on Tcl 8.5's channel reflection
# Meta description support. Exports a single command for the
︙︙
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

	upvar #0 $varname content

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset    }] }
	    end     { set newloc [expr {$max + $offset - 1}] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc >= $max} {
	    # We can seek beyond the end of the current contents, add
	    # a block of zeros.
	    append content [binary format @[expr {$newloc - $max}]]
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc








|
|







|








140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

	upvar #0 $varname content

	# Compute the new location per the arguments.

	set max [string length $content]
	switch -exact -- $base {
	    start   { set newloc $offset}
	    current { set newloc [expr {$at  + $offset }] }
	    end     { set newloc [expr {$max + $offset }] }
	}

	# Check if the new location is beyond the range given by the
	# content.

	if {$newloc < 0} {
	    return -code error "Cannot seek before the start of the channel"
	} elseif {$newloc > $max} {
	    # We can seek beyond the end of the current contents, add
	    # a block of zeros.
	    append content [binary format @[expr {$newloc - $max}]]
	}

	# Commit to new location, switch readable events, and report.
	set at $newloc
︙︙
173
174
175
176
177
178
179
180
181

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::variable 1.0.3
return








|


173
174
175
176
177
178
179
180
181

	# properly processed by the event handler. Like for regular
	# files -- Ticket [864a0c83e3].
	my allow read
    }
}

# # ## ### ##### ######## #############
package provide tcl::chan::variable 1.0.4
return

Added modules/virtchannel_base/variable.test. 















































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

# -------------------------------------------------------------------------
# variable.test -*- tcl -*-
# (C) 2017 Andreas Kupries. BSD licensed.
# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0
testsNeed        TclOO 1

support {
    use virtchannel_core/core.tcl   tcl::chan::core
    use virtchannel_core/events.tcl tcl::chan::events
}
testing {
    useLocal variable.tcl tcl::chan::variable
}

# -------------------------------------------------------------------------

test tcl-chan-variable-1.0 {constructor wrong\#args} -body {
    tcl::chan::variable
} -returnCodes error \
    -result {wrong # args: should be "tcl::chan::variable varname"}

test tcl-chan-variable-1.1 {constructor wrong\#args} -body {
    tcl::chan::variable V X
} -returnCodes error \
    -result {wrong # args: should be "tcl::chan::variable varname"}

# -------------------------------------------------------------------------

test tcl-chan-variable-2.0 {tell, initial, empty} -setup {
    set content ""
    set c [tcl::chan::variable content]
} -body {
    tell $c
} -cleanup {
    close $c
    unset c content
} -result 0

test tcl-chan-variable-2.1 {seek from start, expand, tell} -setup {
    set content ""
    set c [tcl::chan::variable content]
} -body {
    seek $c 10
    tell $c
} -cleanup {
    close $c
    unset c content
} -result 10

test tcl-chan-variable-2.2 {seek from end, eof, empty, tell} -setup {
    set content ""
    set c [tcl::chan::variable content]
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c content
} -result 0

test tcl-chan-variable-2.3 {seek from end, eof, non-empty, tell} -setup {
    set content ""
    set c [tcl::chan::variable content]
    puts $c Hello
} -body {
    seek $c 0 end
    tell $c
} -cleanup {
    close $c
    unset c content
} -result 6

test tcl-chan-variable-2.4 {seek from end, non-eof, non-empty, tell} -setup {
    set content ""
    set c [tcl::chan::variable content]
    puts $c Hello
} -body {
    seek $c -6 end
    tell $c
} -cleanup {
    close $c
    unset c content
} -result 0

# -------------------------------------------------------------------------
# Explicit cleanup of loaded support classes.
rename tcl::chan::events {}
rename tcl::chan::core   {}
testsuiteCleanup
return

# Local Variables:
#  mode: tcl
#  indent-tabs-mode: nil
# End:

This page was generated in about 0.067s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19