mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

build: Support pthread builds without 'pthread_cancel' support (Android).

Browse source 
Reported by Sylvain Beucler <beuc@beuc.net>.

* configure.ac: Check for 'pthread_cancel'.
* libguile/threads.c (scm_cancel_thread): Conditionalize on
  !SCM_USE_PTHREAD_THREADS || defined HAVE_PTHREAD_CANCEL.
* test-suite/tests/threads.test (require-cancel-thread): New procedure.
  ("timed joining fails if timeout exceeded", "join-thread returns
  timeoutval on timeout", "cancel succeeds", "handler result passed to
  join", "can cancel self"): Use it.
This commit is contained in:
Ludovic Courtès 2014-07-04 15:52:15 +02:00
parent 8c75d3ae01
commit f184e887a6
3 changed files with 23 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
configure.ac
View file

@ -1371,8 +1371,11 @@ case "$with_threads" in
# 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 };".

7
libguile/threads.c
View file

@ -1156,6 +1156,11 @@ SCM_DEFINE (scm_yield, "yield", 0, 0, 0,
}
#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} "
@ -1181,6 +1186,8 @@ SCM_DEFINE (scm_cancel_thread, "cancel-thread", 1, 0, 0,
}
#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}. "

13
test-suite/tests/threads.test
View file

@ -1,6 +1,7 @@
;;;; 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
@ -36,6 +37,11 @@
(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
@ -277,6 +283,7 @@
(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)
@ -286,6 +293,7 @@
(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)
@ -335,6 +343,7 @@
(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))))
@ -343,6 +352,7 @@
#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))))
@ -351,6 +361,7 @@
(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