Tcl Source Code

Check-in [aca4170f1d]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

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

Overview
Comment:merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:aca4170f1d67b2e8d14b974092bbeadc970beaaf41e4d28dcf3801ff654c6315
User & Date: dgp 2018-06-13 16:58:38
Context
2018-06-15
10:24
Align common install locations in SC_PATH_TCLCONFIG and SC_PATH_TKCONFIG. Add FreeBSD (closes [d6d60... check-in: e75ddc983a user: stu tags: trunk
2018-06-14
18:31
Merge trunk. Some more size_t additions in parameters/fields check-in: ae9773610f user: jan.nijtmans tags: memory-API
2018-06-13
16:58
merge 8.7 check-in: aca4170f1d user: dgp tags: trunk
16:15
Don't call getsockname(2) in Tcl_MakeFileChannel(3) unless absolutely necessary. Closes RFE [0ac9d06... check-in: a23a536a48 user: stu tags: trunk
16:12
merge 8.6 check-in: 596aa0c944 user: dgp tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/async.test.

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
...
181
182
183
184
185
186
187


188
189
190
191



192
193
194
195
196
197
198
...
201
202
203
204
205
206
207



208
209
210
211
212
213
214
215
216
217
218
219
220
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	# allow plenty of time to pass in case valgrind is running
	set start [clock seconds]
	while {
		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
	} { 


		nothing
	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {



    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
................................................................................
	set aresult {Async event not delivered}
	testasync marklater $handle
	# allow plenty of time to pass in case valgrind is running
	set start [clock seconds]
	while {
		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
	} {


	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {



    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
................................................................................
	set aresult {Async event not delivered}
	testasync marklater $handle
	set i 0
    } "[string repeat {;incr i;} 1500000]after 10;" {
	return $aresult
    }]] $hm
} -result {test pattern} -cleanup {



    testasync delete $hm
}

# cleanup
if {[testConstraint testasync]} {
    testasync delete
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|
|
|
|
|
|
|
|
>
>
|
|



>
>
>







 







>
>




>
>
>







 







>
>
>













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
...
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
} -body {
    apply {{handle} {
    global aresult
    set aresult {Async event not delivered}
    testasync marklater $handle
    # allow plenty of time to pass in case valgrind is running
    set start [clock seconds]
    while {
	[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
    } {
	# be less busy
	after 100
	nothing
    }
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
................................................................................
	set aresult {Async event not delivered}
	testasync marklater $handle
	# allow plenty of time to pass in case valgrind is running
	set start [clock seconds]
	while {
		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
	} {
		# be less busy
	    after 100
	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
................................................................................
	set aresult {Async event not delivered}
	testasync marklater $handle
	set i 0
    } "[string repeat {;incr i;} 1500000]after 10;" {
	return $aresult
    }]] $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}

# cleanup
if {[testConstraint testasync]} {
    testasync delete
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/main.test.

1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
	file delete result
    } -result "1\nExit MainLoop\n"

    test Tcl_Main-8.13 {
	Bug 1775878
    } -constraints {
	exec Tcltest
    } -setup {
	catch {set f [open "|[list [interpreter]]" w+]}
    } -body {
	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result







<
<







1206
1207
1208
1209
1210
1211
1212


1213
1214
1215
1216
1217
1218
1219
	file delete result
    } -result "1\nExit MainLoop\n"

    test Tcl_Main-8.13 {
	Bug 1775878
    } -constraints {
	exec Tcltest


    } -body {
	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result