Serving the Web/ServingTheWeb1995.disc1of1.iso/linux/slacksrce/tcl/tcl+tk+t/tclx7.3bl/tclx7/tclX7.3b/tests/signal.test

Text File | 1994-07-16 | 8.5 KB | 320 lines

#
# signal.test
#
# Tests for the signal and kill commands.
#---------------------------------------------------------------------------
# Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: signal.test,v 4.0 1994/07/16 05:25:52 markd Rel $
#------------------------------------------------------------------------------
#

if {[info procs test] != "test"} then {source testlib.tcl}

#
# Fork without exec will not work under Tk, skip this test
#
if ![lempty [info commands button]] {
    puts "*************************************************************"
    puts "Signal tests are constructed in a way that does not work"
    puts "under Tk.  Test skipped."
    puts "*************************************************************"
    puts ""
    return
}

#
# Determine if we have Posix signals.
#
set msg {}
set posix 1
catch {signal unblock SIGHUP} msg
if {$msg == "Posix signals are not available on this system"} {
    set posix 0
}

Test signal-1.1 {signal tests} {
    signal ignore SIGHUP
    kill HUP [id process]
} 0 {}

Test signal-1.2 {signal tests} {
    global errorInfo
    set errorInfo {}
    signal error HUP
    proc KillMe3 {} {kill SIGHUP [id process]}
    proc KillMe2 {} {KillMe3}
    proc KillMe1 {} {KillMe2}
    list [catch {KillMe1} msg] $msg $errorInfo
} 0 {1 {SIGHUP signal received} {SIGHUP signal received
    while executing
"kill SIGHUP [id process]"
    (procedure "KillMe3" line 1)
    invoked from within
"KillMe3"
    (procedure "KillMe2" line 1)
    invoked from within
"KillMe2"
    (procedure "KillMe1" line 1)
    invoked from within
"KillMe1"}}

Test signal-1.3 {signal tests} {
    signal error {HUP SIGTERM}
    set one [list [catch {kill HUP  [id process]} msg] $msg]
    set two [list [catch {kill TERM [id process]} msg] $msg]
    list $one $two
} 0 {{1 {SIGHUP signal received}} {1 {SIGTERM signal received}}}

Test signal-1.4 {signal tests} {
    set signalWeGot {}
    signal trap 1 {set signalWeGot %S}
    kill SIGHUP [id process]
    signal default 1
    set signalWeGot
} 0 {SIGHUP}

Test signal-1.41 {signal tests} {
    set signalWeGot {}
    set signalTrash {}
    signal trap 1 {set signalWeGot %S; set signalTrash "%%"}
    kill SIGHUP [id process]
    signal default 1
    list $signalWeGot $signalTrash
} 0 {SIGHUP %%}

Test signal-1.42 {signal tests} {
    signal trap 1 {set signalWeGot %s; set signalTrash "%%"}
    kill SIGHUP [id process]
} 1 {bad signal trap command formatting specification "%s", expected one of "%%" or "%S"}
signal default SIGHUP

Test signal-1.5 {signal tests} {
    signal default {SIGHUP SIGINT}
    signal get {SIGHUP SIGINT}
} 0 {{SIGHUP {default 0}} {SIGINT {default 0}}}

Test signal-1.6 {signal tests} {
    signal default SIGHUP
    signal ignore  SIGINT
    signal get {SIGHUP SIGINT}
} 0 {{SIGHUP {default 0}} {SIGINT {ignore 0}}}

Test signal-1.7 {signal tests} {
    signal trap {SIGHUP SIGINT} {error "Should not get this signal"}
    signal get {SIGHUP SIGINT}
} 0 [list {SIGHUP {trap 0 {error "Should not get this signal"}}} \
          {SIGINT {trap 0 {error "Should not get this signal"}}} ]

Test signal-1.8 {signal tests} {
    signal error {SIGHUP SIGINT}
    signal get {SIGHUP SIGINT}
} 0 {{SIGHUP {error 0}} {SIGINT {error 0}}}

Test signal-1.8.1 {signal tests} {
    signal error {SIGHUP SIGINT}
    set sigkl [signal get *]
    list [keylget sigkl SIGHUP]  [keylget sigkl SIGINT]
} 0 {{error 0} {error 0}}

Test signal-1.8.2 {signal tests} {
    set sigkl [signal get *]
    list [keylget sigkl SIGALRM {}] [keylget sigkl SIGPIPE {}] \
        [keylget sigkl SIGINT {}]
} 0 {1 1 1}

Test signal-1.8.3 {signal tests} {
    signal error {SIGHUP SIGINT}
    set sigkl [signal get *]
    signal default {SIGHUP SIGINT}
    signal set $sigkl
    signal get {SIGHUP SIGINT}
} 0 {{SIGHUP {error 0}} {SIGINT {error 0}}}

Test signal-1.9 {signal tests} {
    global errorInfo
    set errorInfo {}
    proc KillMe3 {} {kill SIGHUP [id process]}
    proc KillMe2 {} {KillMe3}
    proc KillMe1 {} {KillMe2}
    signal trap SIGHUP {error "Blew it in the trap code"}
    list [catch {KillMe1} msg ] $msg $errorInfo
} 0 {1 {Blew it in the trap code} {Blew it in the trap code
    while executing
"error "Blew it in the trap code""
    while executing signal trap code for SIGHUP signal
    invoked from within
"kill SIGHUP [id process]"
    (procedure "KillMe3" line 1)
    invoked from within
"KillMe3"
    (procedure "KillMe2" line 1)
    invoked from within
"KillMe2"
    (procedure "KillMe1" line 1)
    invoked from within
"KillMe1"}}

Test signal-1.10 {signal tests} {
    signal
} 1 {wrong # args: signal action signalList ?command?}

Test signal-1.11 {signal tests} {
    signal ignore foo
} 1 {invalid signal "foo"}

Test signal-1.12 {signal tests} {
    signal ignore sigint "echo foo"
} 1 {command may not be specified for "ignore" action}

Test signal-1.13 {signal tests} {
    signal baz sigint
} 1 {invalid signal action specified: baz: expected one of "default", "ignore", "error", "trap", "get", "set", "block", or "unblock"}

#
# Complex test for the death of a child.
#

proc PollSigChld {} {
    global G_gotChild
    set sleepCnt 0
    while {!$G_gotChild} {
        incr sleepCnt
        if {$sleepCnt > 90} {
            error "signal-1.14: SIGCHLD lost"
        }
        sleep 1
    }
}


proc ForkChild {exitCode} {
    flush stdout  ;# Not going to exec, must clean up the buffers.
    flush stderr
    set childPid [fork]
    if {$childPid == 0} {
        exit $exitCode
    }
    return $childPid
}

if $posix {
    set expect {123 {{SIGCHLD {trap 0 {global G_gotChild;set G_gotChild 1;sleep 1}}}}}
} else {
    set expect {123 {{SIGCHLD {default 0}}}}
}
set expect
Test signal-1.15 {signal tests} {
    global G_gotChild
    set G_gotChild 0
    signal trap SIGCHLD {global G_gotChild;set G_gotChild 1;sleep 1}
    set pid1 [ForkChild 123]
    PollSigChld
    set status1 [wait $pid1]
    list [lindex $status1 2] [signal get SIGCHLD]
} 0 $expect

signal default SIGCHLD

#
# Check that the signals are left in the correct state after receiving
# a signal (on SIGCHLD is different if we have Posix signals).
#

Test signal-1.16 {signal tests} {
    global G_gotChild
    set G_gotChild 0
    signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
    kill SIGCHLD [id process]
    set gotChild1 $G_gotChild
    set G_gotChild 0
    kill SIGCHLD [id process]
    set gotChild2 $G_gotChild
    set G_gotChild 0
    signal trap SIGCHLD {global G_gotChild;set G_gotChild 1}
    kill SIGCHLD [id process]
    set gotChild3 $G_gotChild
    signal default SIGCHLD
    list $gotChild1 $gotChild2 $gotChild3
} 0 [list 1 $posix 1]


Test signal-1.17 {signal tests} {
    global G_gotPipe
    set G_gotPipe 0
    signal trap SIGPIPE {global G_gotPipe;set G_gotPipe 1}
    kill SIGPIPE [id process]
    set gotPipe1 $G_gotPipe
    set G_gotPipe 0
    kill SIGPIPE [id process]
    set gotPipe2 $G_gotPipe
    signal default SIGPIPE
    list $gotPipe1 $gotPipe2
} 0 {1 1}

if $posix {
    Test signal-1.18 {signal tests} {
        signal error SIGHUP
        signal block SIGHUP
        signal get SIGHUP
    } 0 {{SIGHUP {error 1}}}

    Test signal-1.19 {signal tests} {
        signal unblock SIGHUP
        signal get SIGHUP
    } 0 {{SIGHUP {error 0}}}

    Test signal-1.18 {signal tests} {
        signal block SIGHUP
        signal error SIGHUP
        signal get SIGHUP
    } 0 {{SIGHUP {error 1}}}

    signal unblock SIGHUP
    signal default SIGHUP
}


Test signal-2.1 {kill tests} {
    kill
} 1 {wrong # args: kill ?-pgroup? ?signal? idlist}

signal error SIGINT

Test signal-2.2 {kill tests} {
    kill 2 [id process]
} 1 {SIGINT signal received}

Test signal-2.3 {kill tests} {
    kill INT [id process]
} 1 {SIGINT signal received}

Test signal-2.4 {kill tests} {
    kill SIGINT [id process]
} 1 {SIGINT signal received}

Test signal-2.5 {kill tests} {
    kill 10000 [id process]
} 1 {invalid signal "10000"}

Test signal-2.6 {kill tests} {
    kill SIGFOO [id process]
} 1 {invalid signal "SIGFOO"}

Test signal-2.7 {kill tests} {
    kill 0 [id process]
} 0 {}

Test signal-2.8 {kill tests} {
    set pgrp [ForkLoopingChild 1]
    kill -pgroup SIGKILL $pgrp
    lrange [wait -pgroup $pgrp] 1 2
} 0 {SIG SIGKILL}