# pthread_attr_get_np - "np" meaning "non portable" says it
# all; specific to FreeBSD
# pthread_sigmask - not available on mingw
+ # pthread_cancel - not available on Android (Bionic libc)
#
- AC_CHECK_FUNCS(pthread_attr_getstack pthread_getattr_np pthread_get_stackaddr_np pthread_attr_get_np pthread_sigmask)
+ AC_CHECK_FUNCS([pthread_attr_getstack pthread_getattr_np \
+ pthread_get_stackaddr_np pthread_attr_get_np pthread_sigmask \
+ pthread_cancel])
# On past versions of Solaris, believe 8 through 10 at least, you
# had to write "pthread_once_t foo = { PTHREAD_ONCE_INIT };".
}
#undef FUNC_NAME
+/* Some systems, notably Android, lack 'pthread_cancel'. Don't provide
+ 'cancel-thread' on these systems. */
+
+#if !SCM_USE_PTHREAD_THREADS || defined HAVE_PTHREAD_CANCEL
+
SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
(SCM thread),
"Asynchronously force the target @var{thread} to terminate. @var{thread} "
}
#undef FUNC_NAME
+#endif
+
SCM_DEFINE (scm_set_thread_cleanup_x, "set-thread-cleanup!", 2, 0, 0,
(SCM thread, SCM proc),
"Set the thunk @var{proc} as the cleanup handler for the thread @var{thread}. "
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
-;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright 2003, 2006, 2007, 2009, 2010, 2011, 2012, 2013,
+;;;; 2014 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(equal? '(a b c) '(a b c))
a))
+(define (require-cancel-thread)
+ ;; Skip the test when 'cancel-thread' is unavailable.
+ (unless (defined? 'cancel-thread)
+ (throw 'unresolved)))
+
(if (provided? 'threads)
(begin
(with-test-prefix "join-thread"
(pass-if "timed joining fails if timeout exceeded"
+ (require-cancel-thread)
(let* ((m (make-mutex))
(c (make-condition-variable))
(t (begin-thread (begin (lock-mutex m)
(not r)))
(pass-if "join-thread returns timeoutval on timeout"
+ (require-cancel-thread)
(let* ((m (make-mutex))
(c (make-condition-variable))
(t (begin-thread (begin (lock-mutex m)
(with-test-prefix "cancel-thread"
(pass-if "cancel succeeds"
+ (require-cancel-thread)
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin (lock-mutex m) 'foo))))
#t)))
(pass-if "handler result passed to join"
+ (require-cancel-thread)
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (lock-mutex m))))
(eq? (join-thread t) 'foo))))
(pass-if "can cancel self"
+ (require-cancel-thread)
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin