Overview
| Comment: | Added child reaper based on post to #chicken by andyjpg, it seems to work well |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
2886acdd2f593802d86f8b10dd6a296e |
| User & Date: | matt on 2013-09-11 23:36:14 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-09-12
| ||
| 23:38 | Added exec to nbfake. Changed test4 to do launchwait. Added forced registration of top level tests as not having them is a path to possible escape on silent failure check-in: fd20d22153 user: matt tags: v1.55 | |
|
2013-09-11
| ||
| 23:36 | Added child reaper based on post to #chicken by andyjpg, it seems to work well check-in: 2886acdd2f user: matt tags: v1.55 | |
|
2013-09-10
| ||
| 17:27 | Misc fixes check-in: e5b733b81c user: mrwellan tags: v1.55 | |
Changes
Modified NOTES from [ef843a82ce] to [973eb2f3d1].
|
Modified megatest.scm from [73e9da4e68] to [ab8143b2ea].
| ︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 | + + + + + + + + + + + + + + + + + + |
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")
;; Overall exit handling setup immediately
;;
(let ((original-exit (exit-handler)))
(exit-handler (lambda (#!optional (exit-code 0))
(printf "Preparing to exit with exit code ~A ...\n" exit-code)
(children
(lambda (pid)
(handle-exceptions
exn
#t
(let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
(if (or (eq? pid-val pid)
(eq? pid-val 0))
(begin
(printf "Sending signal/term to ~A\n" pid)
(process-signal pid signal/term)))))))
(original-exit exit-code))))
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(define help (conc "
|
| ︙ |
Modified process.scm from [444a7f5a5f] to [8a2775d2d2].
| ︙ | |||
107 108 109 110 111 112 113 | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | + + + + + + + + + + + + + + + + |
(let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
(if (eq? pid-val 0)
(begin
(thread-sleep! 2)
(loop (+ i 1)))
(values pid-val exit-status exit-code))))))
;;======================================================================
;; MISC PROCESS RELATED STUFF
;;======================================================================
(define (children proc)
(with-input-from-pipe
(conc "ps h --ppid " (current-process-id) " -o pid")
(lambda ()
(let loop ((inl (read-line))
(res '()))
(if (eof-object? inl)
(reverse res)
(let ((pid (string->number inl)))
(if proc (proc pid))
(loop (read-line) (cons pid res))))))))
|