Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/main.test@bde4ae8d615e (annotated)

sl@0	1	# This file contains a collection of tests for generic/tclMain.c.
sl@0	2	#
sl@0	3	# RCS: @(#) $Id$
sl@0	4
sl@0	5	if {[catch {package require tcltest 2.0.2}]} {
sl@0	6	puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
sl@0	7	return
sl@0	8	}
sl@0	9
sl@0	10	namespace eval ::tcl::test::main {
sl@0	11
sl@0	12	namespace import ::tcltest::test
sl@0	13	namespace import ::tcltest::testConstraint
sl@0	14	namespace import ::tcltest::interpreter
sl@0	15	namespace import ::tcltest::cleanupTests
sl@0	16	namespace import ::tcltest::makeFile
sl@0	17	namespace import ::tcltest::removeFile
sl@0	18	namespace import ::tcltest::temporaryDirectory
sl@0	19	namespace import ::tcltest::workingDirectory
sl@0	20
sl@0	21	# Is [exec] defined?
sl@0	22	testConstraint exec [llength [info commands exec]]
sl@0	23
sl@0	24	# Is the Tcltest package loaded?
sl@0	25	# - that is, the special C-coded testing commands in tclTest.c
sl@0	26	# - tests use testing commands introduced in Tcltest 8.4
sl@0	27	testConstraint Tcltest [expr {
sl@0	28	[llength [package provide Tcltest]]
sl@0	29	&& [package vsatisfies [package provide Tcltest] 8.4]}]
sl@0	30
sl@0	31	# Procedure to simulate interactive typing of commands, line by line
sl@0	32	proc type {chan script} {
sl@0	33	foreach line [split $script \n] {
sl@0	34	if {[catch {
sl@0	35	puts $chan $line
sl@0	36	flush $chan
sl@0	37	}]} {
sl@0	38	return
sl@0	39	}
sl@0	40	# Grrr... Behavior depends on this value.
sl@0	41	after 1000
sl@0	42	}
sl@0	43	}
sl@0	44
sl@0	45	cd [temporaryDirectory]
sl@0	46	# Tests Tcl_Main-1.*: variable initializations
sl@0	47
sl@0	48	test Tcl_Main-1.1 {
sl@0	49	Tcl_Main: startup script - normal
sl@0	50	} -constraints {
sl@0	51	stdio
sl@0	52	} -setup {
sl@0	53	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
sl@0	54	catch {set f [open "\|[list [interpreter] script]" r]}
sl@0	55	} -body {
sl@0	56	read $f
sl@0	57	} -cleanup {
sl@0	58	close $f
sl@0	59	removeFile script
sl@0	60	} -result [list script {} 0]\n
sl@0	61
sl@0	62	test Tcl_Main-1.2 {
sl@0	63	Tcl_Main: startup script - can't begin with '-'
sl@0	64	} -constraints {
sl@0	65	stdio
sl@0	66	} -setup {
sl@0	67	makeFile {puts [list $argv0 $argv $tcl_interactive]} -script
sl@0	68	catch {set f [open "\|[list [interpreter] -script]" w+]}
sl@0	69	} -body {
sl@0	70	puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}
sl@0	71	flush $f
sl@0	72	read $f
sl@0	73	} -cleanup {
sl@0	74	close $f
sl@0	75	removeFile -script
sl@0	76	} -result [list [interpreter] -script 0]\n
sl@0	77
sl@0	78	test Tcl_Main-1.3 {
sl@0	79	Tcl_Main: encoding of arguments: done by system encoding
sl@0	80	Note the shortcoming explained in Tcl Feature Request 491789
sl@0	81	} -constraints {
sl@0	82	stdio
sl@0	83	} -setup {
sl@0	84	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
sl@0	85	catch {set f [open "\|[list [interpreter] script \u00c0]" r]}
sl@0	86	} -body {
sl@0	87	read $f
sl@0	88	} -cleanup {
sl@0	89	close $f
sl@0	90	removeFile script
sl@0	91	} -result [list script [list [encoding convertfrom [encoding system] \
sl@0	92	[encoding convertto [encoding system] \u00c0]]] 0]\n
sl@0	93
sl@0	94	test Tcl_Main-1.4 {
sl@0	95	Tcl_Main: encoding of arguments: done by system encoding
sl@0	96	Note the shortcoming explained in Tcl Feature Request 491789
sl@0	97	} -constraints {
sl@0	98	stdio tempNotWin
sl@0	99	} -setup {
sl@0	100	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
sl@0	101	catch {set f [open "\|[list [interpreter] script \u20ac]" r]}
sl@0	102	} -body {
sl@0	103	read $f
sl@0	104	} -cleanup {
sl@0	105	close $f
sl@0	106	removeFile script
sl@0	107	} -result [list script [list [encoding convertfrom [encoding system] \
sl@0	108	[encoding convertto [encoding system] \u20ac]]] 0]\n
sl@0	109
sl@0	110	test Tcl_Main-1.5 {
sl@0	111	Tcl_Main: encoding of script name: system encoding loss
sl@0	112	Note the shortcoming explained in Tcl Feature Request 491789
sl@0	113	} -constraints {
sl@0	114	stdio
sl@0	115	} -setup {
sl@0	116	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
sl@0	117	catch {set f [open "\|[list [interpreter] \u00c0]" r]}
sl@0	118	} -body {
sl@0	119	read $f
sl@0	120	} -cleanup {
sl@0	121	close $f
sl@0	122	removeFile \u00c0
sl@0	123	} -result [list [list [encoding convertfrom [encoding system] \
sl@0	124	[encoding convertto [encoding system] \u00c0]]] {} 0]\n
sl@0	125
sl@0	126	test Tcl_Main-1.6 {
sl@0	127	Tcl_Main: encoding of script name: system encoding loss
sl@0	128	Note the shortcoming explained in Tcl Feature Request 491789
sl@0	129	} -constraints {
sl@0	130	stdio tempNotWin
sl@0	131	} -setup {
sl@0	132	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
sl@0	133	catch {set f [open "\|[list [interpreter] \u20ac]" r]}
sl@0	134	} -body {
sl@0	135	read $f
sl@0	136	} -cleanup {
sl@0	137	close $f
sl@0	138	removeFile \u20ac
sl@0	139	} -result [list [list [encoding convertfrom [encoding system] \
sl@0	140	[encoding convertto [encoding system] \u20ac]]] {} 0]\n
sl@0	141
sl@0	142	# Tests Tcl_Main-2.*: application-initialization procedure
sl@0	143
sl@0	144	test Tcl_Main-2.1 {
sl@0	145	Tcl_Main: appInitProc returns error
sl@0	146	} -constraints {
sl@0	147	exec Tcltest
sl@0	148	} -setup {
sl@0	149	makeFile {puts "In script"} script
sl@0	150	} -body {
sl@0	151	exec [interpreter] script -appinitprocerror >& result
sl@0	152	set f [open result]
sl@0	153	read $f
sl@0	154	} -cleanup {
sl@0	155	close $f
sl@0	156	file delete result
sl@0	157	removeFile script
sl@0	158	} -result "application-specific initialization failed: \nIn script\n"
sl@0	159
sl@0	160	test Tcl_Main-2.2 {
sl@0	161	Tcl_Main: appInitProc returns error
sl@0	162	} -constraints {
sl@0	163	exec Tcltest
sl@0	164	} -body {
sl@0	165	exec [interpreter] << {puts "In script"} -appinitprocerror >& result
sl@0	166	set f [open result]
sl@0	167	read $f
sl@0	168	} -cleanup {
sl@0	169	close $f
sl@0	170	file delete result
sl@0	171	} -result "application-specific initialization failed: \nIn script\n"
sl@0	172
sl@0	173	test Tcl_Main-2.3 {
sl@0	174	Tcl_Main: appInitProc deletes interp
sl@0	175	} -constraints {
sl@0	176	exec Tcltest
sl@0	177	} -setup {
sl@0	178	makeFile {puts "In script"} script
sl@0	179	} -body {
sl@0	180	exec [interpreter] script -appinitprocdeleteinterp >& result
sl@0	181	set f [open result]
sl@0	182	read $f
sl@0	183	} -cleanup {
sl@0	184	close $f
sl@0	185	file delete result
sl@0	186	removeFile script
sl@0	187	} -result "application-specific initialization failed: \n"
sl@0	188
sl@0	189	test Tcl_Main-2.4 {
sl@0	190	Tcl_Main: appInitProc deletes interp
sl@0	191	} -constraints {
sl@0	192	exec Tcltest
sl@0	193	} -body {
sl@0	194	exec [interpreter] << {puts "In script"} \
sl@0	195	-appinitprocdeleteinterp >& result
sl@0	196	set f [open result]
sl@0	197	read $f
sl@0	198	} -cleanup {
sl@0	199	close $f
sl@0	200	file delete result
sl@0	201	} -result "application-specific initialization failed: \n"
sl@0	202
sl@0	203	test Tcl_Main-2.5 {
sl@0	204	Tcl_Main: appInitProc closes stderr
sl@0	205	} -constraints {
sl@0	206	exec Tcltest
sl@0	207	} -body {
sl@0	208	exec [interpreter] << {puts "In script"} \
sl@0	209	-appinitprocclosestderr >& result
sl@0	210	set f [open result]
sl@0	211	read $f
sl@0	212	} -cleanup {
sl@0	213	close $f
sl@0	214	file delete result
sl@0	215	} -result "In script\n"
sl@0	216
sl@0	217	# Tests Tcl_Main-3.*: startup script evaluation
sl@0	218
sl@0	219	test Tcl_Main-3.1 {
sl@0	220	Tcl_Main: startup script does not exist
sl@0	221	} -constraints {
sl@0	222	exec
sl@0	223	} -setup {
sl@0	224	if {[file exists no-such-file]} {
sl@0	225	error "Can't run test Tcl_Main-3.1\
sl@0	226	where a file named \"no-such-file\" exists"
sl@0	227	}
sl@0	228	} -body {
sl@0	229	set code [catch {exec [interpreter] no-such-file >& result} result]
sl@0	230	set f [open result]
sl@0	231	list $code $result [read $f]
sl@0	232	} -cleanup {
sl@0	233	close $f
sl@0	234	file delete result
sl@0	235	} -match glob -result [list 1 {child process exited abnormally} \
sl@0	236	{couldn't read file "no-such-file":*}]
sl@0	237
sl@0	238	test Tcl_Main-3.2 {
sl@0	239	Tcl_Main: startup script raises error
sl@0	240	} -constraints {
sl@0	241	exec
sl@0	242	} -setup {
sl@0	243	makeFile {error ERROR} script
sl@0	244	} -body {
sl@0	245	set code [catch {exec [interpreter] script >& result} result]
sl@0	246	set f [open result]
sl@0	247	list $code $result [read $f]
sl@0	248	} -cleanup {
sl@0	249	close $f
sl@0	250	file delete result
sl@0	251	removeFile script
sl@0	252	} -match glob -result [list 1 {child process exited abnormally} \
sl@0	253	"ERROR\n while executing*"]
sl@0	254
sl@0	255	test Tcl_Main-3.3 {
sl@0	256	Tcl_Main: startup script closes stderr
sl@0	257	} -constraints {
sl@0	258	exec
sl@0	259	} -setup {
sl@0	260	makeFile {close stderr; error ERROR} script
sl@0	261	} -body {
sl@0	262	set code [catch {exec [interpreter] script >& result} result]
sl@0	263	set f [open result]
sl@0	264	list $code $result [read $f]
sl@0	265	} -cleanup {
sl@0	266	close $f
sl@0	267	file delete result
sl@0	268	removeFile script
sl@0	269	} -result [list 1 {child process exited abnormally} {}]
sl@0	270
sl@0	271	test Tcl_Main-3.4 {
sl@0	272	Tcl_Main: startup script holds incomplete script
sl@0	273	} -constraints {
sl@0	274	exec
sl@0	275	} -setup {
sl@0	276	makeFile "if 1 \{" script
sl@0	277	} -body {
sl@0	278	set code [catch {exec [interpreter] script >& result} result]
sl@0	279	set f [open result]
sl@0	280	join [list $code $result [read $f]] \n
sl@0	281	} -cleanup {
sl@0	282	close $f
sl@0	283	file delete result
sl@0	284	removeFile script
sl@0	285	} -match glob -result [join [list 1 {child process exited abnormally}\
sl@0	286	"missing close-brace\n while executing*"] \n]
sl@0	287
sl@0	288	test Tcl_Main-3.5 {
sl@0	289	Tcl_Main: startup script sets main loop
sl@0	290	} -constraints {
sl@0	291	exec Tcltest
sl@0	292	} -setup {
sl@0	293	makeFile {
sl@0	294	rename exit _exit
sl@0	295	proc exit {code} {
sl@0	296	puts "In exit"
sl@0	297	_exit $code
sl@0	298	}
sl@0	299	after 0 {
sl@0	300	puts event
sl@0	301	testexitmainloop
sl@0	302	}
sl@0	303	testexithandler create 0
sl@0	304	testsetmainloop
sl@0	305	} script
sl@0	306	} -body {
sl@0	307	exec [interpreter] script >& result
sl@0	308	set f [open result]
sl@0	309	read $f
sl@0	310	} -cleanup {
sl@0	311	close $f
sl@0	312	file delete result
sl@0	313	removeFile script
sl@0	314	} -result "event\nExit MainLoop\nIn exit\neven 0\n"
sl@0	315
sl@0	316	test Tcl_Main-3.6 {
sl@0	317	Tcl_Main: startup script sets main loop and closes stdin
sl@0	318	} -constraints {
sl@0	319	exec Tcltest
sl@0	320	} -setup {
sl@0	321	makeFile {
sl@0	322	close stdin
sl@0	323	testsetmainloop
sl@0	324	rename exit _exit
sl@0	325	proc exit {code} {
sl@0	326	puts "In exit"
sl@0	327	_exit $code
sl@0	328	}
sl@0	329	after 0 {
sl@0	330	puts event
sl@0	331	testexitmainloop
sl@0	332	}
sl@0	333	testexithandler create 0
sl@0	334	} script
sl@0	335	} -body {
sl@0	336	exec [interpreter] script >& result
sl@0	337	set f [open result]
sl@0	338	read $f
sl@0	339	} -cleanup {
sl@0	340	close $f
sl@0	341	file delete result
sl@0	342	removeFile script
sl@0	343	} -result "event\nExit MainLoop\nIn exit\neven 0\n"
sl@0	344
sl@0	345	test Tcl_Main-3.7 {
sl@0	346	Tcl_Main: startup script deletes interp
sl@0	347	} -constraints {
sl@0	348	exec Tcltest
sl@0	349	} -setup {
sl@0	350	makeFile {
sl@0	351	rename exit _exit
sl@0	352	proc exit {code} {
sl@0	353	puts "In exit"
sl@0	354	_exit $code
sl@0	355	}
sl@0	356	testexithandler create 0
sl@0	357	testinterpdelete {}
sl@0	358	} script
sl@0	359	} -body {
sl@0	360	exec [interpreter] script >& result
sl@0	361	set f [open result]
sl@0	362	read $f
sl@0	363	} -cleanup {
sl@0	364	close $f
sl@0	365	file delete result
sl@0	366	removeFile script
sl@0	367	} -result "even 0\n"
sl@0	368
sl@0	369	test Tcl_Main-3.8 {
sl@0	370	Tcl_Main: startup script deletes interp and sets mainloop
sl@0	371	} -constraints {
sl@0	372	exec Tcltest
sl@0	373	} -setup {
sl@0	374	makeFile {
sl@0	375	testsetmainloop
sl@0	376	rename exit _exit
sl@0	377	proc exit {code} {
sl@0	378	puts "In exit"
sl@0	379	_exit $code
sl@0	380	}
sl@0	381	testexitmainloop
sl@0	382	testexithandler create 0
sl@0	383	testinterpdelete {}
sl@0	384	} script
sl@0	385	} -body {
sl@0	386	exec [interpreter] script >& result
sl@0	387	set f [open result]
sl@0	388	read $f
sl@0	389	} -cleanup {
sl@0	390	close $f
sl@0	391	file delete result
sl@0	392	removeFile script
sl@0	393	} -result "Exit MainLoop\neven 0\n"
sl@0	394
sl@0	395	test Tcl_Main-3.9 {
sl@0	396	Tcl_Main: startup script can set tcl_interactive without limit
sl@0	397	} -constraints {
sl@0	398	exec
sl@0	399	} -setup {
sl@0	400	makeFile {set tcl_interactive foo} script
sl@0	401	} -body {
sl@0	402	exec [interpreter] script >& result
sl@0	403	set f [open result]
sl@0	404	read $f
sl@0	405	} -cleanup {
sl@0	406	close $f
sl@0	407	file delete result
sl@0	408	removeFile script
sl@0	409	} -result {}
sl@0	410
sl@0	411	# Tests Tcl_Main-4.*: rc file evaluation
sl@0	412
sl@0	413	test Tcl_Main-4.1 {
sl@0	414	Tcl_Main: rcFile evaluation deletes interp
sl@0	415	} -constraints {
sl@0	416	exec Tcltest
sl@0	417	} -setup {
sl@0	418	set rc [makeFile {testinterpdelete {}} rc]
sl@0	419	} -body {
sl@0	420	exec [interpreter] << {puts "In script"} \
sl@0	421	-appinitprocsetrcfile $rc >& result
sl@0	422	set f [open result]
sl@0	423	read $f
sl@0	424	} -cleanup {
sl@0	425	close $f
sl@0	426	file delete result
sl@0	427	removeFile rc
sl@0	428	} -result "application-specific initialization failed: \n"
sl@0	429
sl@0	430	test Tcl_Main-4.2 {
sl@0	431	Tcl_Main: rcFile evaluation closes stdin
sl@0	432	} -constraints {
sl@0	433	exec Tcltest
sl@0	434	} -setup {
sl@0	435	set rc [makeFile {close stdin} rc]
sl@0	436	} -body {
sl@0	437	exec [interpreter] << {puts "In script"} \
sl@0	438	-appinitprocsetrcfile $rc >& result
sl@0	439	set f [open result]
sl@0	440	read $f
sl@0	441	} -cleanup {
sl@0	442	close $f
sl@0	443	file delete result
sl@0	444	removeFile rc
sl@0	445	} -result "application-specific initialization failed: \n"
sl@0	446
sl@0	447	test Tcl_Main-4.3 {
sl@0	448	Tcl_Main: rcFile evaluation closes stdin and sets main loop
sl@0	449	} -constraints {
sl@0	450	exec Tcltest
sl@0	451	} -setup {
sl@0	452	set rc [makeFile {
sl@0	453	close stdin
sl@0	454	testsetmainloop
sl@0	455	after 0 testexitmainloop
sl@0	456	testexithandler create 0
sl@0	457	rename exit _exit
sl@0	458	proc exit code {
sl@0	459	puts "In exit"
sl@0	460	_exit $code
sl@0	461	}
sl@0	462	} rc]
sl@0	463	} -body {
sl@0	464	exec [interpreter] << {puts "In script"} \
sl@0	465	-appinitprocsetrcfile $rc >& result
sl@0	466	set f [open result]
sl@0	467	read $f
sl@0	468	} -cleanup {
sl@0	469	close $f
sl@0	470	file delete result
sl@0	471	removeFile rc
sl@0	472	} -result "application-specific initialization failed:\
sl@0	473	\nExit MainLoop\nIn exit\neven 0\n"
sl@0	474
sl@0	475	test Tcl_Main-4.4 {
sl@0	476	Tcl_Main: rcFile evaluation sets main loop
sl@0	477	} -constraints {
sl@0	478	exec Tcltest
sl@0	479	} -setup {
sl@0	480	set rc [makeFile {
sl@0	481	testsetmainloop
sl@0	482	after 0 testexitmainloop
sl@0	483	testexithandler create 0
sl@0	484	rename exit _exit
sl@0	485	proc exit code {
sl@0	486	puts "In exit"
sl@0	487	_exit $code
sl@0	488	}
sl@0	489	} rc]
sl@0	490	} -body {
sl@0	491	exec [interpreter] << {} \
sl@0	492	-appinitprocsetrcfile $rc >& result
sl@0	493	set f [open result]
sl@0	494	read $f
sl@0	495	} -cleanup {
sl@0	496	close $f
sl@0	497	file delete result
sl@0	498	removeFile rc
sl@0	499	} -result "application-specific initialization failed:\
sl@0	500	\nExit MainLoop\nIn exit\neven 0\n"
sl@0	501
sl@0	502	test Tcl_Main-4.5 {
sl@0	503	Tcl_Main: Bug 1481986
sl@0	504	} -constraints {
sl@0	505	exec Tcltest
sl@0	506	} -setup {
sl@0	507	set rc [makeFile {
sl@0	508	testsetmainloop
sl@0	509	after 0 {puts "Event callback"}
sl@0	510	} rc]
sl@0	511	} -body {
sl@0	512	set f [open "\|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
sl@0	513	after 1000
sl@0	514	type $f {puts {Interactive output}
sl@0	515	exit
sl@0	516	}
sl@0	517	read $f
sl@0	518	} -cleanup {
sl@0	519	catch {close $f}
sl@0	520	removeFile rc
sl@0	521	} -result "Event callback\nInteractive output\n"
sl@0	522
sl@0	523	# Tests Tcl_Main-5.*: interactive operations
sl@0	524
sl@0	525	test Tcl_Main-5.1 {
sl@0	526	Tcl_Main: tcl_interactive must be boolean
sl@0	527	} -constraints {
sl@0	528	exec
sl@0	529	} -body {
sl@0	530	exec [interpreter] << {set tcl_interactive foo} >& result
sl@0	531	set f [open result]
sl@0	532	read $f
sl@0	533	} -cleanup {
sl@0	534	close $f
sl@0	535	file delete result
sl@0	536	} -result "can't set \"tcl_interactive\":\
sl@0	537	variable must have boolean value\n"
sl@0	538
sl@0	539	test Tcl_Main-5.2 {
sl@0	540	Tcl_Main able to handle non-blocking stdin
sl@0	541	} -constraints {
sl@0	542	exec
sl@0	543	} -setup {
sl@0	544	catch {set f [open "\|[list [interpreter]]" w+]}
sl@0	545	} -body {
sl@0	546	type $f {
sl@0	547	fconfigure stdin -blocking 0
sl@0	548	puts SUCCESS
sl@0	549	}
sl@0	550	list [catch {gets $f} line] $line
sl@0	551	} -cleanup {
sl@0	552	close $f
sl@0	553	} -result [list 0 SUCCESS]
sl@0	554
sl@0	555	test Tcl_Main-5.3 {
sl@0	556	Tcl_Main handles stdin EOF in mid-command
sl@0	557	} -constraints {
sl@0	558	exec
sl@0	559	} -setup {
sl@0	560	catch {set f [open "\|[list [interpreter]]" w+]}
sl@0	561	catch {fconfigure $f -blocking 0}
sl@0	562	} -body {
sl@0	563	type $f "fconfigure stdin -eofchar \\032
sl@0	564	if 1 \{\n\032"
sl@0	565	variable wait
sl@0	566	fileevent $f readable \
sl@0	567	[list set [namespace which -variable wait] "child exit"]
sl@0	568	set id [after 2000 [list set [namespace which -variable wait] timeout]]
sl@0	569	vwait [namespace which -variable wait]
sl@0	570	after cancel $id
sl@0	571	set wait
sl@0	572	} -cleanup {
sl@0	573	if {[string equal timeout $wait]
sl@0	574	&& [string equal unix $::tcl_platform(platform)]} {
sl@0	575	exec kill [pid $f]
sl@0	576	}
sl@0	577	close $f
sl@0	578	} -result {child exit}
sl@0	579
sl@0	580	test Tcl_Main-5.4 {
sl@0	581	Tcl_Main handles stdin EOF in mid-command
sl@0	582	} -constraints {
sl@0	583	exec
sl@0	584	} -setup {
sl@0	585	set cmd {makeFile "if 1 \{" script}
sl@0	586	catch {set f [open "\|[list [interpreter]] < [list [eval $cmd]]" r]}
sl@0	587	catch {fconfigure $f -blocking 0}
sl@0	588	} -body {
sl@0	589	variable wait
sl@0	590	fileevent $f readable \
sl@0	591	[list set [namespace which -variable wait] "child exit"]
sl@0	592	set id [after 2000 [list set [namespace which -variable wait] timeout]]
sl@0	593	vwait [namespace which -variable wait]
sl@0	594	after cancel $id
sl@0	595	set wait
sl@0	596	} -cleanup {
sl@0	597	if {[string equal timeout $wait]
sl@0	598	&& [string equal unix $::tcl_platform(platform)]} {
sl@0	599	exec kill [pid $f]
sl@0	600	}
sl@0	601	close $f
sl@0	602	removeFile script
sl@0	603	} -result {child exit}
sl@0	604
sl@0	605	test Tcl_Main-5.5 {
sl@0	606	Tcl_Main: error raised in interactive mode
sl@0	607	} -constraints {
sl@0	608	exec
sl@0	609	} -body {
sl@0	610	exec [interpreter] << {error foo} >& result
sl@0	611	set f [open result]
sl@0	612	read $f
sl@0	613	} -cleanup {
sl@0	614	close $f
sl@0	615	file delete result
sl@0	616	} -result "foo\n"
sl@0	617
sl@0	618	test Tcl_Main-5.6 {
sl@0	619	Tcl_Main: interactive mode: errors don't stop command loop
sl@0	620	} -constraints {
sl@0	621	exec
sl@0	622	} -body {
sl@0	623	exec [interpreter] << {
sl@0	624	error foo
sl@0	625	puts bar
sl@0	626	} >& result
sl@0	627	set f [open result]
sl@0	628	read $f
sl@0	629	} -cleanup {
sl@0	630	close $f
sl@0	631	file delete result
sl@0	632	} -result "foo\nbar\n"
sl@0	633
sl@0	634	test Tcl_Main-5.7 {
sl@0	635	Tcl_Main: interactive mode: closed stderr
sl@0	636	} -constraints {
sl@0	637	exec
sl@0	638	} -body {
sl@0	639	exec [interpreter] << {
sl@0	640	close stderr
sl@0	641	error foo
sl@0	642	puts bar
sl@0	643	} >& result
sl@0	644	set f [open result]
sl@0	645	read $f
sl@0	646	} -cleanup {
sl@0	647	close $f
sl@0	648	file delete result
sl@0	649	} -result "bar\n"
sl@0	650
sl@0	651	test Tcl_Main-5.8 {
sl@0	652	Tcl_Main: interactive mode: close stdin
sl@0	653	-> main loop & [exit] & exit handlers
sl@0	654	} -constraints {
sl@0	655	exec Tcltest
sl@0	656	} -body {
sl@0	657	exec [interpreter] << {
sl@0	658	rename exit _exit
sl@0	659	proc exit code {
sl@0	660	puts "In exit"
sl@0	661	_exit $code
sl@0	662	}
sl@0	663	testsetmainloop
sl@0	664	testexitmainloop
sl@0	665	testexithandler create 0
sl@0	666	close stdin
sl@0	667	} >& result
sl@0	668	set f [open result]
sl@0	669	read $f
sl@0	670	} -cleanup {
sl@0	671	close $f
sl@0	672	file delete result
sl@0	673	} -result "Exit MainLoop\nIn exit\neven 0\n"
sl@0	674
sl@0	675	test Tcl_Main-5.9 {
sl@0	676	Tcl_Main: interactive mode: delete interp
sl@0	677	-> main loop & exit handlers, but no [exit]
sl@0	678	} -constraints {
sl@0	679	exec Tcltest
sl@0	680	} -body {
sl@0	681	exec [interpreter] << {
sl@0	682	rename exit _exit
sl@0	683	proc exit code {
sl@0	684	puts "In exit"
sl@0	685	_exit $code
sl@0	686	}
sl@0	687	testsetmainloop
sl@0	688	testexitmainloop
sl@0	689	testexithandler create 0
sl@0	690	testinterpdelete {}
sl@0	691	} >& result
sl@0	692	set f [open result]
sl@0	693	read $f
sl@0	694	} -cleanup {
sl@0	695	close $f
sl@0	696	file delete result
sl@0	697	} -result "Exit MainLoop\neven 0\n"
sl@0	698
sl@0	699	test Tcl_Main-5.10 {
sl@0	700	Tcl_Main: exit main loop in mid-interactive command
sl@0	701	} -constraints {
sl@0	702	exec Tcltest
sl@0	703	} -setup {
sl@0	704	catch {set f [open "\|[list [interpreter]]" w+]}
sl@0	705	catch {fconfigure $f -blocking 0}
sl@0	706	} -body {
sl@0	707	type $f "testsetmainloop
sl@0	708	after 2000 testexitmainloop
sl@0	709	puts \{1 2"
sl@0	710	after 4000
sl@0	711	type $f "3 4\}"
sl@0	712	set code1 [catch {gets $f} line1]
sl@0	713	set code2 [catch {gets $f} line2]
sl@0	714	set code3 [catch {gets $f} line3]
sl@0	715	list $code1 $line1 $code2 $line2 $code3 $line3
sl@0	716	} -cleanup {
sl@0	717	close $f
sl@0	718	} -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]
sl@0	719
sl@0	720	test Tcl_Main-5.11 {
sl@0	721	Tcl_Main: EOF in interactive main loop
sl@0	722	} -constraints {
sl@0	723	exec Tcltest
sl@0	724	} -body {
sl@0	725	exec [interpreter] << {
sl@0	726	rename exit _exit
sl@0	727	proc exit code {
sl@0	728	puts "In exit"
sl@0	729	_exit $code
sl@0	730	}
sl@0	731	testexithandler create 0
sl@0	732	after 0 testexitmainloop
sl@0	733	testsetmainloop
sl@0	734	} >& result
sl@0	735	set f [open result]
sl@0	736	read $f
sl@0	737	} -cleanup {
sl@0	738	close $f
sl@0	739	file delete result
sl@0	740	} -result "Exit MainLoop\nIn exit\neven 0\n"
sl@0	741
sl@0	742	test Tcl_Main-5.12 {
sl@0	743	Tcl_Main: close stdin in interactive main loop
sl@0	744	} -constraints {
sl@0	745	exec Tcltest
sl@0	746	} -body {
sl@0	747	exec [interpreter] << {
sl@0	748	rename exit _exit
sl@0	749	proc exit code {
sl@0	750	puts "In exit"
sl@0	751	_exit $code
sl@0	752	}
sl@0	753	testexithandler create 0
sl@0	754	after 100 testexitmainloop
sl@0	755	testsetmainloop
sl@0	756	close stdin
sl@0	757	puts "don't reach this"
sl@0	758	} >& result
sl@0	759	set f [open result]
sl@0	760	read $f
sl@0	761	} -cleanup {
sl@0	762	close $f
sl@0	763	file delete result
sl@0	764	} -result "Exit MainLoop\nIn exit\neven 0\n"
sl@0	765
sl@0	766	# Tests Tcl_Main-6.*: interactive operations with prompts
sl@0	767
sl@0	768	test Tcl_Main-6.1 {
sl@0	769	Tcl_Main: enable prompts with tcl_interactive
sl@0	770	} -constraints {
sl@0	771	exec
sl@0	772	} -body {
sl@0	773	exec [interpreter] << {set tcl_interactive 1} >& result
sl@0	774	set f [open result]
sl@0	775	read $f
sl@0	776	} -cleanup {
sl@0	777	close $f
sl@0	778	file delete result
sl@0	779	} -result "1\n% "
sl@0	780
sl@0	781	test Tcl_Main-6.2 {
sl@0	782	Tcl_Main: prompt deletes interp
sl@0	783	} -constraints {
sl@0	784	exec Tcltest
sl@0	785	} -body {
sl@0	786	exec [interpreter] << {
sl@0	787	set tcl_prompt1 {testinterpdelete {}}
sl@0	788	set tcl_interactive 1
sl@0	789	puts "not reached"
sl@0	790	} >& result
sl@0	791	set f [open result]
sl@0	792	read $f
sl@0	793	} -cleanup {
sl@0	794	close $f
sl@0	795	file delete result
sl@0	796	} -result "1\n"
sl@0	797
sl@0	798	test Tcl_Main-6.3 {
sl@0	799	Tcl_Main: prompt closes stdin
sl@0	800	} -constraints {
sl@0	801	exec
sl@0	802	} -body {
sl@0	803	exec [interpreter] << {
sl@0	804	set tcl_prompt1 {close stdin}
sl@0	805	set tcl_interactive 1
sl@0	806	puts "not reached"
sl@0	807	} >& result
sl@0	808	set f [open result]
sl@0	809	read $f
sl@0	810	} -cleanup {
sl@0	811	close $f
sl@0	812	file delete result
sl@0	813	} -result "1\n"
sl@0	814
sl@0	815	test Tcl_Main-6.4 {
sl@0	816	Tcl_Main: interactive output, closed stdout
sl@0	817	} -constraints {
sl@0	818	exec
sl@0	819	} -body {
sl@0	820	exec [interpreter] << {
sl@0	821	set tcl_interactive 1
sl@0	822	close stdout
sl@0	823	set a NO
sl@0	824	puts stderr YES
sl@0	825	} >& result
sl@0	826	set f [open result]
sl@0	827	read $f
sl@0	828	} -cleanup {
sl@0	829	close $f
sl@0	830	file delete result
sl@0	831	} -result "1\n% YES\n"
sl@0	832
sl@0	833	test Tcl_Main-6.5 {
sl@0	834	Tcl_Main: interactive entry to main loop
sl@0	835	} -constraints {
sl@0	836	exec Tcltest
sl@0	837	} -body {
sl@0	838	exec [interpreter] << {
sl@0	839	set tcl_interactive 1
sl@0	840	testsetmainloop
sl@0	841	testexitmainloop} >& result
sl@0	842	set f [open result]
sl@0	843	read $f
sl@0	844	} -cleanup {
sl@0	845	close $f
sl@0	846	file delete result
sl@0	847	} -result "1\n% % % Exit MainLoop\n"
sl@0	848
sl@0	849	test Tcl_Main-6.6 {
sl@0	850	Tcl_Main: number of prompts during stdin close exit
sl@0	851	} -constraints {
sl@0	852	exec
sl@0	853	} -body {
sl@0	854	exec [interpreter] << {
sl@0	855	set tcl_interactive 1
sl@0	856	close stdin} >& result
sl@0	857	set f [open result]
sl@0	858	read $f
sl@0	859	} -cleanup {
sl@0	860	close $f
sl@0	861	file delete result
sl@0	862	} -result "1\n% "
sl@0	863
sl@0	864	test Tcl_Main-6.7 {
sl@0	865	[unknown]: interactive auto-completion.
sl@0	866	} -constraints {
sl@0	867	exec
sl@0	868	} -body {
sl@0	869	exec [interpreter] << {
sl@0	870	proc foo\{ x {}
sl@0	871	set ::auto_noexec xxx
sl@0	872	set tcl_interactive 1
sl@0	873	foo y} >& result
sl@0	874	set f [open result]
sl@0	875	read $f
sl@0	876	} -cleanup {
sl@0	877	close $f
sl@0	878	file delete result
sl@0	879	} -result "1\n% % "
sl@0	880
sl@0	881	# Tests Tcl_Main-7.*: exiting
sl@0	882
sl@0	883	test Tcl_Main-7.1 {
sl@0	884	Tcl_Main: [exit] defined as no-op -> still have exithandlers
sl@0	885	} -constraints {
sl@0	886	exec Tcltest
sl@0	887	} -body {
sl@0	888	exec [interpreter] << {
sl@0	889	proc exit args {}
sl@0	890	testexithandler create 0
sl@0	891	} >& result
sl@0	892	set f [open result]
sl@0	893	read $f
sl@0	894	} -cleanup {
sl@0	895	close $f
sl@0	896	file delete result
sl@0	897	} -result "even 0\n"
sl@0	898
sl@0	899	test Tcl_Main-7.2 {
sl@0	900	Tcl_Main: [exit] defined as no-op -> still have exithandlers
sl@0	901	} -constraints {
sl@0	902	exec Tcltest
sl@0	903	} -body {
sl@0	904	exec [interpreter] << {
sl@0	905	proc exit args {}
sl@0	906	testexithandler create 0
sl@0	907	after 0 testexitmainloop
sl@0	908	testsetmainloop
sl@0	909	} >& result
sl@0	910	set f [open result]
sl@0	911	read $f
sl@0	912	} -cleanup {
sl@0	913	close $f
sl@0	914	file delete result
sl@0	915	} -result "Exit MainLoop\neven 0\n"
sl@0	916
sl@0	917	# Tests Tcl_Main-8.*: StdinProc operations
sl@0	918
sl@0	919	test Tcl_Main-8.1 {
sl@0	920	StdinProc: handles non-blocking stdin
sl@0	921	} -constraints {
sl@0	922	exec Tcltest
sl@0	923	} -body {
sl@0	924	exec [interpreter] << {
sl@0	925	testsetmainloop
sl@0	926	fconfigure stdin -blocking 0
sl@0	927	testexitmainloop
sl@0	928	} >& result
sl@0	929	set f [open result]
sl@0	930	read $f
sl@0	931	} -cleanup {
sl@0	932	close $f
sl@0	933	file delete result
sl@0	934	} -result "Exit MainLoop\n"
sl@0	935
sl@0	936	test Tcl_Main-8.2 {
sl@0	937	StdinProc: handles stdin EOF
sl@0	938	} -constraints {
sl@0	939	exec Tcltest
sl@0	940	} -body {
sl@0	941	exec [interpreter] << {
sl@0	942	testsetmainloop
sl@0	943	testexithandler create 0
sl@0	944	rename exit _exit
sl@0	945	proc exit code {
sl@0	946	puts "In exit"
sl@0	947	_exit $code
sl@0	948	}
sl@0	949	after 100 testexitmainloop
sl@0	950	} >& result
sl@0	951	set f [open result]
sl@0	952	read $f
sl@0	953	} -cleanup {
sl@0	954	close $f
sl@0	955	file delete result
sl@0	956	} -result "Exit MainLoop\nIn exit\neven 0\n"
sl@0	957
sl@0	958	test Tcl_Main-8.3 {
sl@0	959	StdinProc: handles interactive stdin EOF
sl@0	960	} -constraints {
sl@0	961	exec Tcltest
sl@0	962	} -body {
sl@0	963	exec [interpreter] << {
sl@0	964	testsetmainloop
sl@0	965	testexithandler create 0
sl@0	966	rename exit _exit
sl@0	967	proc exit code {
sl@0	968	puts "In exit"
sl@0	969	_exit $code
sl@0	970	}
sl@0	971	set tcl_interactive 1} >& result
sl@0	972	set f [open result]
sl@0	973	read $f
sl@0	974	} -cleanup {
sl@0	975	close $f
sl@0	976	file delete result
sl@0	977	} -result "1\n% even 0\n"
sl@0	978
sl@0	979	test Tcl_Main-8.4 {
sl@0	980	StdinProc: handles stdin close
sl@0	981	} -constraints {
sl@0	982	exec Tcltest
sl@0	983	} -body {
sl@0	984	exec [interpreter] << {
sl@0	985	testsetmainloop
sl@0	986	rename exit _exit
sl@0	987	proc exit code {
sl@0	988	puts "In exit"
sl@0	989	_exit $code
sl@0	990	}
sl@0	991	after 100 testexitmainloop
sl@0	992	after 0 puts 1
sl@0	993	close stdin
sl@0	994	} >& result
sl@0	995	set f [open result]
sl@0	996	read $f
sl@0	997	} -cleanup {
sl@0	998	close $f
sl@0	999	file delete result
sl@0	1000	} -result "1\nExit MainLoop\nIn exit\n"
sl@0	1001
sl@0	1002	test Tcl_Main-8.5 {
sl@0	1003	StdinProc: handles interactive stdin close
sl@0	1004	} -constraints {
sl@0	1005	exec Tcltest
sl@0	1006	} -body {
sl@0	1007	exec [interpreter] << {
sl@0	1008	testsetmainloop
sl@0	1009	set tcl_interactive 1
sl@0	1010	rename exit _exit
sl@0	1011	proc exit code {
sl@0	1012	puts "In exit"
sl@0	1013	_exit $code
sl@0	1014	}
sl@0	1015	after 100 testexitmainloop
sl@0	1016	after 0 puts 1
sl@0	1017	close stdin
sl@0	1018	} >& result
sl@0	1019	set f [open result]
sl@0	1020	read $f
sl@0	1021	} -cleanup {
sl@0	1022	close $f
sl@0	1023	file delete result
sl@0	1024	} -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"
sl@0	1025
sl@0	1026	test Tcl_Main-8.6 {
sl@0	1027	StdinProc: handles event loop re-entry
sl@0	1028	} -constraints {
sl@0	1029	exec Tcltest
sl@0	1030	} -body {
sl@0	1031	exec [interpreter] << {
sl@0	1032	testsetmainloop
sl@0	1033	after 100 {puts 1; set delay 1}
sl@0	1034	vwait delay
sl@0	1035	puts 2
sl@0	1036	testexitmainloop
sl@0	1037	} >& result
sl@0	1038	set f [open result]
sl@0	1039	read $f
sl@0	1040	} -cleanup {
sl@0	1041	close $f
sl@0	1042	file delete result
sl@0	1043	} -result "1\n2\nExit MainLoop\n"
sl@0	1044
sl@0	1045	test Tcl_Main-8.7 {
sl@0	1046	StdinProc: handling of errors
sl@0	1047	} -constraints {
sl@0	1048	exec Tcltest
sl@0	1049	} -body {
sl@0	1050	exec [interpreter] << {
sl@0	1051	testsetmainloop
sl@0	1052	error foo
sl@0	1053	testexitmainloop
sl@0	1054	} >& result
sl@0	1055	set f [open result]
sl@0	1056	read $f
sl@0	1057	} -cleanup {
sl@0	1058	close $f
sl@0	1059	file delete result
sl@0	1060	} -result "foo\nExit MainLoop\n"
sl@0	1061
sl@0	1062	test Tcl_Main-8.8 {
sl@0	1063	StdinProc: handling of errors, closed stderr
sl@0	1064	} -constraints {
sl@0	1065	exec Tcltest
sl@0	1066	} -body {
sl@0	1067	exec [interpreter] << {
sl@0	1068	testsetmainloop
sl@0	1069	close stderr
sl@0	1070	error foo
sl@0	1071	testexitmainloop
sl@0	1072	} >& result
sl@0	1073	set f [open result]
sl@0	1074	read $f
sl@0	1075	} -cleanup {
sl@0	1076	close $f
sl@0	1077	file delete result
sl@0	1078	} -result "Exit MainLoop\n"
sl@0	1079
sl@0	1080	test Tcl_Main-8.9 {
sl@0	1081	StdinProc: interactive output
sl@0	1082	} -constraints {
sl@0	1083	exec Tcltest
sl@0	1084	} -body {
sl@0	1085	exec [interpreter] << {
sl@0	1086	testsetmainloop
sl@0	1087	set tcl_interactive 1
sl@0	1088	testexitmainloop} >& result
sl@0	1089	set f [open result]
sl@0	1090	read $f
sl@0	1091	} -cleanup {
sl@0	1092	close $f
sl@0	1093	file delete result
sl@0	1094	} -result "1\n% % Exit MainLoop\n"
sl@0	1095
sl@0	1096	test Tcl_Main-8.10 {
sl@0	1097	StdinProc: interactive output, closed stdout
sl@0	1098	} -constraints {
sl@0	1099	exec Tcltest
sl@0	1100	} -body {
sl@0	1101	exec [interpreter] << {
sl@0	1102	testsetmainloop
sl@0	1103	close stdout
sl@0	1104	set tcl_interactive 1
sl@0	1105	testexitmainloop
sl@0	1106	} >& result
sl@0	1107	set f [open result]
sl@0	1108	read $f
sl@0	1109	} -cleanup {
sl@0	1110	close $f
sl@0	1111	file delete result
sl@0	1112	} -result {}
sl@0	1113
sl@0	1114	test Tcl_Main-8.11 {
sl@0	1115	StdinProc: prompt deletes interp
sl@0	1116	} -constraints {
sl@0	1117	exec Tcltest
sl@0	1118	} -body {
sl@0	1119	exec [interpreter] << {
sl@0	1120	testsetmainloop
sl@0	1121	set tcl_prompt1 {testinterpdelete {}}
sl@0	1122	set tcl_interactive 1} >& result
sl@0	1123	set f [open result]
sl@0	1124	read $f
sl@0	1125	} -cleanup {
sl@0	1126	close $f
sl@0	1127	file delete result
sl@0	1128	} -result "1\n"
sl@0	1129
sl@0	1130	test Tcl_Main-8.12 {
sl@0	1131	StdinProc: prompt closes stdin
sl@0	1132	} -constraints {
sl@0	1133	exec Tcltest
sl@0	1134	} -body {
sl@0	1135	exec [interpreter] << {
sl@0	1136	testsetmainloop
sl@0	1137	set tcl_prompt1 {close stdin}
sl@0	1138	after 100 testexitmainloop
sl@0	1139	set tcl_interactive 1
sl@0	1140	puts "not reached"
sl@0	1141	} >& result
sl@0	1142	set f [open result]
sl@0	1143	read $f
sl@0	1144	} -cleanup {
sl@0	1145	close $f
sl@0	1146	file delete result
sl@0	1147	} -result "1\nExit MainLoop\n"
sl@0	1148
sl@0	1149	# Tests Tcl_Main-9.*: Prompt operations
sl@0	1150
sl@0	1151	test Tcl_Main-9.1 {
sl@0	1152	Prompt: custom prompt variables
sl@0	1153	} -constraints {
sl@0	1154	exec
sl@0	1155	} -body {
sl@0	1156	exec [interpreter] << {
sl@0	1157	set tcl_prompt1 {puts -nonewline stdout "one "}
sl@0	1158	set tcl_prompt2 {puts -nonewline stdout "two "}
sl@0	1159	set tcl_interactive 1
sl@0	1160	puts {This is
sl@0	1161	a test}} >& result
sl@0	1162	set f [open result]
sl@0	1163	read $f
sl@0	1164	} -cleanup {
sl@0	1165	close $f
sl@0	1166	file delete result
sl@0	1167	} -result "1\none two This is\n\t\ta test\none "
sl@0	1168
sl@0	1169	test Tcl_Main-9.2 {
sl@0	1170	Prompt: error in custom prompt variables
sl@0	1171	} -constraints {
sl@0	1172	exec
sl@0	1173	} -body {
sl@0	1174	exec [interpreter] << {
sl@0	1175	set tcl_prompt1 {error foo}
sl@0	1176	set tcl_interactive 1
sl@0	1177	set errorInfo} >& result
sl@0	1178	set f [open result]
sl@0	1179	read $f
sl@0	1180	} -cleanup {
sl@0	1181	close $f
sl@0	1182	file delete result
sl@0	1183	} -result "1\nfoo\n% foo\n while executing\n\"error foo\"\n (script\
sl@0	1184	that generates prompt)\nfoo\n% "
sl@0	1185
sl@0	1186	test Tcl_Main-9.3 {
sl@0	1187	Prompt: error in custom prompt variables, closed stderr
sl@0	1188	} -constraints {
sl@0	1189	exec
sl@0	1190	} -body {
sl@0	1191	exec [interpreter] << {
sl@0	1192	set tcl_prompt1 {close stderr; error foo}
sl@0	1193	set tcl_interactive 1} >& result
sl@0	1194	set f [open result]
sl@0	1195	read $f
sl@0	1196	} -cleanup {
sl@0	1197	close $f
sl@0	1198	file delete result
sl@0	1199	} -result "1\n% "
sl@0	1200
sl@0	1201	test Tcl_Main-9.4 {
sl@0	1202	Prompt: error in custom prompt variables, closed stdout
sl@0	1203	} -constraints {
sl@0	1204	exec
sl@0	1205	} -body {
sl@0	1206	exec [interpreter] << {
sl@0	1207	set tcl_prompt1 {close stdout; error foo}
sl@0	1208	set tcl_interactive 1} >& result
sl@0	1209	set f [open result]
sl@0	1210	read $f
sl@0	1211	} -cleanup {
sl@0	1212	close $f
sl@0	1213	file delete result
sl@0	1214	} -result "1\nfoo\n"
sl@0	1215
sl@0	1216	cd [workingDirectory]
sl@0	1217
sl@0	1218	cleanupTests
sl@0	1219	}
sl@0	1220
sl@0	1221	namespace delete ::tcl::test::main
sl@0	1222	return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--