Raymond Toy pushed to branch master at cmucl / cmucl Commits: e5777ecb by Raymond Toy at 2016-11-28T20:29:33-08:00 Fix #26: Use nanosleep to sleep lisp/os-common.c: o Implement os_sleep(double) to sleep for the given number of seconds. Uses nanosleep on all platforms to sleep, taking care to sleep more if nanosleep was interrupted. code/lispinit.lisp: code/multi-proc.lisp: o Use the new os_sleep function to sleep for the requested amount of time. - - - - - 05585b8d by Raymond Toy at 2016-11-28T21:05:02-08:00 Minor cosmetic tweaks o Include math.h before netdb.h (from Carl) o Use ceil instead of trunc and add comment on why. o Conform to cmucl style. - - - - - 9e99edb8 by Raymond Toy at 2016-11-28T21:14:27-08:00 Add test for issue 26 Basically used the repro case from the issue. - - - - - f09db6e5 by Raymond Toy at 2016-11-28T22:14:26-08:00 Solaris needs -lrt library to get nanosleep. - - - - - 1aae3ef9 by Raymond Toy at 2016-11-29T19:01:54-08:00 Verify the process ran and exited successfully - - - - - 260c0e45 by Raymond Toy at 2016-11-29T19:03:17-08:00 Adjust comment - - - - - fb864a9b by Raymond Toy at 2016-11-30T19:53:44-08:00 Fix merge conflicts with master - - - - - 8743d581 by Raymond Toy at 2016-11-30T19:53:57-08:00 Fix merge conflicts - - - - - 5f7c4fea by Raymond Toy at 2016-12-02T03:37:16+00:00 Merge branch 'rtoy-issue-26' into 'master' Fix #26: Use nanosleep to sleep without being interrupted First, use nanosleep to sleep instead of using select. Then handle the case of nanosleep being interrupted wherein we keep calling nanosleep with the remaining time until the desired time has elapsed. See merge request !17 - - - - - 5 changed files: - src/code/lispinit.lisp - src/code/multi-proc.lisp - src/lisp/Config.sparc_common - src/lisp/os-common.c - tests/issues.lisp Changes: ===================================== src/code/lispinit.lisp ===================================== --- a/src/code/lispinit.lisp +++ b/src/code/lispinit.lisp @@ -515,12 +515,9 @@ :format-arguments (list n) :datum n :expected-type '(real 0))) - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac) (truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil)  ;;;; SCRUB-CONTROL-STACK ===================================== src/code/multi-proc.lisp ===================================== --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1643,12 +1643,9 @@ ;; Can't call process-wait if the scheduling is inhibited. *inhibit-scheduling*) ;; The initial-process may block. - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac)(truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil) (t (process-wait-with-timeout "Sleep" n (constantly nil))))) ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -48,5 +48,5 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c elf.c -OS_LIBS= -lsocket -lnsl -ldl +OS_LIBS= -lsocket -lnsl -ldl -lrt EXEC_FINAL_OBJ = exec-final.o ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -6,9 +6,11 @@ */ #include <errno.h> +#include <math.h> #include <netdb.h> #include <stdio.h> #include <string.h> +#include <time.h> #include "os.h" #include "internals.h" @@ -562,3 +564,27 @@ int ieee754_rem_pio2(double x, double *y0, double *y1) return n; } + +/* + * sleep for the given number of seconds, even if we're interrupted. + */ +void +os_sleep(double seconds) +{ + struct timespec requested; + struct timespec remaining; + double integral; + double fractional; + + fractional = modf(seconds, &integral); + requested.tv_sec = (time_t) integral; + /* + * Round up---better to sleep slightly too long than to sleep for + * too short a time. + */ + requested.tv_nsec = (long) ceil(fractional * 1e9); + + while (nanosleep(&requested, &remaining) == -1 && errno == EINTR) { + requested = remaining; + } +} ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -352,3 +352,18 @@ (:tag :issues) (loop for k from 1 to 24 do (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) + +(define-test issue.26 + (:tag :issues) + (let ((start-time (get-universal-time))) + (let ((p (ext:run-program "/usr/bin/env" '("sleep" "1") :wait nil))) + (sleep 5) + ;; For this test to be valid, the process must have finished + ;; with a successful exit. + (assert-true (eq (ext:process-status p) :exited)) + (assert-true (zerop (ext:process-exit-code p))) + + ;; We expect to have slept for at least 5 sec, but since + ;; get-universal-time only has an accuracy of 1 sec, just verify + ;; more than 3 sec have elapsed. + (assert-true (>= (- (get-universal-time) start-time) 3))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0e172b4b2d6dc5a6dd016c080...