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

     1 # This file contains a collection of tests for generic/tclMain.c.

2 #

     3 # RCS: @(#) $Id$

     5 if {[catch {package require tcltest 2.0.2}]} {

     6     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."

     7     return

8 }

    10 namespace eval ::tcl::test::main {

    12     namespace import ::tcltest::test

    13     namespace import ::tcltest::testConstraint

    14     namespace import ::tcltest::interpreter

    15     namespace import ::tcltest::cleanupTests

    16     namespace import ::tcltest::makeFile

    17     namespace import ::tcltest::removeFile

    18     namespace import ::tcltest::temporaryDirectory

    19     namespace import ::tcltest::workingDirectory

    21     # Is [exec] defined?

    22     testConstraint exec [llength [info commands exec]]

    24     # Is the Tcltest package loaded?

    25     #	- that is, the special C-coded testing commands in tclTest.c

    26     #   - tests use testing commands introduced in Tcltest 8.4

    27     testConstraint Tcltest [expr {

    28 	[llength [package provide Tcltest]]

    29 	&& [package vsatisfies [package provide Tcltest] 8.4]}]

    31     # Procedure to simulate interactive typing of commands, line by line

    32     proc type {chan script} {

    33 	foreach line [split $script \n] {

    34 	    if {[catch {

    35 	        puts $chan $line

    36 	        flush $chan

    37 	    }]} {

    38 		return

    39 	    }

    40 	    # Grrr... Behavior depends on this value.

    41 	    after 1000

    42 	}

    43     }

    45     cd [temporaryDirectory]

    46     # Tests Tcl_Main-1.*: variable initializations

    48     test Tcl_Main-1.1 {

    49 	Tcl_Main: startup script - normal

    50     } -constraints {

    51 	stdio

    52     } -setup {

    53 	makeFile {puts [list $argv0 $argv $tcl_interactive]} script

    54 	catch {set f [open "|[list [interpreter] script]" r]}

    55     } -body {

    56 	read $f

    57     } -cleanup {

    58 	close $f

    59 	removeFile script

    60     } -result [list script {} 0]\n

    62     test Tcl_Main-1.2 {

    63 	Tcl_Main: startup script - can't begin with '-'

    64     } -constraints {

    65 	stdio

    66     } -setup {

    67 	makeFile {puts [list $argv0 $argv $tcl_interactive]} -script

    68 	catch {set f [open "|[list [interpreter] -script]" w+]}

    69     } -body {

    70 	puts $f {puts [list $argv0 $argv $tcl_interactive]; exit}

    71 	flush $f

    72 	read $f

    73     } -cleanup {

    74 	close $f

    75 	removeFile -script

    76     } -result [list [interpreter] -script 0]\n

    78     test Tcl_Main-1.3 {

    79 	Tcl_Main: encoding of arguments: done by system encoding

    80 	Note the shortcoming explained in Tcl Feature Request 491789

    81     } -constraints {

    82 	stdio

    83     } -setup {

    84 	makeFile {puts [list $argv0 $argv $tcl_interactive]} script

    85 	catch {set f [open "|[list [interpreter] script \u00c0]" r]}

    86     } -body {

    87 	read $f

    88     } -cleanup {

    89 	close $f

    90 	removeFile script

    91     } -result [list script [list [encoding convertfrom [encoding system] \

    92 	[encoding convertto [encoding system] \u00c0]]] 0]\n

    94     test Tcl_Main-1.4 {

    95 	Tcl_Main: encoding of arguments: done by system encoding

    96 	Note the shortcoming explained in Tcl Feature Request 491789

    97     } -constraints {

    98 	stdio tempNotWin

    99     } -setup {

   100 	makeFile {puts [list $argv0 $argv $tcl_interactive]} script

   101 	catch {set f [open "|[list [interpreter] script \u20ac]" r]}

   102     } -body {

   103 	read $f

   104     } -cleanup {

   105 	close $f

   106 	removeFile script

   107     } -result [list script [list [encoding convertfrom [encoding system] \

   108 	[encoding convertto [encoding system] \u20ac]]] 0]\n

   110     test Tcl_Main-1.5 {

   111 	Tcl_Main: encoding of script name: system encoding loss

   112 	Note the shortcoming explained in Tcl Feature Request 491789

   113     } -constraints {

   114 	stdio

   115     } -setup {

   116 	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0

   117 	catch {set f [open "|[list [interpreter] \u00c0]" r]}

   118     } -body {

   119 	read $f

   120     } -cleanup {

   121 	close $f

   122 	removeFile \u00c0

   123     } -result [list [list [encoding convertfrom [encoding system] \

   124 	[encoding convertto [encoding system] \u00c0]]] {} 0]\n

   126     test Tcl_Main-1.6 {

   127 	Tcl_Main: encoding of script name: system encoding loss

   128 	Note the shortcoming explained in Tcl Feature Request 491789

   129     } -constraints {

   130 	stdio tempNotWin

   131     } -setup {

   132 	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac

   133 	catch {set f [open "|[list [interpreter] \u20ac]" r]}

   134     } -body {

   135 	read $f

   136     } -cleanup {

   137 	close $f

   138 	removeFile \u20ac

   139     } -result [list [list [encoding convertfrom [encoding system] \

   140 	[encoding convertto [encoding system] \u20ac]]] {} 0]\n

   142     # Tests Tcl_Main-2.*: application-initialization procedure

   144     test Tcl_Main-2.1 {

   145 	Tcl_Main: appInitProc returns error

   146     } -constraints {

   147 	exec Tcltest

   148     } -setup {

   149 	makeFile {puts "In script"} script

   150     } -body {

   151 	exec [interpreter] script -appinitprocerror >& result

   152 	set f [open result]

   153 	read $f

   154     } -cleanup {

   155 	close $f

   156 	file delete result

   157 	removeFile script

   158     } -result "application-specific initialization failed: \nIn script\n"

   160     test Tcl_Main-2.2 {

   161 	Tcl_Main: appInitProc returns error

   162     } -constraints {

   163 	exec Tcltest

   164     } -body {

   165 	exec [interpreter] << {puts "In script"} -appinitprocerror >& result

   166 	set f [open result]

   167 	read $f

   168     } -cleanup {

   169 	close $f

   170 	file delete result

   171     } -result "application-specific initialization failed: \nIn script\n"

   173     test Tcl_Main-2.3 {

   174 	Tcl_Main: appInitProc deletes interp

   175     } -constraints {

   176 	exec Tcltest

   177     } -setup {

   178 	makeFile {puts "In script"} script

   179     } -body {

   180 	exec [interpreter] script -appinitprocdeleteinterp >& result

   181 	set f [open result]

   182 	read $f

   183     } -cleanup {

   184 	close $f

   185 	file delete result

   186 	removeFile script

   187     } -result "application-specific initialization failed: \n"

   189     test Tcl_Main-2.4 {

   190 	Tcl_Main: appInitProc deletes interp

   191     } -constraints {

   192 	exec Tcltest

   193     } -body {

   194 	exec [interpreter] << {puts "In script"} \

   195 		-appinitprocdeleteinterp >& result

   196 	set f [open result]

   197 	read $f

   198     } -cleanup {

   199 	close $f

   200 	file delete result

   201     } -result "application-specific initialization failed: \n"

   203     test Tcl_Main-2.5 {

   204 	Tcl_Main: appInitProc closes stderr

   205     } -constraints {

   206 	exec Tcltest

   207     } -body {

   208 	exec [interpreter] << {puts "In script"} \

   209 		-appinitprocclosestderr >& result

   210 	set f [open result]

   211 	read $f

   212     } -cleanup {

   213 	close $f

   214 	file delete result

   215     } -result "In script\n"

   217     # Tests Tcl_Main-3.*: startup script evaluation

   219     test Tcl_Main-3.1 {

   220 	Tcl_Main: startup script does not exist

   221     } -constraints {

   222 	exec

   223     } -setup {

   224 	if {[file exists no-such-file]} {

   225 	    error "Can't run test Tcl_Main-3.1\

   226 		    where a file named \"no-such-file\" exists"

   227 	}

   228     } -body {

   229 	set code [catch {exec [interpreter] no-such-file >& result} result]

   230 	set f [open result]

   231 	list $code $result [read $f]

   232     } -cleanup {

   233 	close $f

   234 	file delete result

   235     } -match glob -result [list 1 {child process exited abnormally} \

   236 	{couldn't read file "no-such-file":*}]

   238     test Tcl_Main-3.2 {

   239 	Tcl_Main: startup script raises error

   240     } -constraints {

   241 	exec

   242     } -setup {

   243 	makeFile {error ERROR} script

   244     } -body {

   245 	set code [catch {exec [interpreter] script >& result} result]

   246 	set f [open result]

   247 	list $code $result [read $f]

   248     } -cleanup {

   249 	close $f

   250 	file delete result

   251 	removeFile script

   252     } -match glob -result [list 1 {child process exited abnormally} \

   253 	"ERROR\n    while executing*"]

   255     test Tcl_Main-3.3 {

   256 	Tcl_Main: startup script closes stderr

   257     } -constraints {

   258 	exec

   259     } -setup {

   260 	makeFile {close stderr; error ERROR} script

   261     } -body {

   262 	set code [catch {exec [interpreter] script >& result} result]

   263 	set f [open result]

   264 	list $code $result [read $f]

   265     } -cleanup {

   266 	close $f

   267 	file delete result

   268 	removeFile script

   269     } -result [list 1 {child process exited abnormally} {}]

   271     test Tcl_Main-3.4 {

   272 	Tcl_Main: startup script holds incomplete script

   273     } -constraints {

   274 	exec

   275     } -setup {

   276 	makeFile "if 1 \{" script

   277     } -body {

   278 	set code [catch {exec [interpreter] script >& result} result]

   279 	set f [open result]

   280 	join [list $code $result [read $f]] \n

   281     } -cleanup {

   282 	close $f

   283 	file delete result

   284 	removeFile script

   285     } -match glob -result [join [list 1 {child process exited abnormally}\

   286 	"missing close-brace\n    while executing*"] \n]

   288     test Tcl_Main-3.5 {

   289 	Tcl_Main: startup script sets main loop

   290     } -constraints {

   291 	exec Tcltest

   292     } -setup {

   293 	makeFile {

   294 		rename exit _exit

   295 		proc exit {code} {

   296 		    puts "In exit"

   297 		    _exit $code

   298 		}

   299 		after 0 {

   300 			puts event

   301 			testexitmainloop

   302 		}

   303 		testexithandler create 0

   304 		testsetmainloop

   305 	} script

   306     } -body {

   307 	exec [interpreter] script >& result

   308 	set f [open result]

   309 	read $f

   310     } -cleanup {

   311 	close $f

   312 	file delete result

   313 	removeFile script

   314     } -result "event\nExit MainLoop\nIn exit\neven 0\n"

   316     test Tcl_Main-3.6 {

   317 	Tcl_Main: startup script sets main loop and closes stdin

   318     } -constraints {

   319 	exec Tcltest

   320     } -setup {

   321 	makeFile {

   322 		close stdin

   323 		testsetmainloop

   324 		rename exit _exit

   325 		proc exit {code} {

   326 		    puts "In exit"

   327 		    _exit $code

   328 		}

   329 		after 0 {

   330 			puts event

   331 			testexitmainloop

   332 		}

   333 		testexithandler create 0

   334 	} script

   335     } -body {

   336 	exec [interpreter] script >& result

   337 	set f [open result]

   338 	read $f

   339     } -cleanup {

   340 	close $f

   341 	file delete result

   342 	removeFile script

   343     } -result "event\nExit MainLoop\nIn exit\neven 0\n"

   345     test Tcl_Main-3.7 {

   346 	Tcl_Main: startup script deletes interp

   347     } -constraints {

   348 	exec Tcltest

   349     } -setup {

   350 	makeFile {

   351 		rename exit _exit

   352 		proc exit {code} {

   353 		    puts "In exit"

   354 		    _exit $code

   355 		}

   356 		testexithandler create 0

   357 		testinterpdelete {}

   358 	} script

   359     } -body {

   360 	exec [interpreter] script >& result

   361 	set f [open result]

   362 	read $f

   363     } -cleanup {

   364 	close $f

   365 	file delete result

   366 	removeFile script

   367     } -result "even 0\n"

   369     test Tcl_Main-3.8 {

   370 	Tcl_Main: startup script deletes interp and sets mainloop

   371     } -constraints {

   372 	exec Tcltest

   373     } -setup {

   374 	makeFile {

   375 		testsetmainloop

   376 		rename exit _exit

   377 		proc exit {code} {

   378 		    puts "In exit"

   379 		    _exit $code

   380 		}

   381 		testexitmainloop

   382 		testexithandler create 0

   383 		testinterpdelete {}

   384 	} script

   385     } -body {

   386 	exec [interpreter] script >& result

   387 	set f [open result]

   388 	read $f

   389     } -cleanup {

   390 	close $f

   391 	file delete result

   392 	removeFile script

   393     } -result "Exit MainLoop\neven 0\n"

   395     test Tcl_Main-3.9 {

   396 	Tcl_Main: startup script can set tcl_interactive without limit

   397     } -constraints {

   398 	exec

   399     } -setup {

   400 	makeFile {set tcl_interactive foo} script

   401     } -body {

   402 	exec [interpreter] script >& result

   403 	set f [open result]

   404 	read $f

   405     } -cleanup {

   406 	close $f

   407 	file delete result

   408 	removeFile script

   409     } -result {}

   411     # Tests Tcl_Main-4.*: rc file evaluation

   413     test Tcl_Main-4.1 {

   414 	Tcl_Main: rcFile evaluation deletes interp

   415     } -constraints {

   416 	exec Tcltest

   417     } -setup {

   418 	set rc [makeFile {testinterpdelete {}} rc]

   419     } -body {

   420 	exec [interpreter] << {puts "In script"} \

   421 		-appinitprocsetrcfile $rc >& result

   422 	set f [open result]

   423 	read $f

   424     } -cleanup {

   425 	close $f

   426 	file delete result

   427 	removeFile rc

   428     } -result "application-specific initialization failed: \n"

   430     test Tcl_Main-4.2 {

   431 	Tcl_Main: rcFile evaluation closes stdin

   432     } -constraints {

   433 	exec Tcltest

   434     } -setup {

   435 	set rc [makeFile {close stdin} rc]

   436     } -body {

   437 	exec [interpreter] << {puts "In script"} \

   438 		-appinitprocsetrcfile $rc >& result

   439 	set f [open result]

   440 	read $f

   441     } -cleanup {

   442 	close $f

   443 	file delete result

   444 	removeFile rc

   445     } -result "application-specific initialization failed: \n"

   447     test Tcl_Main-4.3 {

   448 	Tcl_Main: rcFile evaluation closes stdin and sets main loop

   449     } -constraints {

   450 	exec Tcltest

   451     } -setup {

   452 	set rc [makeFile {

   453 		close stdin

   454 		testsetmainloop

   455 		after 0 testexitmainloop

   456 		testexithandler create 0

   457 		rename exit _exit

   458 		proc exit code {

   459 		    puts "In exit"

   460 		    _exit $code

   461 		}

   462 	} rc]

   463     } -body {

   464 	exec [interpreter] << {puts "In script"} \

   465 		-appinitprocsetrcfile $rc >& result

   466 	set f [open result]

   467 	read $f

   468     } -cleanup {

   469 	close $f

   470 	file delete result

   471 	removeFile rc

   472     } -result "application-specific initialization failed:\

   473 	\nExit MainLoop\nIn exit\neven 0\n"

   475     test Tcl_Main-4.4 {

   476 	Tcl_Main: rcFile evaluation sets main loop

   477     } -constraints {

   478 	exec Tcltest

   479     } -setup {

   480 	set rc [makeFile {

   481 		testsetmainloop

   482 		after 0 testexitmainloop

   483 		testexithandler create 0

   484 		rename exit _exit

   485 		proc exit code {

   486 		    puts "In exit"

   487 		    _exit $code

   488 		}

   489 	} rc]

   490     } -body {

   491 	exec [interpreter] << {} \

   492 		-appinitprocsetrcfile $rc >& result

   493 	set f [open result]

   494 	read $f

   495     } -cleanup {

   496 	close $f

   497 	file delete result

   498 	removeFile rc

   499     } -result "application-specific initialization failed:\

   500 	\nExit MainLoop\nIn exit\neven 0\n"

   502     test Tcl_Main-4.5 {

   503 	Tcl_Main: Bug 1481986

   504     } -constraints {

   505 	exec Tcltest

   506     } -setup {

   507 	set rc [makeFile {

   508 		testsetmainloop

   509 		after 0 {puts "Event callback"}

   510 	} rc]

   511     } -body {

   512 	set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]

   513 	after 1000

   514 	type $f {puts {Interactive output}

   515 	    exit

   516 	}

   517 	read $f

   518     } -cleanup {

   519 	catch {close $f}

   520 	removeFile rc

   521     } -result "Event callback\nInteractive output\n"

   523     # Tests Tcl_Main-5.*: interactive operations

   525     test Tcl_Main-5.1 {

   526 	Tcl_Main: tcl_interactive must be boolean

   527     } -constraints {

   528 	exec

   529     } -body {

   530 	exec [interpreter] << {set tcl_interactive foo} >& result

   531 	set f [open result]

   532 	read $f

   533     } -cleanup {

   534 	close $f

   535 	file delete result

   536     } -result "can't set \"tcl_interactive\":\

   537 	     variable must have boolean value\n"

   539     test Tcl_Main-5.2 {

   540 	Tcl_Main able to handle non-blocking stdin

   541     } -constraints {

   542 	exec

   543     } -setup {

   544 	catch {set f [open "|[list [interpreter]]" w+]}

   545     } -body {

   546 	type $f {

   547 	    fconfigure stdin -blocking 0

   548 	    puts SUCCESS

   549 	}

   550 	list [catch {gets $f} line] $line

   551     } -cleanup {

   552 	close $f

   553     } -result [list 0 SUCCESS]

   555     test Tcl_Main-5.3 {

   556 	Tcl_Main handles stdin EOF in mid-command

   557     } -constraints {

   558 	exec

   559     } -setup {

   560 	catch {set f [open "|[list [interpreter]]" w+]}

   561 	catch {fconfigure $f -blocking 0}

   562     } -body {

   563 	type $f "fconfigure stdin -eofchar \\032

   564 	    if 1 \{\n\032"

   565 	variable wait

   566 	fileevent $f readable \

   567 		[list set [namespace which -variable wait] "child exit"]

   568 	set id [after 2000 [list set [namespace which -variable wait] timeout]]

   569 	vwait [namespace which -variable wait]

   570 	after cancel $id

   571 	set wait

   572     } -cleanup {

   573 	if {[string equal timeout $wait]

   574 		&& [string equal unix $::tcl_platform(platform)]} {

   575 	    exec kill [pid $f]

   576 	}

   577 	close $f

   578     } -result {child exit}

   580     test Tcl_Main-5.4 {

   581 	Tcl_Main handles stdin EOF in mid-command

   582     } -constraints {

   583 	exec

   584     } -setup {

   585 	set cmd {makeFile "if 1 \{" script}

   586 	catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}

   587 	catch {fconfigure $f -blocking 0}

   588     } -body {

   589 	variable wait

   590 	fileevent $f readable \

   591 		[list set [namespace which -variable wait] "child exit"]

   592 	set id [after 2000 [list set [namespace which -variable wait] timeout]]

   593 	vwait [namespace which -variable wait]

   594 	after cancel $id

   595 	set wait

   596     } -cleanup {

   597 	if {[string equal timeout $wait]

   598 		&& [string equal unix $::tcl_platform(platform)]} {

   599 	    exec kill [pid $f]

   600 	}

   601 	close $f

   602 	removeFile script

   603     } -result {child exit}

   605     test Tcl_Main-5.5 {

   606 	Tcl_Main: error raised in interactive mode

   607     } -constraints {

   608 	exec

   609     } -body {

   610 	exec [interpreter] << {error foo} >& result

   611 	set f [open result]

   612 	read $f

   613     } -cleanup {

   614 	close $f

   615 	file delete result

   616     } -result "foo\n"

   618     test Tcl_Main-5.6 {

   619 	Tcl_Main: interactive mode: errors don't stop command loop

   620     } -constraints {

   621 	exec

   622     } -body {

   623 	exec [interpreter] << {

   624 		error foo

   625 		puts bar

   626 	} >& result

   627 	set f [open result]

   628 	read $f

   629     } -cleanup {

   630 	close $f

   631 	file delete result

   632     } -result "foo\nbar\n"

   634     test Tcl_Main-5.7 {

   635 	Tcl_Main: interactive mode: closed stderr

   636     } -constraints {

   637 	exec

   638     } -body {

   639 	exec [interpreter] << {

   640 		close stderr

   641 		error foo

   642 		puts bar

   643 	} >& result

   644 	set f [open result]

   645 	read $f

   646     } -cleanup {

   647 	close $f

   648 	file delete result

   649     } -result "bar\n"

   651     test Tcl_Main-5.8 {

   652 	Tcl_Main: interactive mode: close stdin

   653 		-> main loop & [exit] & exit handlers

   654     } -constraints {

   655 	exec Tcltest

   656     } -body {

   657 	exec [interpreter] << {

   658 		rename exit _exit

   659 		proc exit code {

   660 		    puts "In exit"

   661 		    _exit $code

   662 		}

   663 		testsetmainloop

   664 		testexitmainloop

   665 		testexithandler create 0

   666 		close stdin

   667 	} >& result

   668 	set f [open result]

   669 	read $f

   670     } -cleanup {

   671 	close $f

   672 	file delete result

   673     } -result "Exit MainLoop\nIn exit\neven 0\n"

   675     test Tcl_Main-5.9 {

   676 	Tcl_Main: interactive mode: delete interp

   677 		-> main loop & exit handlers, but no [exit]

   678     } -constraints {

   679 	exec Tcltest

   680     } -body {

   681 	exec [interpreter] << {

   682 		rename exit _exit

   683 		proc exit code {

   684 		    puts "In exit"

   685 		    _exit $code

   686 		}

   687 		testsetmainloop

   688 		testexitmainloop

   689 		testexithandler create 0

   690 		testinterpdelete {}

   691 	} >& result

   692 	set f [open result]

   693 	read $f

   694     } -cleanup {

   695 	close $f

   696 	file delete result

   697     } -result "Exit MainLoop\neven 0\n"

   699     test Tcl_Main-5.10 {

   700 	Tcl_Main: exit main loop in mid-interactive command

   701     } -constraints {

   702 	exec Tcltest

   703     } -setup {

   704 	catch {set f [open "|[list [interpreter]]" w+]}

   705 	catch {fconfigure $f -blocking 0}

   706     } -body {

   707 	type $f "testsetmainloop

   708 	         after 2000 testexitmainloop

   709 	         puts \{1 2"

   710 	after 4000

   711 	type $f "3 4\}"

   712 	set code1 [catch {gets $f} line1]

   713 	set code2 [catch {gets $f} line2]

   714 	set code3 [catch {gets $f} line3]

   715 	list $code1 $line1 $code2 $line2 $code3 $line3

   716     } -cleanup {

   717 	close $f

   718     } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]

   720     test Tcl_Main-5.11 {

   721 	Tcl_Main: EOF in interactive main loop

   722     } -constraints {

   723 	exec Tcltest

   724     } -body {

   725 	exec [interpreter] << {

   726 		rename exit _exit

   727 		proc exit code {

   728 		    puts "In exit"

   729 		    _exit $code

   730 		}

   731 		testexithandler create 0

   732 		after 0 testexitmainloop

   733 		testsetmainloop

   734 	} >& result

   735 	set f [open result]

   736 	read $f

   737     } -cleanup {

   738 	close $f

   739 	file delete result

   740     } -result "Exit MainLoop\nIn exit\neven 0\n"

   742     test Tcl_Main-5.12 {

   743 	Tcl_Main: close stdin in interactive main loop

   744     } -constraints {

   745 	exec Tcltest

   746     } -body {

   747 	exec [interpreter] << {

   748 		rename exit _exit

   749 		proc exit code {

   750 		    puts "In exit"

   751 		    _exit $code

   752 		}

   753 		testexithandler create 0

   754 		after 100 testexitmainloop

   755 		testsetmainloop

   756 		close stdin

   757 		puts "don't reach this"

   758 	} >& result

   759 	set f [open result]

   760 	read $f

   761     } -cleanup {

   762 	close $f

   763 	file delete result

   764     } -result "Exit MainLoop\nIn exit\neven 0\n"

   766     # Tests Tcl_Main-6.*: interactive operations with prompts

   768     test Tcl_Main-6.1 {

   769 	Tcl_Main: enable prompts with tcl_interactive

   770     } -constraints {

   771 	exec

   772     } -body {

   773 	exec [interpreter] << {set tcl_interactive 1} >& result

   774 	set f [open result]

   775 	read $f

   776     } -cleanup {

   777 	close $f

   778 	file delete result

   779     } -result "1\n% "

   781     test Tcl_Main-6.2 {

   782 	Tcl_Main: prompt deletes interp

   783     } -constraints {

   784 	exec Tcltest

   785     } -body {

   786 	exec [interpreter] << {

   787 		set tcl_prompt1 {testinterpdelete {}}

   788 		set tcl_interactive 1

   789 		puts "not reached"

   790 	} >& result

   791 	set f [open result]

   792 	read $f

   793     } -cleanup {

   794 	close $f

   795 	file delete result

   796     } -result "1\n"

   798     test Tcl_Main-6.3 {

   799 	Tcl_Main: prompt closes stdin

   800     } -constraints {

   801 	exec

   802     } -body {

   803 	exec [interpreter] << {

   804 		set tcl_prompt1 {close stdin}

   805 		set tcl_interactive 1

   806 		puts "not reached"

   807 	} >& result

   808 	set f [open result]

   809 	read $f

   810     } -cleanup {

   811 	close $f

   812 	file delete result

   813     } -result "1\n"

   815     test Tcl_Main-6.4 {

   816 	Tcl_Main: interactive output, closed stdout

   817     } -constraints {

   818 	exec

   819     } -body {

   820 	exec [interpreter] << {

   821 		set tcl_interactive 1

   822 		close stdout

   823 		set a NO

   824 		puts stderr YES

   825 	} >& result

   826 	set f [open result]

   827 	read $f

   828     } -cleanup {

   829 	close $f

   830 	file delete result

   831     } -result "1\n% YES\n"

   833     test Tcl_Main-6.5 {

   834 	Tcl_Main: interactive entry to main loop

   835     } -constraints {

   836 	exec Tcltest

   837     } -body {

   838 	exec [interpreter] << {

   839 		set tcl_interactive 1

   840 		testsetmainloop

   841 		testexitmainloop} >& result

   842 	set f [open result]

   843 	read $f

   844     } -cleanup {

   845 	close $f

   846 	file delete result

   847     } -result "1\n% % % Exit MainLoop\n"

   849     test Tcl_Main-6.6 {

   850 	Tcl_Main: number of prompts during stdin close exit

   851     } -constraints {

   852 	exec

   853     } -body {

   854 	exec [interpreter] << {

   855 		set tcl_interactive 1

   856 		close stdin} >& result

   857 	set f [open result]

   858 	read $f

   859     } -cleanup {

   860 	close $f

   861 	file delete result

   862     } -result "1\n% "

   864     test Tcl_Main-6.7 {

   865 	[unknown]: interactive auto-completion.

   866     } -constraints {

   867 	exec

   868     } -body {

   869 	exec [interpreter] << {

   870 		proc foo\{ x {}

   871 		set ::auto_noexec xxx

   872 		set tcl_interactive 1

   873 		foo y} >& result

   874 	set f [open result]

   875 	read $f

   876     } -cleanup {

   877 	close $f

   878 	file delete result

   879     } -result "1\n% % "

   881     # Tests Tcl_Main-7.*: exiting

   883     test Tcl_Main-7.1 {

   884 	Tcl_Main: [exit] defined as no-op -> still have exithandlers

   885     } -constraints {

   886 	exec Tcltest

   887     } -body {

   888 	exec [interpreter] << {

   889 		proc exit args {}

   890 		testexithandler create 0

   891 	} >& result

   892 	set f [open result]

   893 	read $f

   894     } -cleanup {

   895 	close $f

   896 	file delete result

   897     } -result "even 0\n"

   899     test Tcl_Main-7.2 {

   900 	Tcl_Main: [exit] defined as no-op -> still have exithandlers

   901     } -constraints {

   902 	exec Tcltest

   903     } -body {

   904 	exec [interpreter] << {

   905 		proc exit args {}

   906 		testexithandler create 0

   907 		after 0 testexitmainloop

   908 		testsetmainloop

   909 	} >& result

   910 	set f [open result]

   911 	read $f

   912     } -cleanup {

   913 	close $f

   914 	file delete result

   915     } -result "Exit MainLoop\neven 0\n"

   917     # Tests Tcl_Main-8.*: StdinProc operations

   919     test Tcl_Main-8.1 {

   920 	StdinProc: handles non-blocking stdin

   921     } -constraints {

   922 	exec Tcltest

   923     } -body {

   924 	exec [interpreter] << {

   925 		testsetmainloop

   926 		fconfigure stdin -blocking 0

   927 		testexitmainloop

   928 	} >& result

   929 	set f [open result]

   930 	read $f

   931     } -cleanup {

   932 	close $f

   933 	file delete result

   934     } -result "Exit MainLoop\n"

   936     test Tcl_Main-8.2 {

   937 	StdinProc: handles stdin EOF

   938     } -constraints {

   939 	exec Tcltest

   940     } -body {

   941 	exec [interpreter] << {

   942 		testsetmainloop

   943 		testexithandler create 0

   944 		rename exit _exit

   945 		proc exit code {

   946 		    puts "In exit"

   947 		    _exit $code

   948 		}

   949 		after 100 testexitmainloop

   950 	} >& result

   951 	set f [open result]

   952 	read $f

   953     } -cleanup {

   954 	close $f

   955 	file delete result

   956     } -result "Exit MainLoop\nIn exit\neven 0\n"

   958     test Tcl_Main-8.3 {

   959 	StdinProc: handles interactive stdin EOF

   960     } -constraints {

   961 	exec Tcltest

   962     } -body {

   963 	exec [interpreter] << {

   964 		testsetmainloop

   965 		testexithandler create 0

   966 		rename exit _exit

   967 		proc exit code {

   968 		    puts "In exit"

   969 		    _exit $code

   970 		}

   971 		set tcl_interactive 1} >& result

   972 	set f [open result]

   973 	read $f

   974     } -cleanup {

   975 	close $f

   976 	file delete result

   977     } -result "1\n% even 0\n"

   979     test Tcl_Main-8.4 {

   980 	StdinProc: handles stdin close

   981     } -constraints {

   982 	exec Tcltest

   983     } -body {

   984 	exec [interpreter] << {

   985 		testsetmainloop

   986 		rename exit _exit

   987 		proc exit code {

   988 		    puts "In exit"

   989 		    _exit $code

   990 		}

   991 		after 100 testexitmainloop

   992 		after 0 puts 1

   993 		close stdin

   994 	} >& result

   995 	set f [open result]

   996 	read $f

   997     } -cleanup {

   998 	close $f

   999 	file delete result

  1000     } -result "1\nExit MainLoop\nIn exit\n"

  1002     test Tcl_Main-8.5 {

  1003 	StdinProc: handles interactive stdin close

  1004     } -constraints {

  1005 	exec Tcltest

  1006     } -body {

  1007 	exec [interpreter] << {

  1008 		testsetmainloop

  1009 		set tcl_interactive 1

  1010 		rename exit _exit

  1011 		proc exit code {

  1012 		    puts "In exit"

  1013 		    _exit $code

  1014 		}

  1015 		after 100 testexitmainloop

  1016 		after 0 puts 1

  1017 		close stdin

  1018 	} >& result

  1019 	set f [open result]

  1020 	read $f

  1021     } -cleanup {

  1022 	close $f

  1023 	file delete result

  1024     } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"

  1026     test Tcl_Main-8.6 {

  1027 	StdinProc: handles event loop re-entry

  1028     } -constraints {

  1029 	exec Tcltest

  1030     } -body {

  1031 	exec [interpreter] << {

  1032 		testsetmainloop

  1033 		after 100 {puts 1; set delay 1}

  1034 		vwait delay

  1035 		puts 2

  1036 		testexitmainloop

  1037 	} >& result

  1038 	set f [open result]

  1039 	read $f

  1040     } -cleanup {

  1041 	close $f

  1042 	file delete result

  1043     } -result "1\n2\nExit MainLoop\n"

  1045     test Tcl_Main-8.7 {

  1046 	StdinProc: handling of errors

  1047     } -constraints {

  1048 	exec Tcltest

  1049     } -body {

  1050 	exec [interpreter] << {

  1051 		testsetmainloop

  1052 		error foo

  1053 		testexitmainloop

  1054 	} >& result

  1055 	set f [open result]

  1056 	read $f

  1057     } -cleanup {

  1058 	close $f

  1059 	file delete result

  1060     } -result "foo\nExit MainLoop\n"

  1062     test Tcl_Main-8.8 {

  1063 	StdinProc: handling of errors, closed stderr

  1064     } -constraints {

  1065 	exec Tcltest

  1066     } -body {

  1067 	exec [interpreter] << {

  1068 		testsetmainloop

  1069 		close stderr

  1070 		error foo

  1071 		testexitmainloop

  1072 	} >& result

  1073 	set f [open result]

  1074 	read $f

  1075     } -cleanup {

  1076 	close $f

  1077 	file delete result

  1078     } -result "Exit MainLoop\n"

  1080     test Tcl_Main-8.9 {

  1081 	StdinProc: interactive output

  1082     } -constraints {

  1083 	exec Tcltest

  1084     } -body {

  1085 	exec [interpreter] << {

  1086 		testsetmainloop

  1087 		set tcl_interactive 1

  1088 		testexitmainloop} >& result

  1089 	set f [open result]

  1090 	read $f

  1091     } -cleanup {

  1092 	close $f

  1093 	file delete result

  1094     } -result "1\n% % Exit MainLoop\n"

  1096     test Tcl_Main-8.10 {

  1097 	StdinProc: interactive output, closed stdout

  1098     } -constraints {

  1099 	exec Tcltest

  1100     } -body {

  1101 	exec [interpreter] << {

  1102 		testsetmainloop

  1103 		close stdout

  1104 		set tcl_interactive 1

  1105 		testexitmainloop

  1106 	} >& result

  1107 	set f [open result]

  1108 	read $f

  1109     } -cleanup {

  1110 	close $f

  1111 	file delete result

  1112     } -result {}

  1114     test Tcl_Main-8.11 {

  1115 	StdinProc: prompt deletes interp

  1116     } -constraints {

  1117 	exec Tcltest

  1118     } -body {

  1119 	exec [interpreter] << {

  1120 		testsetmainloop

  1121 		set tcl_prompt1 {testinterpdelete {}}

  1122 		set tcl_interactive 1} >& result

  1123 	set f [open result]

  1124 	read $f

  1125     } -cleanup {

  1126 	close $f

  1127 	file delete result

  1128     } -result "1\n"

  1130     test Tcl_Main-8.12 {

  1131 	StdinProc: prompt closes stdin

  1132     } -constraints {

  1133 	exec Tcltest

  1134     } -body {

  1135 	exec [interpreter] << {

  1136 		testsetmainloop

  1137 		set tcl_prompt1 {close stdin}

  1138 		after 100 testexitmainloop

  1139 		set tcl_interactive 1

  1140 		puts "not reached"

  1141 	} >& result

  1142 	set f [open result]

  1143 	read $f

  1144     } -cleanup {

  1145 	close $f

  1146 	file delete result

  1147     } -result "1\nExit MainLoop\n"

  1149     # Tests Tcl_Main-9.*: Prompt operations

  1151     test Tcl_Main-9.1 {

  1152 	Prompt: custom prompt variables

  1153     } -constraints {

  1154 	exec

  1155     } -body {

  1156 	exec [interpreter] << {

  1157 		set tcl_prompt1 {puts -nonewline stdout "one "}

  1158 		set tcl_prompt2 {puts -nonewline stdout "two "}

  1159 		set tcl_interactive 1

  1160 		puts {This is

  1161 		a test}} >& result

  1162 	set f [open result]

  1163 	read $f

  1164     } -cleanup {

  1165 	close $f

  1166 	file delete result

  1167     } -result "1\none two This is\n\t\ta test\none "

  1169     test Tcl_Main-9.2 {

  1170 	Prompt: error in custom prompt variables

  1171     } -constraints {

  1172 	exec

  1173     } -body {

  1174 	exec [interpreter] << {

  1175 		set tcl_prompt1 {error foo}

  1176 		set tcl_interactive 1

  1177 		set errorInfo} >& result

  1178 	set f [open result]

  1179 	read $f

  1180     } -cleanup {

  1181 	close $f

  1182 	file delete result

  1183     } -result "1\nfoo\n% foo\n    while executing\n\"error foo\"\n    (script\

  1184 	that generates prompt)\nfoo\n% "

  1186     test Tcl_Main-9.3 {

  1187 	Prompt: error in custom prompt variables, closed stderr

  1188     } -constraints {

  1189 	exec

  1190     } -body {

  1191 	exec [interpreter] << {

  1192 		set tcl_prompt1 {close stderr; error foo}

  1193 		set tcl_interactive 1} >& result

  1194 	set f [open result]

  1195 	read $f

  1196     } -cleanup {

  1197 	close $f

  1198 	file delete result

  1199     } -result "1\n% "

  1201     test Tcl_Main-9.4 {

  1202 	Prompt: error in custom prompt variables, closed stdout

  1203     } -constraints {

  1204 	exec

  1205     } -body {

  1206 	exec [interpreter] << {

  1207 		set tcl_prompt1 {close stdout; error foo}

  1208 		set tcl_interactive 1} >& result

  1209 	set f [open result]

  1210 	read $f

  1211     } -cleanup {

  1212 	close $f

  1213 	file delete result

  1214     } -result "1\nfoo\n"

  1216     cd [workingDirectory]

  1218     cleanupTests

  1219 }

  1221 namespace delete ::tcl::test::main

  1222 return

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