qa-setsig

   1 #!/usr/bin/newlisp
   2 #
   3 # check out customized signal handlers
   4 #
   5 # USAGE: qa-setsig <low-bound> <high-bound>
   6 #
   7 # example: qa-setsig 1 8
   8 #
   9 # checks all signals between 1 and 8
  10 #
  11 # run without arguments for testing 1-8, 10-16
  12 #
  13 # USAGE: qa-setsig
  14 #
  15
  16 (set 'opsys (& 0xF ((sys-info) -1)))
  17
  18 (set 'library (if
  19   (= opsys 1) "libc.so.6" ;; Linux
  20   (= opsys 2) "libc.so"        ;; FreeBSD
  21   (= opsys 3) "libc.dylib"     ;; Mac OSX
  22   (= opsys 4) "libc.so"))      ;; Solaris
  23
  24 (if (not library)
  25         (begin
  26                 (println "Cannot run qa-signal on this platform")
  27                 (exit)))
  28
  29 (import library "getpid")
  30 (import library "kill")
  31
  32 (set 'low (int (main-args 2)))
  33 (set 'high (int (main-args 3)))
  34 (set 'pid (getpid))
  35
  36 (if low
  37         (println "low=" low " hight=" high " pid=" pid))
  38
  39 (define (alarm sig)
  40         (if (= sig high) (set 'done true))
  41         (print "sig-" sig " ")
  42         (push sig result-list -1)
  43 )
  44
  45 (if (and low high)
  46         (set 'sig-list (sequence low high))
  47         (set 'sig-list (append (sequence 1 8) (sequence 10 16))))
  48
  49 (set 'high (last sig-list))
  50
  51 (dolist (s sig-list) (signal s 'alarm))
  52
  53
  54 (fork (begin
  55                 (dolist (s sig-list)
  56                         (sleep 200)
  57                         (kill pid (int s)))
  58                 (sleep 200)
  59 ;               (kill pid 9)
  60 ))
  61
  62 (println)
  63 (while (not done)  (print ".") (sleep 100))
  64 (println)
  65 (println "sent: " sig-list)
  66 (println "received: " result-list)
  67 (if (= result-list sig-list)
  68         (println "signal testing OK")
  69         (println "ERROR: problem in signal testing"))
  70
  71 (println)
  72 (exit)