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