Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/main.test @ 31

Last change on this file since 31 was 25, checked in by landauf, 18 years ago

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