Jim Tcl
Check-in [027a885518]
Not logged in

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

Overview
Comment:Implement defer, $jim::defer

Allows commands to run when a proc or interpreter exits.

If the $jim::defer variables exists at proc or interp exit, it is treated as a list of scripts to evaluate (in reverse order).

The [defer] command is a helper to add scripts to $jim::defer

See tests/defer.test

Signed-off-by: Steve Bennett <steveb@workware.net.au>

Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:027a88551837477bf7d58abe63fb742e38230ccc
User & Date: steveb@workware.net.au 2017-09-15 09:17:48
Context
2017-09-16
05:37
defer: fast lookup existence of $jim::defer

This speeds up call frame destruction in the common case that $jim::defer does not exist.

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: e4c02883cb user: steveb@workware.net.au tags: trunk

2017-09-15
09:17
Implement defer, $jim::defer

Allows commands to run when a proc or interpreter exits.

If the $jim::defer variables exists at proc or interp exit, it is treated as a list of scripts to evaluate (in reverse order).

The [defer] command is a helper to add scripts to $jim::defer

See tests/defer.test

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: 027a885518 user: steveb@workware.net.au tags: trunk

02:12
docs: Update documentation for recent changes

Add aio sockopt Add history completion Remove aio tcp_nodelay

Signed-off-by: Steve Bennett <steveb@workware.net.au> check-in: 954bfa31a8 user: steveb@workware.net.au tags: trunk

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to TODO.

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
CORE LANGUAGE FEATURES



CORE COMMANDS

- [onleave] command, executing something as soon as the current procedure
  returns. With no arguments it returns the script set, with one appends
  the onleave script. There should be a way to reset.

  Currently we have [local] which can be used to delete procs on proc exit.
  Also try/on/finally. Is [onleave] really needed?

OTHER COMMANDS NOT IN TCL BUT THAT SHOULD BE IN JIM

- Set commands: [lunion], [lintersect], and [ldifference]

EXTENSIONS

- Cryptography: hash functions, block ciphers, strim ciphers, PRNGs.
- Tuplespace extension (http://wiki.tcl.tk/3947) (using sqlite as backend)
- Zlib
- Gdlib
- CGI (interface compatible with ncgi, but possibly written in C for speed)

REFERENCES SYSTEM

- Unify ref/getref/setref/collect/finalize under an unique [ref] command.

>
>



|
<
<
<
<
<









<






1
2
3
4
5
6
7





8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
CORE LANGUAGE FEATURES

- none

CORE COMMANDS

- none






OTHER COMMANDS NOT IN TCL BUT THAT SHOULD BE IN JIM

- Set commands: [lunion], [lintersect], and [ldifference]

EXTENSIONS

- Cryptography: hash functions, block ciphers, strim ciphers, PRNGs.
- Tuplespace extension (http://wiki.tcl.tk/3947) (using sqlite as backend)

- Gdlib
- CGI (interface compatible with ncgi, but possibly written in C for speed)

REFERENCES SYSTEM

- Unify ref/getref/setref/collect/finalize under an unique [ref] command.

Changes to jim.c.

5021
5022
5023
5024
5025
5026
5027

















































5028
5029
5030
5031
5032
5033
5034
....
5541
5542
5543
5544
5545
5546
5547


5548
5549
5550
5551
5552
5553
5554
.....
10806
10807
10808
10809
10810
10811
10812
10813

10814
10815
10816
10817
10818
10819
10820
        }
        Jim_FreeStack(localCommands);
        Jim_Free(localCommands);
    }
    return JIM_OK;
}



















































#define JIM_FCF_FULL 0          /* Always free the vars hash table */
#define JIM_FCF_REUSE 1         /* Reuse the vars hash table if possible */
static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
 {
    JimDeleteLocalProcs(interp, cf->localCommands);

................................................................................
{
    Jim_CallFrame *cf, *cfx;

    Jim_Obj *objPtr, *nextObjPtr;

    /* Free the active call frames list - must be done before i->commands is destroyed */
    for (cf = i->framePtr; cf; cf = cfx) {


        cfx = cf->parent;
        JimFreeCallFrame(i, cf, JIM_FCF_FULL);
    }

    Jim_DecrRefCount(i, i->emptyObj);
    Jim_DecrRefCount(i, i->trueObj);
    Jim_DecrRefCount(i, i->falseObj);
................................................................................
    }

    /* Eval the body */
    retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);

badargset:

    /* Free the callframe */

    interp->framePtr = interp->framePtr->parent;
    JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);

    /* Now chain any tailcalls in the parent frame */
    if (interp->framePtr->tailcallObj) {
        do {
            Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;







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







 







>
>







 







|
>







5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
5078
5079
5080
5081
5082
5083
....
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
.....
10857
10858
10859
10860
10861
10862
10863
10864
10865
10866
10867
10868
10869
10870
10871
10872
        }
        Jim_FreeStack(localCommands);
        Jim_Free(localCommands);
    }
    return JIM_OK;
}

/**
 * Run any $jim::defer scripts for the current call frame.
 *
 * retcode is the return code from the current proc.
 *
 * Returns the new return code.
 */
static int JimInvokeDefer(Jim_Interp *interp, int retcode)
{
    Jim_Obj *objPtr = Jim_GetVariableStr(interp, "jim::defer", JIM_NONE);
    int ret = JIM_OK;

    if (objPtr) {
        int i;
        int listLen = Jim_ListLength(interp, objPtr);
        Jim_Obj *resultObjPtr;

        Jim_IncrRefCount(objPtr);

        /* Need to save away the current interp result and
         * restore it if appropriate
         */
        resultObjPtr = Jim_GetResult(interp);
        Jim_IncrRefCount(resultObjPtr);
        Jim_SetEmptyResult(interp);

        /* Invoke in reverse order */
        for (i = listLen; i > 0; i--) {
            /* If a defer script returns an error, don't evaluate remaining scripts */
            Jim_Obj *scriptObjPtr = Jim_ListGetIndex(interp, objPtr, i - 1);
            ret = Jim_EvalObj(interp, scriptObjPtr);
            if (ret != JIM_OK) {
                break;
            }
        }

        if (ret == JIM_OK || retcode == JIM_ERR) {
            /* defer script had no error, or proc had an error so restore proc result */
            Jim_SetResult(interp, resultObjPtr);
        }
        else {
            retcode = ret;
        }

        Jim_DecrRefCount(interp, resultObjPtr);
        Jim_DecrRefCount(interp, objPtr);
    }
    return retcode;
}

#define JIM_FCF_FULL 0          /* Always free the vars hash table */
#define JIM_FCF_REUSE 1         /* Reuse the vars hash table if possible */
static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action)
 {
    JimDeleteLocalProcs(interp, cf->localCommands);

................................................................................
{
    Jim_CallFrame *cf, *cfx;

    Jim_Obj *objPtr, *nextObjPtr;

    /* Free the active call frames list - must be done before i->commands is destroyed */
    for (cf = i->framePtr; cf; cf = cfx) {
        /* Note that we ignore any errors */
        JimInvokeDefer(i, JIM_OK);
        cfx = cf->parent;
        JimFreeCallFrame(i, cf, JIM_FCF_FULL);
    }

    Jim_DecrRefCount(i, i->emptyObj);
    Jim_DecrRefCount(i, i->trueObj);
    Jim_DecrRefCount(i, i->falseObj);
................................................................................
    }

    /* Eval the body */
    retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr);

badargset:

    /* Invoke $jim::defer then destroy the callframe */
    retcode = JimInvokeDefer(interp, retcode);
    interp->framePtr = interp->framePtr->parent;
    JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE);

    /* Now chain any tailcalls in the parent frame */
    if (interp->framePtr->tailcallObj) {
        do {
            Jim_Obj *tailcallObj = interp->framePtr->tailcallObj;

Changes to jim_tcl.txt.

56
57
58
59
60
61
62


63
64
65
66
67
68
69
....
3239
3240
3241
3242
3243
3244
3245















3246
3247
3248
3249
3250
3251
3252
....
5159
5160
5161
5162
5163
5164
5165








5166
5167
5168
5169
5170
5171
5172
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add serial/tty support with `aio tty`
2. Add support for 'jimsh -'
3. Add hidden '-commands' option to many commands
4. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete`
5. Add `aio sockopt`
6. Add scriptable autocompletion support with `history completion`



Changes between 0.76 and 0.77
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add support for `aio sync`
2. Add SSL and TLS support in aio
3. Added `zlib`
4. Added support for boolean constants in `expr`
................................................................................
Note that duplicates are determined relative to the comparison used in the sort. Thus if +-index 0+ is used,
+{1 a}+ and +{1 b}+ would be considered duplicates and only the second element, +{1 b}+, would be retained.

If +-index 'listindex'+ is specified, each element of the list is treated as a list and
the given index is extracted from the list for comparison. The list index may
be any valid list index, such as +1+, +end+ or +end-2+.
















open
~~~~
+*open* 'fileName ?access?'+

+*open* '|command-pipeline ?access?'+

Opens a file and returns an identifier
................................................................................

+*argc*+::
    If jimsh is invoked to run a script, this variable contains the number
    of arguments supplied to the script.

+*jim::argv0*+::
    The value of argv[0] when jimsh was invoked.









CHANGES IN PREVIOUS RELEASES
----------------------------

=== In v0.70 ===

1. +platform_tcl()+ settings are now automatically determined







>
>







 







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







 







>
>
>
>
>
>
>
>







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
....
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
....
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add serial/tty support with `aio tty`
2. Add support for 'jimsh -'
3. Add hidden '-commands' option to many commands
4. Add scriptable autocompletion support in interactive mode with `tcl::autocomplete`
5. Add `aio sockopt`
6. Add scriptable autocompletion support with `history completion`
7. Add support for `tree delete`
8. Add support for `defer` and '$jim::defer'

Changes between 0.76 and 0.77
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1. Add support for `aio sync`
2. Add SSL and TLS support in aio
3. Added `zlib`
4. Added support for boolean constants in `expr`
................................................................................
Note that duplicates are determined relative to the comparison used in the sort. Thus if +-index 0+ is used,
+{1 a}+ and +{1 b}+ would be considered duplicates and only the second element, +{1 b}+, would be retained.

If +-index 'listindex'+ is specified, each element of the list is treated as a list and
the given index is extracted from the list for comparison. The list index may
be any valid list index, such as +1+, +end+ or +end-2+.

defer
~~~~~
+*defer* 'script'+

This command is a simple helper command to add a script to the '+$jim::defer+' variable
that will run when the current proc or interpreter exits. For example:

    jim> proc a {} { defer {puts "Leaving a"}; puts "Exit" }
    jim> a
    Exit
    Leaving a

If the '+$jim::defer+' variable exists, it is treated as a list of scripts to run
when the proc or interpreter exits.

open
~~~~
+*open* 'fileName ?access?'+

+*open* '|command-pipeline ?access?'+

Opens a file and returns an identifier
................................................................................

+*argc*+::
    If jimsh is invoked to run a script, this variable contains the number
    of arguments supplied to the script.

+*jim::argv0*+::
    The value of argv[0] when jimsh was invoked.

The following variables have special meaning to Jim Tcl:

+*jim::defer*+::
    If this variable is set, it is considered to be a list of scripts to evaluate
	when the current proc exits (local variables), or the interpreter exits (global variable).
	See `defer`.


CHANGES IN PREVIOUS RELEASES
----------------------------

=== In v0.70 ===

1. +platform_tcl()+ settings are now automatically determined

Changes to stdlib.tcl.

61
62
63
64
65
66
67







68
69
70
71
72
73
74
		}
		if {$line ne ""} {
			lappend lines $line
		}
	}
	join $lines \n
}








# Sort of replacement for $::errorInfo
# Usage: errorInfo error ?stacktrace?
proc errorInfo {msg {stacktrace ""}} {
	if {$stacktrace eq ""} {
		# By default add the stack backtrace and the live stacktrace
		set stacktrace [info stacktrace]







>
>
>
>
>
>
>







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
		}
		if {$line ne ""} {
			lappend lines $line
		}
	}
	join $lines \n
}

# Add the given script to $jim::defer, to be evaluated when the current
# procedure exits
proc defer {script} {
	upvar jim::defer v
	lappend v $script
}

# Sort of replacement for $::errorInfo
# Usage: errorInfo error ?stacktrace?
proc errorInfo {msg {stacktrace ""}} {
	if {$stacktrace eq ""} {
		# By default add the stack backtrace and the live stacktrace
		set stacktrace [info stacktrace]

Added tests/defer.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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
# vim:se syntax=tcl:

source [file dirname [info script]]/testing.tcl

needs cmd defer
needs cmd interp

test defer-1.1 {defer in proc} {
	set x -
	proc a {} {
		set x +
		# This does nothing since it increments a local variable
		defer {append x L}
		# This increments the global variable
		defer {append ::x G}
		# Will return "-", not "-L" since return happens before defer triggers
		return $x
	}
	list [a] $x
} {+ -G}

test defer-1.2 {set $defer directly} {
	set x -
	proc a {} {
		lappend jim::defer {append ::x a}
		lappend jim::defer {append ::x b}
		return $jim::defer
	}
	list [a] $x
} {{{append ::x a} {append ::x b}} -ba}


test defer-1.3 {unset $defer} {
	set x -
	proc a {} {
		defer {append ::x a}
		# unset, to remove all defer actions
		unset jim::defer
	}
	a
	set x
} {-}

test defer-1.4 {error in defer - error} {
	set x -
	proc a {} {
		# First defer script will not happen because of error in next defer script
		defer {append ::x a}
		# Error ignored because of error from proc
		defer {blah}
		# Last defer script will happen
		defer {append ::x b}
		# This error will take precedence over the error from defer
		error "from a"
	}
	set rc [catch {a} msg]
	list [info ret $rc] $msg $x
} {error {from a} -b}

test defer-1.5 {error in defer - return} {
	set x -
	proc a {} {
		# First defer script will not happen
		defer {append ::x a}
		defer {blah}
		# Last defer script will happen
		defer {append ::x b}
		return 3
	}
	set rc [catch {a} msg]
	list [info ret $rc] $msg $x
} {error {invalid command name "blah"} -b}

test defer-1.6 {error in defer - ok} {
	set x -
	proc a {} {
		# First defer script will not happen
		defer {append ::x a}
		# Error ignored because of error from proc
		defer {blah}
		# Last defer script will happen
		defer {append ::x b}
	}
	set rc [catch {a} msg]
	list [info ret $rc] $msg $x
} {error {invalid command name "blah"} -b}

test defer-1.7 {error in defer - break} {
	set x -
	proc a {} {
		# First defer script will not happen
		defer {append ::x a}
		# This non-zero return code will take precedence over the proc return
		defer {return -code 30 ret30}
		# Last defer script will happen
		defer {append ::x b}

		return -code 20 ret20
	}
	set rc [catch {a} msg]
	list [info ret $rc] $msg $x
} {30 ret30 -b}

test defer-1.8 {error in defer - tailcall} {
	set x -
	proc a {} {
		# This will prevent tailcall from happening
		defer {blah}

		# Tailcall will not happen because of error in defer
		tailcall append ::x a
	}
	set rc [catch {a} msg]
	list [info ret $rc] $msg $x
} {error {invalid command name "blah"} -}

test defer-1.9 {Add to defer in defer body} {
	set x -
	proc a {} {
		defer {
			# Add to defer in defer
			defer {
				# This will do nothing
				error here
			}
		}
		defer {append ::x a}
	}
	a
	set x
} {-a}

test defer-1.10 {Unset defer in defer body} {
	set x -
	proc a {} {
		defer {
			# This will do nothing
			unset -nocomplain jim::defer
		}
		defer {append ::x a}
	}
	a
	set x
} {-a}

test defer-1.11 {defer through tailcall} {
	set x {}
	proc a {} {
		defer {append ::x a}
		b
	}
	proc b {} {
		defer {append ::x b}
		# c will be invoked as through called from a but this
		# won't make any difference for defer
		tailcall c
	}
	proc c {} {
		defer {append ::x c}
	}
	a
	set x
} {bca}

test defer-1.12 {defer in recursive call} {
	set x {}
	proc a {n} {
		# defer happens just before the return, so after the recursive call to a
		defer {lappend ::x $n}
		if {$n > 0} {
			a $($n - 1)
		}
	}
	a 3
	set x
} {0 1 2 3}

test defer-1.13 {defer in recursive tailcall} {
	set x {}
	proc a {n} {
		# defer happens just before the return, so before the tailcall to a
		defer {lappend ::x $n}
		if {$n > 0} {
			tailcall a $($n - 1)
		}
	}
	a 3
	set x
} {3 2 1 0}

test defer-1.14 {defer capture variables} {
	set x {}
	proc a {} {
		set y 1
		# A normal defer will evaluate at the end of the proc, so $y may change
		defer {lappend ::x $y}
		incr y

		# What if we want to capture the value of y here? list will work
		defer [list lappend ::x $y]
		incr y

		# But with multiple statements, list doesn't work, so use a lambda 
		# to capture the value instead
		defer [lambda {} {y} {
			# multi-line script
			lappend ::x $y
		}]
		incr y

		return $y
	}
	list [a] $x
} {4 {3 2 4}}

test defer-2.1 {defer from interp} -body {
	set i [interp]
	# defer needs to have some effect to detect on exit,
	# so write to a file
	file delete defer.tmp
	$i eval {
		defer {
			[open defer.tmp w] puts "leaving child"
		}
	}
	set a [file exists defer.tmp]
	$i delete
	# Now the file should exist
	set f [open defer.tmp]
	$f gets b
	$f close
	list $a $b
} -result {0 {leaving child}} -cleanup {
	file delete defer.tmp
}

testreport