Artifact
ccfc1f518480923583022bf0ee5f7f66e91dd50e
File
tests/aaa_exit.test
— part of check-in
[208b2e859d]
at
2014-09-03 19:44:29
on branch trunk
— Distinguish hanging from crashing in exit tests.
(user:
ferrieux
size: 1698)
[more...]
0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 63 6f 76 65 72 # Commands cover
0010: 65 64 3a 20 20 65 78 69 74 2c 20 65 6d 70 68 61 ed: exit, empha
0020: 73 69 73 20 6f 6e 20 66 69 6e 61 6c 69 7a 61 74 sis on finalizat
0030: 69 6f 6e 20 68 61 6e 67 73 0a 23 0a 23 20 54 68 ion hangs.#.# Th
0040: 69 73 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 is file contains
0050: 20 61 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 a collection of
0060: 20 74 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f tests for one o
0070: 72 20 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 r more of the Tc
0080: 6c 0a 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d l.# built-in com
0090: 6d 61 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 mands. Sourcing
00a0: 20 74 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 this file into
00b0: 54 63 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 Tcl runs the tes
00c0: 74 73 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 ts and.# generat
00d0: 65 73 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 es output for er
00e0: 72 6f 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 rors. No output
00f0: 20 6d 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 means no errors
0100: 20 77 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 were found..#.#
0110: 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 Copyright (c) 1
0120: 39 39 31 2d 31 39 39 33 20 54 68 65 20 52 65 67 991-1993 The Reg
0130: 65 6e 74 73 20 6f 66 20 74 68 65 20 55 6e 69 76 ents of the Univ
0140: 65 72 73 69 74 79 20 6f 66 20 43 61 6c 69 66 6f ersity of Califo
0150: 72 6e 69 61 2e 0a 23 20 43 6f 70 79 72 69 67 68 rnia..# Copyrigh
0160: 74 20 28 63 29 20 31 39 39 34 2d 31 39 39 37 20 t (c) 1994-1997
0170: 53 75 6e 20 4d 69 63 72 6f 73 79 73 74 65 6d 73 Sun Microsystems
0180: 2c 20 49 6e 63 2e 0a 23 20 43 6f 70 79 72 69 67 , Inc..# Copyrig
0190: 68 74 20 28 63 29 20 31 39 39 38 2d 31 39 39 39 ht (c) 1998-1999
01a0: 20 62 79 20 53 63 72 69 70 74 69 63 73 20 43 6f by Scriptics Co
01b0: 72 70 6f 72 61 74 69 6f 6e 2e 0a 23 0a 23 20 53 rporation..#.# S
01c0: 65 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 ee the file "lic
01d0: 65 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 ense.terms" for
01e0: 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 information on u
01f0: 73 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 sage and redistr
0200: 69 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 ibution.# of thi
0210: 73 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 s file, and for
0220: 61 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 a DISCLAIMER OF
0230: 41 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a ALL WARRANTIES..
0240: 0a 69 66 20 7b 5b 6c 73 65 61 72 63 68 20 5b 6e .if {[lsearch [n
0250: 61 6d 65 73 70 61 63 65 20 63 68 69 6c 64 72 65 amespace childre
0260: 6e 5d 20 3a 3a 74 63 6c 74 65 73 74 5d 20 3d 3d n] ::tcltest] ==
0270: 20 2d 31 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61 -1} {. packa
0280: 67 65 20 72 65 71 75 69 72 65 20 74 63 6c 74 65 ge require tclte
0290: 73 74 20 32 0a 20 20 20 20 6e 61 6d 65 73 70 61 st 2. namespa
02a0: 63 65 20 69 6d 70 6f 72 74 20 2d 66 6f 72 63 65 ce import -force
02b0: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 2a 0a 7d 0a ::tcltest::*.}.
02c0: 0a 74 65 73 74 20 65 78 69 74 2d 31 2e 31 20 7b .test exit-1.1 {
02d0: 6e 6f 72 6d 61 6c 2c 20 71 75 69 63 6b 20 65 78 normal, quick ex
02e0: 69 74 7d 20 7b 0a 20 20 20 20 20 73 65 74 20 66 it} {. set f
02f0: 20 5b 6f 70 65 6e 20 22 7c 5b 69 6e 74 65 72 70 [open "|[interp
0300: 72 65 74 65 72 5d 20 3c 3c 20 5c 22 65 78 65 63 reter] << \"exec
0310: 20 5b 69 6e 74 65 72 70 72 65 74 65 72 5d 20 3c [interpreter] <
0320: 3c 20 7b 73 65 74 20 3a 3a 65 6e 76 28 54 43 4c < {set ::env(TCL
0330: 5f 46 49 4e 41 4c 49 5a 45 5f 4f 4e 5f 45 58 49 _FINALIZE_ON_EXI
0340: 54 29 20 30 3b 65 78 69 74 7d 5c 22 22 20 72 5d T) 0;exit}\"" r]
0350: 0a 20 20 20 20 20 73 65 74 20 61 66 74 20 5b 61 . set aft [a
0360: 66 74 65 72 20 31 30 30 30 20 7b 73 65 74 20 64 fter 1000 {set d
0370: 6f 6e 65 20 22 51 75 69 63 6b 20 65 78 69 74 20 one "Quick exit
0380: 68 61 6e 67 73 20 21 21 21 22 7d 5d 0a 20 20 20 hangs !!!"}].
0390: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 fileevent $f r
03a0: 65 61 64 61 62 6c 65 20 7b 61 66 74 65 72 20 63 eadable {after c
03b0: 61 6e 63 65 6c 20 24 61 66 74 3b 73 65 74 20 64 ancel $aft;set d
03c0: 6f 6e 65 20 4f 4b 7d 0a 20 20 20 20 20 76 77 61 one OK}. vwa
03d0: 69 74 20 64 6f 6e 65 0a 20 20 20 20 20 69 66 20 it done. if
03e0: 7b 24 64 6f 6e 65 20 21 3d 20 22 4f 4b 22 7d 20 {$done != "OK"}
03f0: 7b 0a 20 20 20 20 20 09 66 63 6f 6e 66 69 67 75 {. .fconfigu
0400: 72 65 20 24 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $f -blocking
0410: 30 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 0..close $f.
0420: 20 7d 20 65 6c 73 65 20 7b 0a 09 69 66 20 7b 5b } else {..if {[
0430: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d catch {close $f}
0440: 20 65 72 72 5d 7d 20 7b 0a 09 20 20 20 20 73 65 err]} {.. se
0450: 74 20 64 6f 6e 65 20 22 51 75 69 63 6b 20 65 78 t done "Quick ex
0460: 69 74 20 6d 69 73 62 65 68 61 76 65 73 3a 20 24 it misbehaves: $
0470: 65 72 72 22 0a 09 7d 0a 20 20 20 20 20 7d 0a 20 err"..}. }.
0480: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 4f set done.} O
0490: 4b 0a 0a 74 65 73 74 20 65 78 69 74 2d 31 2e 32 K..test exit-1.2
04a0: 20 7b 66 75 6c 6c 2d 66 69 6e 61 6c 69 7a 65 64 {full-finalized
04b0: 20 65 78 69 74 7d 20 7b 0a 20 20 20 20 20 73 65 exit} {. se
04c0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 69 6e 74 t f [open "|[int
04d0: 65 72 70 72 65 74 65 72 5d 20 3c 3c 20 5c 22 65 erpreter] << \"e
04e0: 78 65 63 20 5b 69 6e 74 65 72 70 72 65 74 65 72 xec [interpreter
04f0: 5d 20 3c 3c 20 7b 73 65 74 20 3a 3a 65 6e 76 28 ] << {set ::env(
0500: 54 43 4c 5f 46 49 4e 41 4c 49 5a 45 5f 4f 4e 5f TCL_FINALIZE_ON_
0510: 45 58 49 54 29 20 31 3b 65 78 69 74 7d 5c 22 22 EXIT) 1;exit}\""
0520: 20 72 5d 0a 20 20 20 20 20 73 65 74 20 61 66 74 r]. set aft
0530: 20 5b 61 66 74 65 72 20 31 30 30 30 20 7b 73 65 [after 1000 {se
0540: 74 20 64 6f 6e 65 20 22 46 75 6c 6c 2d 66 69 6e t done "Full-fin
0550: 61 6c 69 7a 65 64 20 65 78 69 74 20 68 61 6e 67 alized exit hang
0560: 73 20 21 21 21 22 7d 5d 0a 20 20 20 20 20 66 69 s !!!"}]. fi
0570: 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 leevent $f reada
0580: 62 6c 65 20 7b 61 66 74 65 72 20 63 61 6e 63 65 ble {after cance
0590: 6c 20 24 61 66 74 3b 73 65 74 20 64 6f 6e 65 20 l $aft;set done
05a0: 4f 4b 7d 0a 20 20 20 20 20 76 77 61 69 74 20 64 OK}. vwait d
05b0: 6f 6e 65 0a 20 20 20 20 20 69 66 20 7b 24 64 6f one. if {$do
05c0: 6e 65 20 21 3d 20 22 4f 4b 22 7d 20 7b 0a 20 20 ne != "OK"} {.
05d0: 20 20 20 09 66 63 6f 6e 66 69 67 75 72 65 20 24 .fconfigure $
05e0: 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 63 f -blocking 0..c
05f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 20 7d 20 65 lose $f. } e
0600: 6c 73 65 20 7b 0a 09 69 66 20 7b 5b 63 61 74 63 lse {..if {[catc
0610: 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 65 72 72 h {close $f} err
0620: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 64 6f ]} {.. set do
0630: 6e 65 20 22 46 75 6c 6c 2d 66 69 6e 61 6c 69 7a ne "Full-finaliz
0640: 65 64 20 65 78 69 74 20 6d 69 73 62 65 68 61 76 ed exit misbehav
0650: 65 73 3a 20 24 65 72 72 22 0a 09 7d 0a 20 20 20 es: $err"..}.
0660: 20 20 7d 0a 20 20 20 20 20 73 65 74 20 64 6f 6e }. set don
0670: 65 0a 7d 20 4f 4b 0a 0a 0a 23 20 63 6c 65 61 6e e.} OK...# clean
0680: 75 70 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c up.::tcltest::cl
0690: 65 61 6e 75 70 54 65 73 74 73 0a 72 65 74 75 72 eanupTests.retur
06a0: 6e 0a n.
