home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tests / signal.test < prev    next >
Encoding:
Text File  |  1994-01-23  |  8.0 KB  |  300 lines
  1. #
  2. # signal.test
  3. #
  4. # Tests for the signal and kill commands.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: signal.test,v 3.1 1994/01/23 16:58:20 markd Exp $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. #
  22. # Fork without exec will not work under Tk, skip this test
  23. #
  24. if ![lempty [info commands button]] {
  25.     puts stderr "*************************************************************"
  26.     puts stderr "Signal tests are constructed in a way that does not work"
  27.     puts stderr "under Tk.  Test skipped."
  28.     puts stderr "*************************************************************"
  29.     puts stderr ""
  30.     return
  31. }
  32.  
  33. #
  34. # Determine if we have Posix signals.
  35. #
  36. set msg {}
  37. set posix 1
  38. catch {signal unblock SIGHUP} msg
  39. if {$msg == "Posix signals are not available on this system"} {
  40.     set posix 0
  41. }
  42.  
  43. Test signal-1.1 {signal tests} {
  44.     signal ignore SIGHUP
  45.     kill HUP [id process]
  46. } 0 {}
  47.  
  48. Test signal-1.2 {signal tests} {
  49.     global errorInfo
  50.     set errorInfo {}
  51.     signal error HUP
  52.     proc KillMe3 {} {kill SIGHUP [id process]}
  53.     proc KillMe2 {} {KillMe3}
  54.     proc KillMe1 {} {KillMe2}
  55.     list [catch {KillMe1} msg] $msg $errorInfo
  56. } 0 {1 {SIGHUP signal received} {SIGHUP signal received
  57.     while executing
  58. "kill SIGHUP [id process]"
  59.     (procedure "KillMe3" line 1)
  60.     invoked from within
  61. "KillMe3"
  62.     (procedure "KillMe2" line 1)
  63.     invoked from within
  64. "KillMe2"
  65.     (procedure "KillMe1" line 1)
  66.     invoked from within
  67. "KillMe1"}}
  68.  
  69. Test signal-1.3 {signal tests} {
  70.     signal error {HUP SIGTERM}
  71.     set one [list [catch {kill HUP  [id process]} msg] $msg]
  72.     set two [list [catch {kill TERM [id process]} msg] $msg]
  73.     list $one $two
  74. } 0 {{1 {SIGHUP signal received}} {1 {SIGTERM signal received}}}
  75.  
  76. Test signal-1.4 {signal tests} {
  77.     set signalWeGot {}
  78.     signal trap 1 {set signalWeGot %S}
  79.     kill SIGHUP [id process]
  80.     signal default 1
  81.     set signalWeGot
  82. } 0 {SIGHUP}
  83.  
  84. Test signal-1.41 {signal tests} {
  85.     set signalWeGot {}
  86.     set signalTrash {}
  87.     signal trap 1 {set signalWeGot %S; set signalTrash "%%"}
  88.     kill SIGHUP [id process]
  89.     signal default 1
  90.     list $signalWeGot $signalTrash
  91. } 0 {SIGHUP %%}
  92.  
  93. Test signal-1.42 {signal tests} {
  94.     signal trap 1 {set signalWeGot %s; set signalTrash "%%"}
  95.     kill SIGHUP [id process]
  96. } 1 {bad signal trap command formatting specification "%s", expected one of "%%" or "%S"}
  97. signal default SIGHUP
  98.  
  99. Test signal-1.5 {signal tests} {
  100.     signal default {SIGHUP SIGINT}
  101.     signal get {SIGHUP SIGINT}
  102. } 0 {{SIGHUP {default 0}} {SIGINT {default 0}}}
  103.  
  104. Test signal-1.6 {signal tests} {
  105.     signal default SIGHUP
  106.     signal ignore  SIGINT
  107.     signal get {SIGHUP SIGINT}
  108. } 0 {{SIGHUP {default 0}} {SIGINT {ignore 0}}}
  109.  
  110. Test signal-1.7 {signal tests} {
  111.     signal trap {SIGHUP SIGINT} {error "Should not get this signal"}
  112.     signal get {SIGHUP SIGINT}
  113. } 0 [list {SIGHUP {trap 0 {error "Should not get this signal"}}} \
  114.           {SIGINT {trap 0 {error "Should not get this signal"}}} ]
  115.  
  116. Test signal-1.8 {signal tests} {
  117.     signal error {SIGHUP SIGINT}
  118.     signal get {SIGHUP SIGINT}
  119. } 0 {{SIGHUP {error 0}} {SIGINT {error 0}}}
  120.  
  121. Test signal-1.9 {signal tests} {
  122.     global errorInfo
  123.     set errorInfo {}
  124.     proc KillMe3 {} {kill SIGHUP [id process]}
  125.     proc KillMe2 {} {KillMe3}
  126.     proc KillMe1 {} {KillMe2}
  127.     signal trap SIGHUP {error "Blew it in the trap code"}
  128.     list [catch {KillMe1} msg ] $msg $errorInfo
  129. } 0 {1 {Blew it in the trap code} {Blew it in the trap code
  130.     while executing
  131. "error "Blew it in the trap code""
  132.     while executing signal trap code for SIGHUP signal
  133.     invoked from within
  134. "kill SIGHUP [id process]"
  135.     (procedure "KillMe3" line 1)
  136.     invoked from within
  137. "KillMe3"
  138.     (procedure "KillMe2" line 1)
  139.     invoked from within
  140. "KillMe2"
  141.     (procedure "KillMe1" line 1)
  142.     invoked from within
  143. "KillMe1"}}
  144.  
  145. Test signal-1.10 {signal tests} {
  146.     signal
  147. } 1 {wrong # args: signal action signalList ?command?}
  148.  
  149. Test signal-1.11 {signal tests} {
  150.     signal ignore foo
  151. } 1 {invalid signal name: foo}
  152.  
  153. Test signal-1.12 {signal tests} {
  154.     signal ignore sigint "echo foo"
  155. } 1 {command may not be specified for "ignore" action}
  156.  
  157. Test signal-1.13 {signal tests} {
  158.     signal baz sigint
  159. } 1 {invalid signal action specified: baz: expected one of "default", "ignore", "error", "trap", or "get", "block", "unblock"}
  160.  
  161. #
  162. # Complex test for the death of a child.
  163. #
  164.  
  165. proc PollSigChld {} {
  166.     global G_gotChild
  167.     set sleepCnt 0
  168.     while {!$G_gotChild} {
  169.         incr sleepCnt
  170.         if {$sleepCnt > 90} {
  171.             error "signal-1.14: SIGCHLD lost"
  172.         }
  173.         sleep 1
  174.     }
  175. }
  176.  
  177.  
  178. proc ForkChild {exitCode} {
  179.     flush stdout  ;# Not going to exec, must clean up the buffers.
  180.     flush stderr
  181.     set childPid [fork]
  182.     if {$childPid == 0} {
  183.         exit $exitCode
  184.     }
  185.     return $childPid
  186. }
  187.  
  188. if $posix {
  189.     set expect {123 {{SIGCHLD {trap 0 {global G_gotChild;set G_gotChild 1;sleep 1}}}}}
  190. } else {
  191.     set expect {123 {{SIGCHLD {default 0}}}}
  192. }
  193. set expect 
  194. Test signal-1.15 {signal tests} {
  195.     global G_gotChild
  196.     set G_gotChild 0
  197.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1;sleep 1}
  198.     set pid1 [ForkChild 123] 
  199.     PollSigChld
  200.     set status1 [wait $pid1]
  201.     list [lindex $status1 2] [signal get SIGCHLD]
  202. } 0 $expect
  203.  
  204. signal default SIGCHLD
  205.  
  206. #
  207. # Check that the signals are left in the correct state after receiving
  208. # a signal (on SIGCHLD is different if we have Posix signals).
  209. #
  210.  
  211. Test signal-1.16 {signal tests} {
  212.     global G_gotChild
  213.     set G_gotChild 0
  214.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
  215.     kill SIGCHLD [id process]
  216.     set gotChild1 $G_gotChild
  217.     set G_gotChild 0
  218.     kill SIGCHLD [id process]
  219.     set gotChild2 $G_gotChild
  220.     set G_gotChild 0
  221.     signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
  222.     kill SIGCHLD [id process]
  223.     set gotChild3 $G_gotChild
  224.     signal default SIGCHLD
  225.     list $gotChild1 $gotChild2 $gotChild3
  226. } 0 [list 1 $posix 1]
  227.  
  228.  
  229. Test signal-1.17 {signal tests} {
  230.     global G_gotPipe
  231.     set G_gotPipe 0
  232.     signal trap SIGPIPE {global G_gotPipe;set G_gotPipe 1}
  233.     kill SIGPIPE [id process]
  234.     set gotPipe1 $G_gotPipe
  235.     set G_gotPipe 0
  236.     kill SIGPIPE [id process]
  237.     set gotPipe2 $G_gotPipe
  238.     signal default SIGPIPE
  239.     list $gotPipe1 $gotPipe2
  240. } 0 {1 1}
  241.  
  242. if $posix {
  243.     Test signal-1.18 {signal tests} {
  244.         signal error SIGHUP
  245.         signal block SIGHUP
  246.         signal get SIGHUP
  247.     } 0 {{SIGHUP {error 1}}}
  248.  
  249.     Test signal-1.19 {signal tests} {
  250.         signal unblock SIGHUP
  251.         signal get SIGHUP
  252.     } 0 {{SIGHUP {error 0}}}
  253.  
  254.     Test signal-1.18 {signal tests} {
  255.         signal block SIGHUP
  256.         signal error SIGHUP
  257.         signal get SIGHUP
  258.     } 0 {{SIGHUP {error 1}}}
  259.  
  260.     signal unblock SIGHUP
  261.     signal default SIGHUP
  262. }
  263.  
  264.  
  265. Test signal-2.1 {kill tests} {
  266.     kill
  267. } 1 {wrong # args: kill ?-pgroup? ?signal? idlist}
  268.  
  269. signal error SIGINT
  270.  
  271. Test signal-2.2 {kill tests} {
  272.     kill 2 [id process]
  273. } 1 {SIGINT signal received}
  274.  
  275. Test signal-2.3 {kill tests} {
  276.     kill INT [id process]
  277. } 1 {SIGINT signal received}
  278.  
  279. Test signal-2.4 {kill tests} {
  280.     kill SIGINT [id process]
  281. } 1 {SIGINT signal received}
  282.  
  283. Test signal-2.5 {kill tests} {
  284.     kill 10000 [id process]
  285. } 1 {invalid signal}
  286.  
  287. Test signal-2.6 {kill tests} {
  288.     kill SIGFOO [id process]
  289. } 1 {invalid signal}
  290.  
  291. Test signal-2.7 {kill tests} {
  292.     kill 0 [id process]
  293. } 0 {}
  294.  
  295. Test signal-2.8 {kill tests} {
  296.     set pgrp [ForkLoopingChild 1]
  297.     kill -pgroup SIGKILL $pgrp
  298.     lrange [wait -pgroup $pgrp] 1 2
  299. } 0 {SIG SIGKILL}
  300.