## operating system signal routing

fun chk(ok msg) {
	if ok { printf "OK: %s\n" msg } \
	else { printf "ERROR: %s\n" msg }
}

## --- SIGPIPE must not be fatal ---
## with the default disposition, writing to a pipe whose reader has gone kills
## the process outright and no I/O primitive can ever report the condition.
p := (sys.pipe)
r := (core.basicAt p 0)
w := (core.basicAt p 1)
sys.close r
raised := false
try {
	sys.write w (core.basicNew ByteArray 4)
} catch (e) {
	raised := true
}
chk raised "writing to a pipe with no reader raises instead of killing the VM"
sys.close w
## the VM is genuinely still usable afterwards, not merely still alive
q := (sys.pipe)
chk (= (sys.write (core.basicAt q 1) (core.basicNew ByteArray 2)) 2) "I/O still works after SIGPIPE"
sys.close (core.basicAt q 0)
sys.close (core.basicAt q 1)

## --- catch and uncatch are idempotent ---
chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-catch returns the signal number"
chk (= (sys.sig-catch sys.SIGUSR1) sys.SIGUSR1) "catching an already caught signal is fine"
chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "sys.sig-uncatch returns the signal number"
chk (= (sys.sig-uncatch sys.SIGUSR1) sys.SIGUSR1) "uncatching an uncaught signal is fine"

## --- a real signal reaches hak code, without stalling the coprocesses ---
## SIGCHLD is used because a child exiting is something this test can arrange
## on its own, with no outside help.
sys.sig-catch sys.SIGCHLD

h     := (sys.sig-getfd)
s     := (core.sem-new)
tmo   := (core.sem-new)
sg    := (core.semgr-new)
core.semgr-add sg s
core.semgr-add sg tmo
fin   := (core.sem-new)
ticks := 0
signo := -1

pr   := (sys.popen "sleep 1; exit 4" "r")
proc := (core.basicAt pr 0)

fun waiter() {
	| w |
	core.sem-signal tmo 20 0
	core.sem-signal-on-input s h
	w := (core.semgr-wait sg)
	core.sem-unsignal s
	core.sem-unsignal tmo
	if (eqv? w tmo) { signo := -2 } \
	else { signo := (sys.sig-get) }
	core.sem-signal fin
	return 0
}

fun ticker() {
	## the waiter is parked on the signal descriptor by now
	while (< ticks 4) {
		ticks := (+ ticks 1)
		core.yield
	}
}

core.fork waiter
core.fork ticker
core.sem-wait fin

chk (= ticks 4) "coprocesses ran while a coprocess waited on a signal"
chk (= signo sys.SIGCHLD) "the signal number came through the signal descriptor"
chk (= (sys.pwait proc) 4) "and the child's exit status is readable"
sys.pclose proc
sys.sig-uncatch sys.SIGCHLD