Tcl Library Source Code

Check-in [6dba867add]
Login

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

Overview
Comment:Added lazyset module
Timelines: family | ancestors | descendants | both | add-lazyset
Files: files | file ages | folders
SHA3-256:6dba867addc63f47f16504d3265a797d12552d0b5a6f2313e075aeb7d81550f6
User & Date: rkeene 2018-12-31 03:51:49
Context
2018-12-31
03:56
Added lazyset to modules index check-in: 00eb13763b user: rkeene tags: add-lazyset
03:51
Added lazyset module check-in: 6dba867add user: rkeene tags: add-lazyset
2018-12-08
18:18
Pulling a commit to uuid that was missed check-in: 63590365a7 user: hypnotoad tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added modules/lazyset/lazyset.tcl.

































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
#! /usr/bin/env tclsh

package require Tcl 8.5

namespace eval ::lazyset {}

proc ::lazyset::variable {args} {
	lassign [lrange $args end-1 end] varName commandPrefix
	set args [lrange $args 0 end-2]

	set appendArgs true
	foreach {arg val} $args {
		switch -exact -- $arg {
			"-array" {
				set isArray [expr {!!$val}]
			}
			"-appendArgs" {
				set appendArgs [expr {!!$val}]
			}
			default {
				error "Valid options -array, -appendArgs: Invalid option \"$arg\""
			}
		}
	}

	set trace [uplevel 1 [list trace info variable $varName]]
	if {$trace ne ""} {
		uplevel 1 [list [list trace remove variable $varName $trace]]
	}

	if {![info exists isArray]} {
		set isArray false
		if {[uplevel 1 [list ::array exists $varName]]} {
			set isArray true
		}
	}

	set finalCode ""
	if {$isArray} {
		append finalCode {
			set varname "$name1\($name2\)"
			if {[uplevel 1 [list info exists $varname]]} {
				return
			}
		}
	} else {
		append finalCode {
			set varname $name1
		}
	}

	if {$appendArgs} {
		append finalCode {
			set args [lrange $args 1 end]
			append code " " [list $name1 $name2 {*}$args]
		}
	}

	append finalCode {
		set result [uplevel 1 $code]

		uplevel 1 [list unset -nocomplain $varname]
		uplevel 1 [list set $varname $result]
	}

	set code [list apply [list {code name1 name2 args} $finalCode] $commandPrefix]

	if {$isArray} {
		uplevel 1 [list unset -nocomplain $varName]
		uplevel 1 [list ::array set $varName [list]]
	} else {
		uplevel 1 [list set $varName ""]
	}

	uplevel 1 [list trace add variable $varName read $code]

	return
}

package provide lazyset 1

Added modules/lazyset/lazyset.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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
# lazyset.test - Copyright (c) 2019 Roy Keene
#
# -------------------------------------------------------------------------

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

testsNeedTcl     8.5
testsNeedTcltest 2

testing {
	useLocal lazyset.tcl lazyset
}

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

test lazyset-basic-1.0 {} -body {
	::lazyset::variable -appendArgs false test {
		return -level 0 ok
	}
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-withargs-1.0 {} -body {
	::lazyset::variable test [list apply {{name1 name2} {
		return ok
	}}]
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-withargs-2.0 {} -body {
	::lazyset::variable test [list apply {{result name1 name2} {
		return $result
	}} ok]
	set test
} -cleanup {
	unset test
} -result {ok}

test lazyset-inscope-1.0 {} -body {
	::lazyset::variable -appendArgs false test {
		set x 0
		return -level 0 ok
	}
	set test
	set x
} -cleanup {
	unset test
	unset x
} -result {0}

test lazyset-onlyonce-1.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false test {
		incr x
		return -level 0 ok
	}
	set test
	set test
	set x
} -cleanup {
	unset test
	unset x
} -result {1}

test lazyset-onlyonce-2.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false -array true test {
		incr x
		return -level 0 ok
	}
	set test(a)
	set test(a)
	set x
} -cleanup {
	unset test
	unset x
} -result {1}

test lazyset-onlyonce-3.0 {} -body {
	set x 0
	::lazyset::variable -appendArgs false -array true test {
		incr x
		return -level 0 ok
	}
	set test(a)
	set test(a)
	set test(b)
	set test(b)
	set x
} -cleanup {
	unset test
	unset x
} -result {2}

test lazyset-array-1.0 {} -body {
	::lazyset::variable -appendArgs false -array true test {
		return -level 0 ok
	}
	set result $test(a)
	append result $test(b)
} -cleanup {
	unset test
	unset result
} -result {okok}

test lazyset-array-1.0 {} -body {
	::lazyset::variable -array true test [list apply {{_ index} {
		return $index
	}}]
	set result $test(a)
	append result $test(b)
} -cleanup {
	unset test
	unset result
} -result {ab}


# -------------------------------------------------------------------------
testsuiteCleanup

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

Added modules/lazyset/pkgIndex.tcl.



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