mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-22 19:44:10 +02:00
Code Activity

Merge commit '2e77f7202b' into boehm-demers-weiser-gc

Browse source 
Conflicts:
	libguile/threads.c
This commit is contained in:
Ludovic Courtès 2008-09-10 22:51:46 +02:00
commit e0513d4d77
20 changed files with 1120 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

22
test-suite/ChangeLog
View file

@ -1,3 +1,25 @@
2007-10-20 Julian Graham <joolean@gmail.com>
* tests/threads.test: Use proper `define-module'.
(cancel-thread, handler result passed to join, can cancel self,
handler supplants final expr, remove handler by setting false,
initial handler is false): New tests.
2007-10-17 Ludovic Courtès <ludo@gnu.org>
* tests/reader.test (reading)[CR recognized as a token
delimiter]: New test.
2007-10-10 Ludovic Courtès <ludo@gnu.org>
* standalone/test-conversion.c: Include <inttypes.h> where
available. Use `PRIiMAX' and `PRIuMAX' to print
`scm_t_u?intmax'. Fixes warnings on x86_64. Reported by Poor
Yorick <org.gnu.lists.guile-user@pooryorick.com>.
* standalone/Makefile.am (test_cflags): Removed reference to
`libguile-ltdl'.
2007-09-03 Ludovic Courtès <ludo@gnu.org>
* tests/reader.test (reading)[block comment finishing sexp]: New

4
test-suite/standalone/Makefile.am
View file

@ -1,6 +1,6 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright 2003, 2004, 2005, 2006 Software Foundation, Inc.
## Copyright 2003, 2004, 2005, 2006, 2007 Software Foundation, Inc.
##
## This file is part of GUILE.
##
@ -32,7 +32,7 @@ TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env"
test_cflags = \
-I$(top_srcdir)/test-suite/standalone \
-I$(top_srcdir) \
-I$(top_srcdir)/libguile-ltdl $(EXTRA_DEFS) $(GUILE_CFLAGS)
$(EXTRA_DEFS) $(GUILE_CFLAGS)
AM_LDFLAGS = $(GUILE_CFLAGS)

54
test-suite/standalone/test-conversion.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1999,2000,2001,2003,2004, 2006 Free Software Foundation, Inc.
/* Copyright (C) 1999,2000,2001,2003,2004, 2006, 2007 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
@ -21,6 +21,21 @@
#include <assert.h>
#include <string.h>
#include "config.h"
#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
#elif (!defined PRIiMAX)
# if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8)
# define PRIiMAX "lli"
# define PRIuMAX "llu"
# else
# define PRIiMAX "li"
# define PRIuMAX "lu"
# endif
#endif
static void
test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
int result)
@ -28,7 +43,8 @@ test_1 (const char *str, scm_t_intmax min, scm_t_intmax max,
int r = scm_is_signed_integer (scm_c_eval_string (str), min, max);
if (r != result)
{
fprintf (stderr, "fail: scm_is_signed_integer (%s, %Ld, %Ld) == %d\n",
fprintf (stderr, "fail: scm_is_signed_integer (%s, "
"%" PRIiMAX ", %" PRIiMAX ") == %d\n",
str, min, max, result);
exit (1);
}
@ -113,7 +129,8 @@ test_2 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
int r = scm_is_unsigned_integer (scm_c_eval_string (str), min, max);
if (r != result)
{
fprintf (stderr, "fail: scm_is_unsigned_integer (%s, %Lu, %Lu) == %d\n",
fprintf (stderr, "fail: scm_is_unsigned_integer (%s, "
"%" PRIuMAX ", %" PRIuMAX ") == %d\n",
str, min, max, result);
exit (1);
}
@ -233,7 +250,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
out_of_range_handler, NULL)))
{
fprintf (stderr,
"fail: scm_to_signed_int (%s, %Ld, %Ld) -> out of range\n",
"fail: scm_to_signed_int (%s, "
"%" PRIiMAX ", %" PRIiMAX ") -> out of range\n",
str, min, max);
exit (1);
}
@ -245,7 +263,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
wrong_type_handler, NULL)))
{
fprintf (stderr,
"fail: scm_to_signed_int (%s, %Ld, %Ld) -> wrong type\n",
"fail: scm_to_signed_int (%s, "
"%" PRIiMAX", %" PRIiMAX ") -> wrong type\n",
str, min, max);
exit (1);
}
@ -258,7 +277,8 @@ test_3 (const char *str, scm_t_intmax min, scm_t_intmax max,
|| data.result != result)
{
fprintf (stderr,
"fail: scm_to_signed_int (%s, %Ld, %Ld) = %Ld\n",
"fail: scm_to_signed_int (%s, "
"%" PRIiMAX ", %" PRIiMAX ") = %" PRIiMAX "\n",
str, min, max, result);
exit (1);
}
@ -365,7 +385,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
out_of_range_handler, NULL)))
{
fprintf (stderr,
"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> out of range\n",
"fail: scm_to_unsigned_int (%s, "
"%" PRIuMAX ", %" PRIuMAX ") -> out of range\n",
str, min, max);
exit (1);
}
@ -377,7 +398,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
wrong_type_handler, NULL)))
{
fprintf (stderr,
"fail: scm_to_unsigned_int (%s, %Lu, %Lu) -> wrong type\n",
"fail: scm_to_unsigned_int (%s, "
"%" PRIuMAX ", %" PRIuMAX ") -> wrong type\n",
str, min, max);
exit (1);
}
@ -390,7 +412,8 @@ test_4 (const char *str, scm_t_uintmax min, scm_t_uintmax max,
|| data.result != result)
{
fprintf (stderr,
"fail: scm_to_unsigned_int (%s, %Lu, %Lu) == %Lu\n",
"fail: scm_to_unsigned_int (%s, "
"%" PRIuMAX ", %" PRIuMAX ") == %" PRIuMAX "\n",
str, min, max, result);
exit (1);
}
@ -446,7 +469,7 @@ test_5 (scm_t_intmax val, const char *result)
SCM res = scm_c_eval_string (result);
if (scm_is_false (scm_equal_p (scm_from_signed_integer (val), res)))
{
fprintf (stderr, "fail: scm_from_signed_integer (%Ld) == %s\n",
fprintf (stderr, "fail: scm_from_signed_integer (%" PRIiMAX ") == %s\n",
val, result);
exit (1);
}
@ -478,7 +501,8 @@ test_6 (scm_t_uintmax val, const char *result)
SCM res = scm_c_eval_string (result);
if (scm_is_false (scm_equal_p (scm_from_unsigned_integer (val), res)))
{
fprintf (stderr, "fail: scm_from_unsigned_integer (%Lu) == %s\n",
fprintf (stderr, "fail: scm_from_unsigned_integer (%"
PRIuMAX ") == %s\n",
val, result);
exit (1);
}
@ -507,7 +531,7 @@ test_7s (SCM n, scm_t_intmax c_n, const char *result, const char *func)
if (scm_is_false (scm_equal_p (n, r)))
{
fprintf (stderr, "fail: %s (%Ld) == %s\n", func, c_n, result);
fprintf (stderr, "fail: %s (%" PRIiMAX ") == %s\n", func, c_n, result);
exit (1);
}
}
@ -521,7 +545,7 @@ test_7u (SCM n, scm_t_uintmax c_n, const char *result, const char *func)
if (scm_is_false (scm_equal_p (n, r)))
{
fprintf (stderr, "fail: %s (%Lu) == %s\n", func, c_n, result);
fprintf (stderr, "fail: %s (%" PRIuMAX ") == %s\n", func, c_n, result);
exit (1);
}
}
@ -580,7 +604,7 @@ test_8s (const char *str, scm_t_intmax (*func) (SCM), const char *func_name,
|| data.result != result)
{
fprintf (stderr,
"fail: %s (%s) = %Ld\n", func_name, str, result);
"fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
exit (1);
}
}
@ -638,7 +662,7 @@ test_8u (const char *str, scm_t_uintmax (*func) (SCM), const char *func_name,
|| data.result != result)
{
fprintf (stderr,
"fail: %s (%s) = %Ld\n", func_name, str, result);
"fail: %s (%s) = %" PRIiMAX "\n", func_name, str, result);
exit (1);
}
}

6
test-suite/tests/reader.test
View file

@ -84,7 +84,11 @@
(pass-if "unprintable symbol"
;; The reader tolerates unprintable characters for symbols.
(equal? (string->symbol "\001\002\003")
(read-string "\001\002\003"))))
(read-string "\001\002\003")))
(pass-if "CR recognized as a token delimiter"
;; In 1.8.3, character 0x0d was not recognized as a delimiter.
(equal? (read-string "one\x0dtwo") 'one)))
(pass-if-exception "radix passed to number->string can't be zero"

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

@ -1,6 +1,6 @@
;;;; threads.test --- Tests for Guile threading. -*- scheme -*-
;;;;
;;;; Copyright 2003, 2006 Free Software Foundation, Inc.
;;;; Copyright 2003, 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -17,8 +17,10 @@
;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;;;; Boston, MA 02110-1301 USA
(use-modules (ice-9 threads)
(test-suite lib))
(define-module (test-threads)
:use-module (ice-9 threads)
:use-module (test-suite lib))
(if (provided? 'threads)
(begin
@ -133,4 +135,54 @@
(lambda (n) (set! result (cons n result)))
(lambda (n) (* 2 n))
'(0 1 2 3 4 5))
(equal? result '(10 8 6 4 2 0)))))))
(equal? result '(10 8 6 4 2 0)))))
;;
;; thread cancellation
;;
(with-test-prefix "cancel-thread"
(pass-if "cancel succeeds"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin (lock-mutex m) 'foo))))
(cancel-thread t)
(join-thread t)
#t)))
(pass-if "handler result passed to join"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (lock-mutex m))))
(set-thread-cleanup! t (lambda () 'foo))
(cancel-thread t)
(eq? (join-thread t) 'foo))))
(pass-if "can cancel self"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (begin
(set-thread-cleanup! (current-thread)
(lambda () 'foo))
(cancel-thread (current-thread))
(lock-mutex m)))))
(eq? (join-thread t) 'foo))))
(pass-if "handler supplants final expr"
(let ((t (begin-thread (begin (set-thread-cleanup! (current-thread)
(lambda () 'bar))
'foo))))
(eq? (join-thread t) 'bar)))
(pass-if "remove handler by setting false"
(let ((m (make-mutex)))
(lock-mutex m)
(let ((t (begin-thread (lock-mutex m) 'bar)))
(set-thread-cleanup! t (lambda () 'foo))
(set-thread-cleanup! t #f)
(unlock-mutex m)
(eq? (join-thread t) 'bar))))
(pass-if "initial handler is false"
(not (thread-cleanup (current-thread)))))))