Tcl Library Source Code

Check-in [ca21301c2a]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Import trunk fixes Tweak manpage a bit for easier version update. Tweak package index to check core version.
Timelines: family | ancestors | descendants | both | add-lazyset
Files: files | file ages | folders
SHA3-256: ca21301c2ae30d847d34d8cb37b59c636ca94c97da6d553ae3064b2192dd7b8a
User & Date: aku 2019-02-21 23:39:21
Context
2019-02-22
00:54
Added Roy Keene's new package, 'lazyset' (determine a value on 1st read of a variable) check-in: 49fdc19548 user: aku tags: trunk
2019-02-21
23:39
Import trunk fixes Tweak manpage a bit for easier version update. Tweak package index to check core version. Closed-Leaf check-in: ca21301c2a user: aku tags: add-lazyset
2019-02-20
05:39
Test fixes in assorted modules - hook: Updated to match changes in 8.6+ core error stack results. - html: Undone bad removal of some trailing whitespace. - markdown: Fixed bad name of untabify2 function, and fixed result postprocessing in tests. - math::pca is Tcl 8.6+ - string::token::shell: Updated to match result variation starting with 8.6. check-in: e6742077ec user: aku tags: trunk
2018-12-31
04:49
Updated to only append one name if array is not being used check-in: 3f2d995fa7 user: rkeene tags: add-lazyset
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/hook/hook.test. 

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    hook bind S1 <H1> O1 {error "simulated error"}
    hook call S1 <H1>
    GetError
} -cleanup {
    cleanup
} -result [EResult \
	       {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorcode NONE}}} \
	       {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {::hook::call S1 <H1>}} -errorcode NONE}}}]

test errorcommand-1.3 {handled errors don't break sequence of calls} -body {
    hook configure -errorcommand ErrorCommand

    TestBind  S1 <H1> O1
    hook bind S1 <H1> O2 {error "simulated error"}
    TestBind  S1 <H1> O3
    hook call S1 <H1>
    list [GetCalls] [GetError]
} -cleanup {
    cleanup
} -result [EResult \
	       {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorcode NONE}}}} \
	       {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {::hook::call S1 <H1>}} -errorcode NONE}}}}]

test errorcommand-1.4 {-errorcommand handles other exceptions} -body {
    hook configure -errorcommand ErrorCommand

    hook bind S1 <H1> O1 {return -code break "simulated break"}
    hook call S1 <H1>
    GetError







|













|








438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466

    hook bind S1 <H1> O1 {error "simulated error"}
    hook call S1 <H1>
    GetError
} -cleanup {
    cleanup
} -result [EResult \
	       {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorcode NONE}}} \
	       {{{S1 <H1> {} O1} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {call S1 <H1>}} -errorcode NONE}}}]

test errorcommand-1.3 {handled errors don't break sequence of calls} -body {
    hook configure -errorcommand ErrorCommand

    TestBind  S1 <H1> O1
    hook bind S1 <H1> O2 {error "simulated error"}
    TestBind  S1 <H1> O3
    hook call S1 <H1>
    list [GetCalls] [GetError]
} -cleanup {
    cleanup
} -result [EResult \
	       {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorcode NONE}}}} \
	       {{{S1 <H1> O1 {}} {S1 <H1> O3 {}}} {{{S1 <H1> {} O2} {simulated error} {-code 1 -level 0 -errorstack {INNER {error {simulated error}} UP 1 CALL {call S1 <H1>}} -errorcode NONE}}}}]

test errorcommand-1.4 {-errorcommand handles other exceptions} -body {
    hook configure -errorcommand ErrorCommand

    hook bind S1 <H1> O1 {return -code break "simulated break"}
    hook call S1 <H1>
    GetError

Changes to modules/html/html.test. 

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606

test html-27.8 {html::foreach--subst body w/ nested foreach} {
    html::foreach x {a b} {
        [html::foreach y {c d} {$x$y}]
    }
} {
        acad

        bcbd
    }

test html-27.9 {html::foreach--subst body w/ multiple nested foreach's} {
    html::foreach x {a b} {
        [html::foreach y {c d} {$x$y
            [html::foreach z {e f} {$z}]
        }]}
} {
        ac
            ef
        ad
            ef

        bc
            ef
        bd
            ef
        }

test html-28.1 {html::for--1 iteration} {







|













|








578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606

test html-27.8 {html::foreach--subst body w/ nested foreach} {
    html::foreach x {a b} {
        [html::foreach y {c d} {$x$y}]
    }
} {
        acad
    
        bcbd
    }

test html-27.9 {html::foreach--subst body w/ multiple nested foreach's} {
    html::foreach x {a b} {
        [html::foreach y {c d} {$x$y
            [html::foreach z {e f} {$z}]
        }]}
} {
        ac
            ef
        ad
            ef
        
        bc
            ef
        bd
            ef
        }

test html-28.1 {html::for--1 iteration} {

Changes to modules/lazyset/lazyset.man. 


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

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin lazyset n 1]
[copyright {2018 Roy Keene}]
[moddesc   {Lazy evaluation for variables and arrays}]
[category  Utility]
[titledesc {Lazy evaluation}]
[require Tcl 8.5]
[require lazyset [opt 1]]
[description]
[para]

The [package lazyset] package provides a mechanism for deferring execution
of code until a specific variable or any index of an array is referenced.

[section {COMMANDS}]

>

|





|








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

[vset VERSION 1]
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin lazyset n [vset VERSION]]
[copyright {2018 Roy Keene}]
[moddesc   {Lazy evaluation for variables and arrays}]
[category  Utility]
[titledesc {Lazy evaluation}]
[require Tcl 8.5]
[require lazyset [opt [vset VERSION]]]
[description]
[para]

The [package lazyset] package provides a mechanism for deferring execution
of code until a specific variable or any index of an array is referenced.

[section {COMMANDS}]

Changes to modules/lazyset/pkgIndex.tcl. 


1

package ifneeded lazyset 1 [list source [file join $dir lazyset.tcl]]

>


1
2

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded lazyset 1 [list source [file join $dir lazyset.tcl]]

Changes to modules/markdown/markdown.tcl. 

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

    # @param markdown  currently takes as a single argument the text in markdown
    #
    # The output of this function is only a fragment, not a complete HTML
    # document. The format of the output is generic XHTML.
    #
    proc convert {markdown} {
        set markdown [regsub {\r\n?} $markdown {\n}]
        set markdown [::textutil::untabify2 $markdown 4]
        set markdown [string trimright $markdown]

        # COLLECT REFERENCES
        array unset ::Markdown::_references
        array set ::Markdown::_references [collect_references markdown]

        # PROCESS







|








41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

    # @param markdown  currently takes as a single argument the text in markdown
    #
    # The output of this function is only a fragment, not a complete HTML
    # document. The format of the output is generic XHTML.
    #
    proc convert {markdown} {
        set markdown [regsub {\r\n?} $markdown {\n}]
        set markdown [::textutil::tabify::untabify2 $markdown 4]
        set markdown [string trimright $markdown]

        # COLLECT REFERENCES
        array unset ::Markdown::_references
        array set ::Markdown::_references [collect_references markdown]

        # PROCESS

Changes to modules/markdown/markdown.test. 

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

}

# convert in
#
# in - markdown input, possibly indented.
#
# Outdents the input and converts it to HTML.  Indents it for inclusion
# in a result.
proc convert {in} {
    set lines [split [string trim [Markdown::convert [outdent $in]]] \n]

    set out [join $lines "\n    "]
    return "\n    $out\n"
}

#=========================================================================
# Tcl-markdown tests

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







|



|








78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

}

# convert in
#
# in - markdown input, possibly indented.
#
# Outdents the input and converts it to HTML.  Indents it for inclusion
# in a result. Empty lines are kept empty.
proc convert {in} {
    set lines [split [string trim [Markdown::convert [outdent $in]]] \n]

    set out [string map [list "\n    \n" "\n\n"] [join $lines "\n    "]]
    return "\n    $out\n"
}

#=========================================================================
# Tcl-markdown tests

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

Changes to modules/math/pca.test. 

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

# -*- tcl -*-

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

testsNeedTcl     8.5
testsNeedTcltest 1.0

support {
    useLocal math.tcl math
    useLocal linalg.tcl math::linearalgebra
    useLocal statistics.tcl math::statistics
}
testing {
    useLocal pca.tcl math::PCA
}

#package require math::statistics






|



|
|








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

# -*- tcl -*-

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

testsNeedTcl     8.6
testsNeedTcltest 1.0

support {
    useLocal math.tcl       math
    useLocal linalg.tcl     math::linearalgebra
    useLocal statistics.tcl math::statistics
}
testing {
    useLocal pca.tcl math::PCA
}

#package require math::statistics

Changes to modules/math/pkgIndex.tcl. 

26
27
28
29
30
31
32

33
34
35

package ifneeded math::linearalgebra     1.1.6 [list source [file join $dir linalg.tcl]]
package ifneeded math::calculus::symdiff 1.0.1 [list source [file join $dir symdiff.tcl]]
package ifneeded math::bigfloat          2.0.2 [list source [file join $dir bigfloat2.tcl]]
package ifneeded math::numtheory         1.1.1 [list source [file join $dir numtheory.tcl]]
package ifneeded math::decimal           1.0.3 [list source [file join $dir decimal.tcl]]
package ifneeded math::geometry          1.3.0 [list source [file join $dir geometry.tcl]]
package ifneeded math::trig              1.0   [list source [file join $dir trig.tcl]]

if {![package vsatisfies [package require Tcl] 8.6]} {return}
package ifneeded math::exact             1.0   [list source [file join $dir exact.tcl]]
package ifneeded math::PCA               1.0   [list source [file join $dir pca.tcl]]







>




26
27
28
29
30
31
32
33
34
35
36

package ifneeded math::linearalgebra     1.1.6 [list source [file join $dir linalg.tcl]]
package ifneeded math::calculus::symdiff 1.0.1 [list source [file join $dir symdiff.tcl]]
package ifneeded math::bigfloat          2.0.2 [list source [file join $dir bigfloat2.tcl]]
package ifneeded math::numtheory         1.1.1 [list source [file join $dir numtheory.tcl]]
package ifneeded math::decimal           1.0.3 [list source [file join $dir decimal.tcl]]
package ifneeded math::geometry          1.3.0 [list source [file join $dir geometry.tcl]]
package ifneeded math::trig              1.0   [list source [file join $dir trig.tcl]]

if {![package vsatisfies [package require Tcl] 8.6]} {return}
package ifneeded math::exact             1.0   [list source [file join $dir exact.tcl]]
package ifneeded math::PCA               1.0   [list source [file join $dir pca.tcl]]

Changes to modules/string/token_shell.test. 

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

support {
    use      fileutil/fileutil.tcl  fileutil
    useLocal token.tcl              string::token
}
testing {
    useLocal token_shell.tcl string::token::shell
}







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

test string-token-shell-1.0 "string token shell, wrong#args, not enough" -body {
    string token shell

} -returnCodes error -result {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}


test string-token-shell-1.1 "string token shell, wrong#args, too many" -body {
    string token shell T X

} -returnCodes error -result {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}


test string-token-shell-1.2 "string token shell, bad option" -body {
    string token shell -foo T
} -returnCodes error -result {Bad option -foo, expected one of -indices, or -partial}

test string-token-shell-1.3 "string token shell, wrong#args, too many" -body {
    string token shell -- T X

} -returnCodes error -result {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"}


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

foreach {n label line tokens} {
    0  empty               {}          {}
    1  leading-whitespace  {  }        {}
    2  plain-words         {a}         {a}







>
>
>
>
>
>





>
|
>



>
|
>







>
|
>








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

support {
    use      fileutil/fileutil.tcl  fileutil
    useLocal token.tcl              string::token
}
testing {
    useLocal token_shell.tcl string::token::shell
}

if {[package vsatisfies [package provide Tcl] 8.6]} {
    proc E {a b} { return $b }
} else {
    proc E {a b} { return $a }
}

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

test string-token-shell-1.0 "string token shell, wrong#args, not enough" -body {
    string token shell
} -returnCodes error -result [E \
  {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"} \
  {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}]

test string-token-shell-1.1 "string token shell, wrong#args, too many" -body {
    string token shell T X
} -returnCodes error -result [E \
  {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"} \
  {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}]

test string-token-shell-1.2 "string token shell, bad option" -body {
    string token shell -foo T
} -returnCodes error -result {Bad option -foo, expected one of -indices, or -partial}

test string-token-shell-1.3 "string token shell, wrong#args, too many" -body {
    string token shell -- T X
} -returnCodes error -result [E \
  {wrong # args: should be "::string::token::shell ?-indices? ?-partial? ?--? text"} \
  {wrong # args: should be "shell ?-indices? ?-partial? ?--? text"}]

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

foreach {n label line tokens} {
    0  empty               {}          {}
    1  leading-whitespace  {  }        {}
    2  plain-words         {a}         {a}

This page was generated in about 0.015s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14