Tcl Library Source Code

Check-in [c02f41029b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Fix ticket [6e778502b8]. Minor code fix. Argument parsing for the "flatten" command executed a "break" when the "--" argument was found. This caused the execution to break out of the enclosing while loop. That, in turn, means the argument set was not adjusted for the "--" argument itself. Looks like a simple case of confusing "break" behavior in Tcl with "break" behavior in "C".
Timelines: family | ancestors | descendants | both | tkt-6e778502b8
Files: files | file ages | folders
SHA3-256: c02f41029b09f0dbf33b9f7f31f8bb8a9bd2aa1ef334cade216b69602d94d229
User & Date: andrewm 2019-01-05 19:47:12
Context
2019-02-26
06:06
Import trunk fixes Closed-Leaf check-in: bc477e224e user: aku tags: tkt-6e778502b8
2019-01-05
19:47
Fix ticket [6e778502b8]. Minor code fix. Argument parsing for the "flatten" command executed a "break" when the "--" argument was found. This caused the execution to break out of the enclosing while loop. That, in turn, means the argument set was not adjusted for the "--" argument itself. Looks like a simple case of confusing "break" behavior in Tcl with "break" behavior in "C". check-in: c02f41029b user: andrewm tags: tkt-6e778502b8
19:28
Create new branch named "tkt-6e778502b8" check-in: 38995cc193 user: andrewm tags: tkt-6e778502b8
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/struct/list.tcl.

643
644
645
646
647
648
649
650



651
652
653
654
655
656
657
....
1821
1822
1823
1824
1825
1826
1827
1828
		"wrong#args: should be \"::struct::list::Lflatten ?-full? ?--? sequence\""
    }

    set full 0
    while {[string match -* [set opt [::lindex $args 0]]]} {
	switch -glob -- $opt {
	    -full   {set full 1}
	    --      {break}



	    default {
		return -code error "Unknown option \"$opt\", should be either -full, or --"
	    }
	}
	set args [::lrange $args 1 end]
    }

................................................................................
## Ready

namespace eval ::struct {
    # Get 'list::list' into the general structure namespace.
    namespace import -force list::list
    namespace export list
}
package provide struct::list 1.8.3






|
>
>
>







 







|
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
....
1824
1825
1826
1827
1828
1829
1830
1831
		"wrong#args: should be \"::struct::list::Lflatten ?-full? ?--? sequence\""
    }

    set full 0
    while {[string match -* [set opt [::lindex $args 0]]]} {
	switch -glob -- $opt {
	    -full   {set full 1}
	    --      {
                set args [::lrange $args 1 end]
                break ; # fix ticket 6e778502b8 -- break exits while loop
            }
	    default {
		return -code error "Unknown option \"$opt\", should be either -full, or --"
	    }
	}
	set args [::lrange $args 1 end]
    }

................................................................................
## Ready

namespace eval ::struct {
    # Get 'list::list' into the general structure namespace.
    namespace import -force list::list
    namespace export list
}
package provide struct::list 1.8.4

Changes to modules/struct/list.test.

386
387
388
389
390
391
392




393
394
395
396
397
398
399
test flatten-1.5 {flatten command} {
    flatten [list "'" "\""]
} {' {"}} ; # " help emacs highlighting

test flatten-1.6 {flatten command} {
    flatten [list "{" "}"]
} "\\\{ \\\}"





test flatten-2.1 {flatten errors} {
    list [catch {flatten} msg] $msg
} {1 {wrong#args: should be "::struct::list::Lflatten ?-full? ?--? sequence"}}

test flatten-2.2 {flatten errors} {
    list [catch {flatten -all {a {b c d} {e {f g}}}} msg] $msg






>
>
>
>







386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
test flatten-1.5 {flatten command} {
    flatten [list "'" "\""]
} {' {"}} ; # " help emacs highlighting

test flatten-1.6 {flatten command} {
    flatten [list "{" "}"]
} "\\\{ \\\}"

test flatten-1.7 {check -- argument termination} {
    flatten -full -- {1 2 3 {4 5} {6 7} {{8 9}} 10}
} {1 2 3 4 5 6 7 8 9 10}

test flatten-2.1 {flatten errors} {
    list [catch {flatten} msg] $msg
} {1 {wrong#args: should be "::struct::list::Lflatten ?-full? ?--? sequence"}}

test flatten-2.2 {flatten errors} {
    list [catch {flatten -all {a {b c d} {e {f g}}}} msg] $msg

Changes to modules/struct/pkgIndex.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
package ifneeded struct::skiplist  1.3   [list source [file join $dir skiplist.tcl]]

package ifneeded struct::graph     1.2.1 [list source [file join $dir graph1.tcl]]
package ifneeded struct::tree      1.2.2 [list source [file join $dir tree1.tcl]]
package ifneeded struct::matrix    1.2.1 [list source [file join $dir matrix1.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded struct::list      1.8.3  [list source [file join $dir list.tcl]]
package ifneeded struct::graph     2.4.1  [list source [file join $dir graph.tcl]]

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

if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded struct::disjointset 1.1 [list source [file join $dir disjointset.tcl]]
package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]






|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
package ifneeded struct::skiplist  1.3   [list source [file join $dir skiplist.tcl]]

package ifneeded struct::graph     1.2.1 [list source [file join $dir graph1.tcl]]
package ifneeded struct::tree      1.2.2 [list source [file join $dir tree1.tcl]]
package ifneeded struct::matrix    1.2.1 [list source [file join $dir matrix1.tcl]]

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded struct::list      1.8.4  [list source [file join $dir list.tcl]]
package ifneeded struct::graph     2.4.1  [list source [file join $dir graph.tcl]]

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

if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded struct::disjointset 1.1 [list source [file join $dir disjointset.tcl]]
package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]

Changes to modules/struct/struct_list.man.

1
2
3
4
5
6
7
8
9
10
[comment {-*- tcl -*- doctools manpage}]
[comment {$Id: struct_list.man,v 1.24 2010/10/05 21:47:25 andreas_kupries Exp $}]
[vset LIST_VERSION 1.8.3]
[manpage_begin struct::list n [vset LIST_VERSION]]
[keywords assign]
[keywords common]
[keywords comparison]
[keywords diff]
[keywords differential]
[keywords equal]

|







1
2
3
4
5
6
7
8
9
10
[comment {-*- tcl -*- doctools manpage}]
[comment {$Id: struct_list.man,v 1.24 2010/10/05 21:47:25 andreas_kupries Exp $}]
[vset LIST_VERSION 1.8.4]
[manpage_begin struct::list n [vset LIST_VERSION]]
[keywords assign]
[keywords common]
[keywords comparison]
[keywords diff]
[keywords differential]
[keywords equal]