[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-711-g8051cf2
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-711-g8051cf2 |
|
Date: |
Sat, 08 Feb 2014 14:32:41 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=8051cf23044e5dbbece0d328102197a04ce5718d
The branch, master has been updated
via 8051cf23044e5dbbece0d328102197a04ce5718d (commit)
via 54f17b7b597a3695a25babac92255ed52fbeec4a (commit)
via c8b7b0dad33d6221682c5f49b7635d8de7e15bab (commit)
via 12b8487d5d7272ae5bda62477df60d3e795aa645 (commit)
via adf06a72d53821d34e14fa69b20b10e2f809f593 (commit)
via 04023cceb7584810005906b86c876d703a0e98b5 (commit)
via d4a5776ac5fd39fc65100d626ca3c147ca3dc2c2 (commit)
via 5fc051babef5ea07cf48c02c31ef729344639f9a (commit)
via 730639e9a7bca966c6e884ec47b3166544767f2f (commit)
via fb7dd00169304a5922838e4d2f25253640a35def (commit)
via dc65b88d839c326889618112c4870ad3a64e9446 (commit)
via b9b88351ea2c4b43a6f90938554dc5693b17e328 (commit)
via 0ce224594ae5a673f6a397c284db5f5a61935334 (commit)
via 495cea0c931de23f074892b3f32808e676712a18 (commit)
via b86069c1308a6ca36f3a3bc56134b3f8fd693592 (commit)
via 54cded99dc5db94b1df0dc417161ebef7c60d874 (commit)
via 2f3b7e9a41677bfe802e8a1ee851827297384c58 (commit)
via 85d3339d7e11c861e64bf2a4131fea8666ad8340 (commit)
via b5f9ba49db8e1ced6d70833b8104a266764a6537 (commit)
via a675a2e81b792b9f860bec57c38a1948631c7a41 (commit)
from 5bc7c6dbab302c8ac991dfd2c3b254ff3524ba65 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 8051cf23044e5dbbece0d328102197a04ce5718d
Merge: 54f17b7 fb7dd00
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 15:31:37 2014 +0100
Merge commit 'fb7dd00169304a5922838e4d2f25253640a35def'
This commit also renames uniform-vector-element-type-code to
array-type-code.
Conflicts:
libguile/uniform.c
libguile/uniform.h
test-suite/tests/arrays.test
commit 54f17b7b597a3695a25babac92255ed52fbeec4a
Merge: c8b7b0d dc65b88
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:56:16 2014 +0100
Merge commit 'dc65b88d839c326889618112c4870ad3a64e9446'
Conflicts:
libguile/srfi-4.c
commit c8b7b0dad33d6221682c5f49b7635d8de7e15bab
Merge: 12b8487 b9b8835
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:55:16 2014 +0100
Merge commit 'b9b88351ea2c4b43a6f90938554dc5693b17e328'
Conflicts:
libguile/deprecated.h
test-suite/tests/00-socket.test
commit 12b8487d5d7272ae5bda62477df60d3e795aa645
Merge: adf06a7 0ce2245
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:48:56 2014 +0100
Merge commit '0ce224594ae5a673f6a397c284db5f5a61935334'
commit adf06a72d53821d34e14fa69b20b10e2f809f593
Merge: 04023cc 495cea0
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:48:48 2014 +0100
Merge commit '495cea0c931de23f074892b3f32808e676712a18'
Conflicts:
libguile/weaks.c
commit 04023cceb7584810005906b86c876d703a0e98b5
Merge: d4a5776 b86069c
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:46:31 2014 +0100
Merge commit 'b86069c1308a6ca36f3a3bc56134b3f8fd693592'
Conflicts:
libguile/hashtab.c
commit d4a5776ac5fd39fc65100d626ca3c147ca3dc2c2
Merge: 5fc051b 54cded9
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:44:23 2014 +0100
Merge commit '54cded99dc5db94b1df0dc417161ebef7c60d874'
commit 5fc051babef5ea07cf48c02c31ef729344639f9a
Merge: 730639e 2f3b7e9
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:44:11 2014 +0100
Merge commit '2f3b7e9a41677bfe802e8a1ee851827297384c58'
Conflicts:
module/ice-9/pretty-print.scm
commit 730639e9a7bca966c6e884ec47b3166544767f2f
Merge: 5bc7c6d a675a2e
Author: Andy Wingo <address@hidden>
Date: Sat Feb 8 14:31:42 2014 +0100
Merge commit 'a675a2e81b792b9f860bec57c38a1948631c7a41'
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-foreign.texi | 12 +--
doc/ref/api-memory.texi | 12 +--
doc/ref/posix.texi | 51 +---------
doc/ref/srfi-modules.texi | 60 -----------
libguile/generalized-arrays.c | 20 ++++-
libguile/generalized-arrays.h | 3 +-
libguile/socket.c | 46 +--------
libguile/socket.h | 6 +-
libguile/srfi-4.c | 68 +++++--------
libguile/uniform.c | 172 -------------------------------
libguile/uniform.h | 29 +-----
libguile/weak-table.c | 4 +-
libguile/weak-vector.c | 4 +-
module/ice-9/pretty-print.scm | 11 +-
module/srfi/srfi-4.scm | 27 +-----
module/srfi/srfi-4/gnu.scm | 45 +--------
module/system/vm/assembler.scm | 24 +++--
test-suite/guile-test | 8 +-
test-suite/tests/00-socket.test | 44 +--------
test-suite/tests/arrays.test | 29 ++---
test-suite/tests/bitvectors.test | 19 ++--
test-suite/tests/bytevectors.test | 7 +-
test-suite/tests/encoding-iso88591.test | 11 +--
test-suite/tests/encoding-iso88597.test | 12 +--
test-suite/tests/encoding-utf8.test | 10 +--
test-suite/tests/format.test | 7 +-
test-suite/tests/ports.test | 4 +-
test-suite/tests/regexp.test | 6 +-
test-suite/tests/srfi-14.test | 10 +--
test-suite/tests/srfi-19.test | 5 +-
test-suite/tests/srfi-4.test | 50 +++++-----
test-suite/tests/tree-il.test | 6 +-
32 files changed, 179 insertions(+), 643 deletions(-)
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index e595668..381c10d 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008,
address@hidden 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
address@hidden 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation,
Inc.
@c See the file guile.texi for copying conditions.
@node Foreign Function Interface
@@ -613,12 +613,10 @@ Scheme objects such as strings, floating point numbers,
or integers.
Return a bytevector aliasing the @var{len} bytes pointed to by
@var{pointer}.
-The user may specify an alternate default interpretation for
-the memory by passing the @var{uvec_type} argument, to indicate
-that the memory is an array of elements of that type.
address@hidden should be something that
address@hidden would return, like @code{f32}
-or @code{s16}.
+The user may specify an alternate default interpretation for the memory
+by passing the @var{uvec_type} argument, to indicate that the memory is
+an array of elements of that type. @var{uvec_type} should be something
+that @code{array-type} would return, like @code{f32} or @code{s16}.
When @var{offset} is passed, it specifies the offset in bytes relative
to @var{pointer} of the memory region aliased by the returned
diff --git a/doc/ref/api-memory.texi b/doc/ref/api-memory.texi
index 130ff84..01bfe81 100644
--- a/doc/ref/api-memory.texi
+++ b/doc/ref/api-memory.texi
@@ -296,9 +296,9 @@ they constitute a doubly-weak table has to be used.
@node Weak hash tables
@subsubsection Weak hash tables
address@hidden {Scheme Procedure} make-weak-key-hash-table size
address@hidden {Scheme Procedure} make-weak-value-hash-table size
address@hidden {Scheme Procedure} make-doubly-weak-hash-table size
address@hidden {Scheme Procedure} make-weak-key-hash-table [size]
address@hidden {Scheme Procedure} make-weak-value-hash-table [size]
address@hidden {Scheme Procedure} make-doubly-weak-hash-table [size]
@deffnx {C Function} scm_make_weak_key_hash_table (size)
@deffnx {C Function} scm_make_weak_value_hash_table (size)
@deffnx {C Function} scm_make_doubly_weak_hash_table (size)
@@ -324,9 +324,6 @@ nor a weak value hash table.
@node Weak vectors
@subsubsection Weak vectors
-Weak vectors are mainly useful in Guile's implementation of weak hash
-tables.
-
@deffn {Scheme Procedure} make-weak-vector size [fill]
@deffnx {C Function} scm_make_weak_vector (size, fill)
Return a weak vector with @var{size} elements. If the optional
@@ -346,8 +343,7 @@ the same way @code{list->vector} would.
@deffn {Scheme Procedure} weak-vector? obj
@deffnx {C Function} scm_weak_vector_p (obj)
-Return @code{#t} if @var{obj} is a weak vector. Note that all
-weak hashes are also weak vectors.
+Return @code{#t} if @var{obj} is a weak vector.
@end deffn
@deffn {Scheme Procedure} weak-vector-ref wvect k
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 9091d9f..6cd90bc 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1,7 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
address@hidden 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
address@hidden 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software
Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node POSIX
@@ -3393,55 +3393,6 @@ file descriptor:
any unflushed buffered port data is ignored.
@end deffn
-The following functions can be used to convert short and long integers
-between ``host'' and ``network'' order. Although the procedures above do
-this automatically for addresses, the conversion will still need to
-be done when sending or receiving encoded integer data from the network.
-
address@hidden {Scheme Procedure} htons value
address@hidden {C Function} scm_htons (value)
-Convert a 16 bit quantity from host to network byte ordering.
address@hidden is packed into 2 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} ntohs value
address@hidden {C Function} scm_ntohs (value)
-Convert a 16 bit quantity from network to host byte ordering.
address@hidden is packed into 2 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} htonl value
address@hidden {C Function} scm_htonl (value)
-Convert a 32 bit quantity from host to network byte ordering.
address@hidden is packed into 4 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
address@hidden {Scheme Procedure} ntohl value
address@hidden {C Function} scm_ntohl (value)
-Convert a 32 bit quantity from network to host byte ordering.
address@hidden is packed into 4 bytes, which are then converted
-and returned as a new integer.
address@hidden deffn
-
-These procedures are inconvenient to use at present, but consider:
-
address@hidden
-(define write-network-long
- (lambda (value port)
- (let ((v (make-uniform-vector 1 1 0)))
- (uniform-vector-set! v 0 (htonl value))
- (uniform-vector-write v port))))
-
-(define read-network-long
- (lambda (port)
- (let ((v (make-uniform-vector 1 1 0)))
- (uniform-vector-read! v port)
- (ntohl (uniform-vector-ref v 0)))))
address@hidden example
-
@node Internet Socket Examples
@subsubsection Network Socket Examples
diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi
index 746ee62..161d372 100644
--- a/doc/ref/srfi-modules.texi
+++ b/doc/ref/srfi-modules.texi
@@ -1346,7 +1346,6 @@ C had modules!)
@menu
* SRFI-4 Overview:: The warp and weft of uniform numeric vectors.
* SRFI-4 API:: Uniform vectors, from Scheme and from C.
-* SRFI-4 Generic Operations:: The general, operating on the specific.
* SRFI-4 and Bytevectors:: SRFI-4 vectors are backed by bytevectors.
* SRFI-4 Extensions:: Guile-specific extensions to the standard.
@end menu
@@ -1731,65 +1730,6 @@ C}), but returns a pointer to the elements of a uniform
numeric vector
of the indicated kind.
@end deftypefn
address@hidden SRFI-4 Generic Operations
address@hidden SRFI-4 - Generic operations
-
-Guile also provides procedures that operate on all types of uniform numeric
-vectors. In what is probably a bug, these procedures are currently available
in
-the default environment as well; however prudent hackers will make sure to
-import @code{(srfi srfi-4 gnu)} before using these.
-
address@hidden {C Function} int scm_is_uniform_vector (SCM uvec)
-Return non-zero when @var{uvec} is a uniform numeric vector, zero
-otherwise.
address@hidden deftypefn
-
address@hidden {C Function} size_t scm_c_uniform_vector_length (SCM uvec)
-Return the number of elements of @var{uvec} as a @code{size_t}.
address@hidden deftypefn
-
address@hidden {Scheme Procedure} uniform-vector? obj
address@hidden {C Function} scm_uniform_vector_p (obj)
-Return @code{#t} if @var{obj} is a homogeneous numeric vector of the
-indicated type.
address@hidden deffn
-
address@hidden {Scheme Procedure} uniform-vector-length vec
address@hidden {C Function} scm_uniform_vector_length (vec)
-Return the number of elements in @var{vec}.
address@hidden deffn
-
address@hidden {Scheme Procedure} uniform-vector-ref vec i
address@hidden {C Function} scm_uniform_vector_ref (vec, i)
-Return the element at index @var{i} in @var{vec}. The first element
-in @var{vec} is index 0.
address@hidden deffn
-
address@hidden {Scheme Procedure} uniform-vector-set! vec i value
address@hidden {C Function} scm_uniform_vector_set_x (vec, i, value)
-Set the element at index @var{i} in @var{vec} to @var{value}. The
-first element in @var{vec} is index 0. The return value is
-unspecified.
address@hidden deffn
-
address@hidden {Scheme Procedure} uniform-vector->list vec
address@hidden {C Function} scm_uniform_vector_to_list (vec)
-Return a newly allocated list holding all elements of @var{vec}.
address@hidden deffn
-
address@hidden {C Function} {const void *} scm_uniform_vector_elements (SCM
vec, scm_t_array_handle *handle, size_t *lenp, ssize_t *incp)
-Like @code{scm_vector_elements} (@pxref{Vector Accessing from C}), but
-returns a pointer to the elements of a uniform numeric vector.
address@hidden deftypefn
-
address@hidden {C Function} {void *} scm_uniform_vector_writable_elements (SCM
vec, scm_t_array_handle *handle, size_t *lenp, ssize_t *incp)
-Like @code{scm_vector_writable_elements} (@pxref{Vector Accessing from
-C}), but returns a pointer to the elements of a uniform numeric vector.
address@hidden deftypefn
-
-Unless you really need to the limited generality of these functions, it
-is best to use the type-specific functions, or the array accessors.
-
@node SRFI-4 and Bytevectors
@subsubsection SRFI-4 - Relation to bytevectors
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index 59925a0..88c1cde 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009, 2010, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006,
2009, 2010, 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 License
@@ -189,6 +189,24 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_array_type_code,
+ "array-type-code", 1, 0, 0,
+ (SCM array),
+ "Return the type of the elements in @var{array},\n"
+ "as an integer code.")
+#define FUNC_NAME s_scm_array_type_code
+{
+ scm_t_array_handle h;
+ scm_t_array_element_type element_type;
+
+ scm_array_get_handle (array, &h);
+ element_type = h.element_type;
+ scm_array_handle_release (&h);
+
+ return scm_from_uint16 (element_type);
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_array_in_bounds_p, "array-in-bounds?", 1, 0, 1,
(SCM ra, SCM args),
"Return @code{#t} if its arguments would be acceptable to\n"
diff --git a/libguile/generalized-arrays.h b/libguile/generalized-arrays.h
index d9fcea6..dfdb8bd 100644
--- a/libguile/generalized-arrays.h
+++ b/libguile/generalized-arrays.h
@@ -3,7 +3,7 @@
#ifndef SCM_GENERALIZED_ARRAYS_H
#define SCM_GENERALIZED_ARRAYS_H
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 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 License
@@ -49,6 +49,7 @@ SCM_API SCM scm_array_length (SCM ra);
SCM_API SCM scm_array_dimensions (SCM ra);
SCM_API SCM scm_array_type (SCM ra);
+SCM_API SCM scm_array_type_code (SCM ra);
SCM_API SCM scm_array_in_bounds_p (SCM v, SCM args);
SCM_API SCM scm_c_array_ref_1 (SCM v, ssize_t idx0);
diff --git a/libguile/socket.c b/libguile/socket.c
index 8c1326a..0516e52 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
- * 2006, 2007, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2006, 2007, 2009, 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 License
@@ -92,50 +92,6 @@ typedef union
-SCM_DEFINE (scm_htons, "htons", 1, 0, 0,
- (SCM value),
- "Convert a 16 bit quantity from host to network byte ordering.\n"
- "@var{value} is packed into 2 bytes, which are then converted\n"
- "and returned as a new integer.")
-#define FUNC_NAME s_scm_htons
-{
- return scm_from_ushort (htons (scm_to_ushort (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_ntohs, "ntohs", 1, 0, 0,
- (SCM value),
- "Convert a 16 bit quantity from network to host byte ordering.\n"
- "@var{value} is packed into 2 bytes, which are then converted\n"
- "and returned as a new integer.")
-#define FUNC_NAME s_scm_ntohs
-{
- return scm_from_ushort (ntohs (scm_to_ushort (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_htonl, "htonl", 1, 0, 0,
- (SCM value),
- "Convert a 32 bit quantity from host to network byte ordering.\n"
- "@var{value} is packed into 4 bytes, which are then converted\n"
- "and returned as a new integer.")
-#define FUNC_NAME s_scm_htonl
-{
- return scm_from_ulong (htonl (scm_to_uint32 (value)));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_ntohl, "ntohl", 1, 0, 0,
- (SCM value),
- "Convert a 32 bit quantity from network to host byte ordering.\n"
- "@var{value} is packed into 4 bytes, which are then converted\n"
- "and returned as a new integer.")
-#define FUNC_NAME s_scm_ntohl
-{
- return scm_from_ulong (ntohl (scm_to_uint32 (value)));
-}
-#undef FUNC_NAME
-
#ifdef HAVE_INET_NETOF
SCM_DEFINE (scm_inet_netof, "inet-netof", 1, 0, 0,
(SCM address),
diff --git a/libguile/socket.h b/libguile/socket.h
index fcddd78..a211867 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -3,7 +3,7 @@
#ifndef SCM_SOCKET_H
#define SCM_SOCKET_H
-/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008 Free
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008, 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 License
@@ -27,10 +27,6 @@
-SCM_API SCM scm_htons (SCM in);
-SCM_API SCM scm_ntohs (SCM in);
-SCM_API SCM scm_htonl (SCM in);
-SCM_API SCM scm_ntohl (SCM in);
SCM_API SCM scm_inet_aton (SCM address);
SCM_API SCM scm_inet_ntoa (SCM inetid);
SCM_API SCM scm_inet_netof (SCM address);
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c
index c45519b..d8a264c 100644
--- a/libguile/srfi-4.c
+++ b/libguile/srfi-4.c
@@ -1,6 +1,6 @@
/* srfi-4.c --- Uniform numeric vector datatypes.
*
- * Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011 Free Software
Foundation, Inc.
+ * Copyright (C) 2001, 2004, 2006, 2009, 2010, 2011, 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 License
@@ -137,32 +137,15 @@
scm_t_array_handle *h, \
size_t *lenp, ssize_t *incp) \
{ \
- scm_uniform_vector_elements (uvec, h, lenp, incp); \
- if (h->element_type == ETYPE (TAG)) \
- return ((ctype*)h->writable_elements) + h->base*width; \
- /* otherwise... */ \
- else \
- { \
- size_t sfrom, sto, lfrom, lto; \
- if (h->dims != &h->dim0) \
- { \
- h->dim0 = h->dims[0]; \
- h->dims = &h->dim0; \
- } \
- sfrom = scm_i_array_element_type_sizes [h->element_type]; \
- sto = scm_i_array_element_type_sizes [ETYPE (TAG)]; \
- lfrom = h->dim0.ubnd - h->dim0.lbnd + 1; \
- lto = lfrom * sfrom / sto; \
- if (lto * sto != lfrom * sfrom) \
- { \
- scm_array_handle_release (h); \
- scm_wrong_type_arg (#tag"vector-elements", SCM_ARG1, uvec); \
- } \
- h->dim0.ubnd = h->dim0.lbnd + lto; \
- h->base = h->base * sto / sfrom; \
- h->element_type = ETYPE (TAG); \
- return ((ctype*)h->writable_elements) + h->base*width; \
- } \
+ if (!scm_is_bytevector (uvec) \
+ || (scm_c_bytevector_length (uvec) % width)) \
+ scm_wrong_type_arg_msg (NULL, 0, uvec, #tag "vector"); \
+ scm_array_get_handle (uvec, h); \
+ if (lenp) \
+ *lenp = scm_c_bytevector_length (uvec) / width; \
+ if (incp) \
+ *incp = 1; \
+ return ((ctype *)h->writable_elements); \
}
@@ -231,13 +214,15 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector",
2, 1, 0,
"Make a srfi-4 vector")
#define FUNC_NAME s_scm_make_srfi_4_vector
{
- int i;
- for (i = 0; i <= SCM_ARRAY_ELEMENT_TYPE_LAST; i++)
- if (scm_is_eq (type, scm_i_array_element_types[i]))
+ int c_type;
+ size_t c_len;
+
+ for (c_type = 0; c_type <= SCM_ARRAY_ELEMENT_TYPE_LAST; c_type++)
+ if (scm_is_eq (type, scm_i_array_element_types[c_type]))
break;
- if (i > SCM_ARRAY_ELEMENT_TYPE_LAST)
+ if (c_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "vector type");
- switch (i)
+ switch (c_type)
{
case SCM_ARRAY_ELEMENT_TYPE_U8:
case SCM_ARRAY_ELEMENT_TYPE_S8:
@@ -252,7 +237,10 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector",
2, 1, 0,
case SCM_ARRAY_ELEMENT_TYPE_C32:
case SCM_ARRAY_ELEMENT_TYPE_C64:
{
- SCM ret = scm_i_make_typed_bytevector (scm_to_size_t (len), i);
+ SCM ret;
+
+ c_len = scm_to_size_t (len);
+ ret = scm_i_make_typed_bytevector (c_len, c_type);
if (SCM_UNBNDP (fill) || scm_is_eq (len, SCM_INUM0))
; /* pass */
@@ -262,17 +250,11 @@ SCM_DEFINE (scm_make_srfi_4_vector, "make-srfi-4-vector",
2, 1, 0,
else
{
scm_t_array_handle h;
- size_t len;
- ssize_t pos, inc;
-
- scm_uniform_vector_writable_elements (ret, &h, &len, &inc);
-
- for (pos = 0; pos != h.dims[0].ubnd; pos += inc)
- scm_array_handle_set (&h, pos, fill);
-
- /* Initialize the last element. */
- scm_array_handle_set (&h, pos, fill);
+ size_t i;
+ scm_array_get_handle (ret, &h);
+ for (i = 0; i < c_len; i++)
+ scm_array_handle_set (&h, i, fill);
scm_array_handle_release (&h);
}
return ret;
diff --git a/libguile/uniform.c b/libguile/uniform.c
index e81f504..f7ca7bc 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -81,178 +81,6 @@ scm_array_handle_uniform_writable_elements
(scm_t_array_handle *h)
return ret;
}
-int
-scm_is_uniform_vector (SCM obj)
-{
- scm_t_array_handle h;
- int ret = 0;
-
- if (scm_is_array (obj))
- {
- scm_array_get_handle (obj, &h);
- ret = (scm_array_handle_rank (&h) == 1
- && SCM_ARRAY_ELEMENT_TYPE_IS_UNBOXED (h.element_type));
- scm_array_handle_release (&h);
- }
- return ret;
-}
-
-size_t
-scm_c_uniform_vector_length (SCM uvec)
-{
- if (!scm_is_uniform_vector (uvec))
- scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
- "uniform vector");
- return scm_c_array_length (uvec);
-}
-
-SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
- (SCM obj),
- "Return @code{#t} if @var{obj} is a uniform vector.")
-#define FUNC_NAME s_scm_uniform_vector_p
-{
- return scm_from_bool (scm_is_uniform_vector (obj));
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1,
0, 0,
- (SCM v),
- "Return the type of the elements in the uniform vector, @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_element_type
-{
- scm_t_array_handle h;
- SCM ret;
-
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
- scm_array_get_handle (v, &h);
- ret = scm_array_handle_element_type (&h);
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_type_code,
- "uniform-vector-element-type-code", 1, 0, 0,
- (SCM v),
- "Return the type of the elements in the uniform vector, @var{v},\n"
- "as an integer code.")
-#define FUNC_NAME s_scm_uniform_vector_element_type_code
-{
- scm_t_array_handle h;
- SCM ret;
-
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
- scm_array_get_handle (v, &h);
- ret = scm_from_uint16 (h.element_type);
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1,
0, 0,
- (SCM v),
- "Return the number of bytes allocated to each element in the\n"
- "uniform vector, @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_element_size
-{
- scm_t_array_handle h;
- size_t len;
- ssize_t inc;
- SCM ret;
- scm_uniform_vector_elements (v, &h, &len, &inc);
- ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
- scm_array_handle_release (&h);
- return ret;
-}
-#undef FUNC_NAME
-
-SCM
-scm_c_uniform_vector_ref (SCM v, size_t pos)
-{
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
- return scm_c_array_ref_1 (v, pos);
-}
-
-SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
- (SCM v, SCM idx),
- "Return the element at index @var{idx} of the\n"
- "homogeneous numeric vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_ref
-{
- return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
-}
-#undef FUNC_NAME
-
-void
-scm_c_uniform_vector_set_x (SCM v, size_t pos, SCM val)
-{
- if (!scm_is_uniform_vector (v))
- scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
- scm_c_array_set_1_x (v, val, pos);
-}
-
-SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
- (SCM v, SCM idx, SCM val),
- "Set the element at index @var{idx} of the\n"
- "homogeneous numeric vector @var{v} to @var{val}.")
-#define FUNC_NAME s_scm_uniform_vector_set_x
-{
- scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
- (SCM uvec),
- "Convert the uniform numeric vector @var{uvec} to a list.")
-#define FUNC_NAME s_scm_uniform_vector_to_list
-{
- if (!scm_is_uniform_vector (uvec))
- scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector");
- return scm_array_to_list (uvec);
-}
-#undef FUNC_NAME
-
-const void *
-scm_uniform_vector_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp)
-{
- return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
-}
-
-void *
-scm_uniform_vector_writable_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp)
-{
- void *ret;
- scm_array_get_handle (uvec, h);
- if (scm_array_handle_rank (h) != 1)
- scm_wrong_type_arg_msg (0, SCM_ARG1, uvec, "uniform vector");
- ret = scm_array_handle_uniform_writable_elements (h);
- if (lenp)
- {
- scm_t_array_dim *dim = scm_array_handle_dims (h);
- *lenp = dim->ubnd - dim->lbnd + 1;
- *incp = dim->inc;
- }
- return ret;
-}
-
-SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
- (SCM v),
- "Return the number of elements in the uniform vector @var{v}.")
-#define FUNC_NAME s_scm_uniform_vector_length
-{
- return scm_from_size_t (scm_c_uniform_vector_length (v));
-}
-#undef FUNC_NAME
-
-
void
scm_init_uniform (void)
{
diff --git a/libguile/uniform.h b/libguile/uniform.h
index 57e214b..ad8428f 100644
--- a/libguile/uniform.h
+++ b/libguile/uniform.h
@@ -3,7 +3,8 @@
#ifndef SCM_UNIFORM_H
#define SCM_UNIFORM_H
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2013
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
+ * 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 License
@@ -43,33 +44,9 @@ SCM_API size_t scm_array_handle_uniform_element_bit_size
(scm_t_array_handle *h)
SCM_API const void *scm_array_handle_uniform_elements (scm_t_array_handle *h);
SCM_API void *scm_array_handle_uniform_writable_elements (scm_t_array_handle
*h);
-SCM_API SCM scm_uniform_vector_p (SCM v);
-SCM_API SCM scm_uniform_vector_length (SCM v);
-SCM_API SCM scm_uniform_vector_element_type (SCM v);
-SCM_API SCM scm_uniform_vector_element_type_code (SCM v);
-SCM_API SCM scm_uniform_vector_element_size (SCM v);
-SCM_API SCM scm_uniform_vector_ref (SCM v, SCM idx);
-SCM_API SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
-SCM_API SCM scm_uniform_vector_to_list (SCM v);
-SCM_API SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
- SCM start, SCM end);
-SCM_API SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
- SCM start, SCM end);
-
-SCM_API int scm_is_uniform_vector (SCM obj);
-SCM_API size_t scm_c_uniform_vector_length (SCM v);
-SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
-SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
-SCM_API const void *scm_uniform_vector_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp, ssize_t *incp);
-SCM_API void *scm_uniform_vector_writable_elements (SCM uvec,
- scm_t_array_handle *h,
- size_t *lenp,
- ssize_t *incp);
-
SCM_INTERNAL void scm_init_uniform (void);
+
#endif /* SCM_UNIFORM_H */
/*
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index e911069..4e3ed33 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2011, 2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 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 License
@@ -1079,7 +1079,7 @@ SCM_DEFINE (scm_make_weak_value_hash_table,
"make-weak-value-hash-table", 0, 1,
#undef FUNC_NAME
-SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1,
0, 0,
+SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 0,
1, 0,
(SCM n),
"Return a hash table with weak keys and values with @var{size}\n"
"buckets. (@pxref{Hash Tables})")
diff --git a/libguile/weak-vector.c b/libguile/weak-vector.c
index b1fff1b..082cdde 100644
--- a/libguile/weak-vector.c
+++ b/libguile/weak-vector.c
@@ -189,7 +189,7 @@ scm_c_weak_vector_ref (SCM wv, size_t k)
d.k = k;
if (k >= SCM_I_VECTOR_LENGTH (wv))
- scm_out_of_range (NULL, scm_from_size_t (k));
+ scm_out_of_range ("weak-vector-ref", scm_from_size_t (k));
ret = GC_call_with_alloc_lock (weak_vector_ref, &d);
@@ -227,7 +227,7 @@ scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
d.k = k;
if (k >= SCM_I_VECTOR_LENGTH (wv))
- scm_out_of_range (NULL, scm_from_size_t (k));
+ scm_out_of_range ("weak-vector-set!", scm_from_size_t (k));
prev = GC_call_with_alloc_lock (weak_vector_ref, &d);
diff --git a/module/ice-9/pretty-print.scm b/module/ice-9/pretty-print.scm
index 1573c6f..007061f 100644
--- a/module/ice-9/pretty-print.scm
+++ b/module/ice-9/pretty-print.scm
@@ -1,7 +1,7 @@
;;;; -*- coding: utf-8; mode: scheme -*-
;;;;
;;;; Copyright (C) 2001, 2004, 2006, 2009, 2010,
-;;;; 2012, 2013 Free Software Foundation, Inc.
+;;;; 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
@@ -20,6 +20,7 @@
(define-module (ice-9 pretty-print)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (rnrs bytevectors)
#:export (pretty-print
truncated-print))
@@ -418,12 +419,12 @@ sub-expression, via the @var{breadth-first?} keyword
argument."
(display ")"))
(else
(display "#"))))
- ((uniform-vector? x)
+ ((bytevector? x)
(cond
((>= width 9)
- (format #t "#~a(" (uniform-vector-element-type x))
- (print-sequence x (- width 6) (uniform-vector-length x)
- uniform-vector-ref identity)
+ (format #t "#~a(" (array-type x))
+ (print-sequence x (- width 6) (array-length x)
+ array-ref identity)
(display ")"))
(else
(display "#"))))
diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm
index c6eb00b..b2e6f49 100644
--- a/module/srfi/srfi-4.scm
+++ b/module/srfi/srfi-4.scm
@@ -1,7 +1,7 @@
;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes
;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010,
-;; 2012 Free Software Foundation, Inc.
+;; 2012, 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
@@ -75,14 +75,11 @@
(define-macro (define-bytevector-type tag infix size)
`(begin
(define (,(symbol-append tag 'vector?) obj)
- (and (uniform-vector? obj)
- (eq? (uniform-vector-element-type obj) ',tag)))
+ (and (bytevector? obj) (eq? (array-type obj) ',tag)))
(define (,(symbol-append 'make- tag 'vector) len . fill)
(apply make-srfi-4-vector ',tag len fill))
(define (,(symbol-append tag 'vector-length) v)
- (let ((len (* (uniform-vector-length v)
- (uniform-vector-element-size v)
- (/ ,size))))
+ (let ((len (/ (bytevector-length v) ,size)))
(if (integer? len)
len
(error "fractional length" v ',tag ,size))))
@@ -119,21 +116,3 @@
(define-bytevector-type s64 s64-native 8)
(define-bytevector-type f32 ieee-single-native 4)
(define-bytevector-type f64 ieee-double-native 8)
-
-(define (bytevector-c32-ref v i)
- (make-rectangular (bytevector-ieee-single-native-ref v i)
- (bytevector-ieee-single-native-ref v (+ i 4))))
-(define (bytevector-c32-set! v i x)
- (bytevector-ieee-single-native-set! v i x)
- (bytevector-ieee-single-native-set! v (+ i 4) x))
-(define-bytevector-type c32 c32 8)
-
-(define (bytevector-c64-ref v i)
- (make-rectangular (bytevector-ieee-double-native-ref v i)
- (bytevector-ieee-double-native-ref v (+ i 8))))
-(define (bytevector-c64-set! v i x)
- (bytevector-ieee-double-native-set! v i x)
- (bytevector-ieee-double-native-set! v (+ i 8) x))
-(define-bytevector-type c64 c64 16)
-
-
diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm
index 7f595d6..42bbf33 100644
--- a/module/srfi/srfi-4/gnu.scm
+++ b/module/srfi/srfi-4/gnu.scm
@@ -1,6 +1,6 @@
;;; Extensions to SRFI-4
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 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
@@ -42,44 +42,6 @@
(define make-srfi-4-vector (@@ (srfi srfi-4) make-srfi-4-vector))
-;; Need quasisyntax to do this effectively using syntax-case
-(define-macro (define-bytevector-type tag infix size)
- `(begin
- (define (,(symbol-append tag 'vector?) obj)
- (and (uniform-vector? obj)
- (eq? (uniform-vector-element-type obj) ',tag)))
- (define (,(symbol-append 'make- tag 'vector) len . fill)
- (apply make-srfi-4-vector ',tag len fill))
- (define (,(symbol-append tag 'vector-length) v)
- (let ((len (* (uniform-vector-length v)
- (uniform-vector-element-size v)
- (/ ,size))))
- (if (integer? len)
- len
- (error "fractional length" v ',tag ,size))))
- (define (,(symbol-append tag 'vector) . elts)
- (,(symbol-append 'list-> tag 'vector) elts))
- (define (,(symbol-append 'list-> tag 'vector) elts)
- (let* ((len (length elts))
- (v (,(symbol-append 'make- tag 'vector) len)))
- (let lp ((i 0) (elts elts))
- (if (and (< i len) (pair? elts))
- (begin
- (,(symbol-append tag 'vector-set!) v i (car elts))
- (lp (1+ i) (cdr elts)))
- v))))
- (define (,(symbol-append tag 'vector->list) v)
- (let lp ((i (1- (,(symbol-append tag 'vector-length) v))) (elts '()))
- (if (< i 0)
- elts
- (lp (1- i) (cons (,(symbol-append tag 'vector-ref) v i) elts)))))
- (define (,(symbol-append tag 'vector-ref) v i)
- (,(symbol-append 'bytevector- infix '-ref) v (* i ,size)))
- (define (,(symbol-append tag 'vector-set!) v i x)
- (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))
- (define (,(symbol-append tag 'vector-set!) v i x)
- (,(symbol-append 'bytevector- infix '-set!) v (* i ,size) x))))
-
(define (bytevector-c32-native-ref v i)
(make-rectangular (bytevector-ieee-single-native-ref v i)
(bytevector-ieee-single-native-ref v (+ i 4))))
@@ -92,8 +54,9 @@
(define (bytevector-c64-native-set! v i x)
(bytevector-ieee-double-native-set! v i (real-part x))
(bytevector-ieee-double-native-set! v (+ i 8) (imag-part x)))
-(define-bytevector-type c32 c32-native 8)
-(define-bytevector-type c64 c64-native 16)
+
+((@@ (srfi srfi-4) define-bytevector-type) c32 c32-native 8)
+((@@ (srfi srfi-4) define-bytevector-type) c64 c64-native 16)
(define-macro (define-any->vector . tags)
`(begin
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 5ddc642..597d878 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -604,14 +604,20 @@ table, its existing label is used directly."
(static-set! 1 ,label 0)))
((uniform-vector-backing-store? obj) '())
((simple-uniform-vector? obj)
- `((static-patch! ,label 2
- ,(recur (make-uniform-vector-backing-store
- (uniform-array->bytevector obj)
- (if (bitvector? obj)
- ;; Bitvectors are addressed in
- ;; 32-bit units.
- 4
- (uniform-vector-element-size obj)))))))
+ (let ((width (case (array-type obj)
+ ((vu8 u8 s8) 1)
+ ((u16 s16) 2)
+ ;; Bitvectors are addressed in 32-bit units.
+ ;; Although a complex number is 8 or 16 bytes wide,
+ ;; it should be byteswapped in 4 or 8 byte units.
+ ((u32 s32 f32 c32 b) 4)
+ ((u64 s64 f64 c64) 8)
+ (else
+ (error "unhandled array type" obj)))))
+ `((static-patch! ,label 2
+ ,(recur (make-uniform-vector-backing-store
+ (uniform-array->bytevector obj)
+ width))))))
(else
(error "don't know how to intern" obj))))
(cond
@@ -1041,7 +1047,7 @@ should be .data or .rodata), and return the resulting
linker object.
((simple-uniform-vector? obj)
(let ((tag (if (bitvector? obj)
tc7-bitvector
- (let ((type-code (uniform-vector-element-type-code
obj)))
+ (let ((type-code (array-type-code obj)))
(logior tc7-bytevector (ash type-code 7))))))
(case word-size
((4)
diff --git a/test-suite/guile-test b/test-suite/guile-test
index cdcfe49..43ea481 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -5,7 +5,7 @@
;;;; guile-test --- run the Guile test suite
;;;; Jim Blandy <address@hidden> --- May 1999
;;;;
-;;;; Copyright (C) 1999, 2001, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2006, 2010, 2014 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -239,8 +239,9 @@
(lambda ()
(for-each (lambda (test)
(display (string-append "Running " test "\n"))
- (with-test-prefix test
- (load (test-file-name test))))
+ (with-locale "C"
+ (with-test-prefix test
+ (load (test-file-name test)))))
tests))))
(if (opt 'coverage #f)
(let-values (((coverage-data _)
@@ -262,4 +263,5 @@
;;; Local Variables:
;;; mode: scheme
+;;; eval: (put 'with-locale 'scheme-indent-function 1)
;;; End:
diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
index 30a0257..211aaaf 100644
--- a/test-suite/tests/00-socket.test
+++ b/test-suite/tests/00-socket.test
@@ -1,7 +1,7 @@
;;;; 00-socket.test --- test socket functions -*- scheme -*-
;;;;
;;;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010,
-;;;; 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; 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
@@ -28,27 +28,6 @@
;;;
-;;; htonl
-;;;
-
-(if (defined? 'htonl)
- (with-test-prefix "htonl"
-
- (pass-if "0" (eqv? 0 (htonl 0)))
-
- (pass-if-exception "-1" exception:out-of-range
- (htonl -1))
-
- ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't
detect
- ;; an overflow for values 2^32 <= x < 2^63
- (pass-if-exception "2^32" exception:out-of-range
- (htonl (ash 1 32)))
-
- (pass-if-exception "2^1024" exception:out-of-range
- (htonl (ash 1 1024)))))
-
-
-;;;
;;; inet-ntop
;;;
@@ -154,27 +133,6 @@
(and (= (sockaddr:fam sa) AF_UNIX)
(string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
-;;;
-;;; ntohl
-;;;
-
-(if (defined? 'ntohl)
- (with-test-prefix "ntohl"
-
- (pass-if "0" (eqv? 0 (ntohl 0)))
-
- (pass-if-exception "-1" exception:out-of-range
- (ntohl -1))
-
- ;; prior to guile 1.6.9 and 1.8.1, systems with 64-bit longs didn't
detect
- ;; an overflow for values 2^32 <= x < 2^63
- (pass-if-exception "2^32" exception:out-of-range
- (ntohl (ash 1 32)))
-
- (pass-if-exception "2^1024" exception:out-of-range
- (ntohl (ash 1 1024)))))
-
-
;;;
;;; AF_UNIX sockets and `make-socket-address'
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0da1a19..015470c 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -1,6 +1,6 @@
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*-
;;;;
-;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software
Foundation, Inc.
+;;;; Copyright 2004, 2006, 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
@@ -33,13 +33,6 @@
(cons 'read-error ".*array length must be non-negative.*"))
-(with-test-prefix "sanity"
- ;; At the current time of writing, bignums have a tc7 that is one bit
- ;; away from strings. It used to be that the vector implementation
- ;; registered for strings had the TYP7S mask, not the TYP7 mask,
- ;; making the system think that bignums were vectors. Doh!
- (pass-if (not (uniform-vector? 12345678901234567890123456789))))
-
(with-test-prefix "array?"
(let ((bool (make-typed-array 'b #t '(5 6)))
@@ -651,39 +644,39 @@
;;; uniform-vector
;;;
-(with-test-prefix "uniform-vector"
+(with-test-prefix "typed arrays"
- (with-test-prefix "uniform-vector-ref byte"
+ (with-test-prefix "array-ref byte"
(let ((a (make-s8vector 1)))
(pass-if "0"
(begin
(array-set! a 0 0)
- (= 0 (uniform-vector-ref a 0))))
+ (= 0 (array-ref a 0))))
(pass-if "127"
(begin
(array-set! a 127 0)
- (= 127 (uniform-vector-ref a 0))))
+ (= 127 (array-ref a 0))))
(pass-if "-128"
(begin
(array-set! a -128 0)
- (= -128 (uniform-vector-ref a 0))))))
+ (= -128 (array-ref a 0))))))
- (with-test-prefix "shared with rank 1 remain uniform vectors"
+ (with-test-prefix "shared with rank 1 equality"
(let ((a #f64(1 2 3 4)))
(pass-if "change offset"
(let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
- (and (uniform-vector? b)
- (= 3 (uniform-vector-length b))
+ (and (eq? (array-type b) (array-type a))
+ (= 3 (array-length b))
(array-equal? b #f64(2 3 4)))))
(pass-if "change stride"
(let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
- (and (uniform-vector? c)
- (= 2 (uniform-vector-length c))
+ (and (eq? (array-type c) (array-type a))
+ (= 2 (array-length c))
(array-equal? c #f64(1 3))))))))
;;;
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
index 4e32c61..8541576 100644
--- a/test-suite/tests/bitvectors.test
+++ b/test-suite/tests/bitvectors.test
@@ -1,6 +1,6 @@
;;;; bitvectors.test --- tests guile's bitvectors -*- scheme -*-
;;;;
-;;;; Copyright 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright 2010, 2011, 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
@@ -22,8 +22,8 @@
(with-test-prefix "predicates"
(pass-if (bitvector? #*1010101010))
- (pass-if (uniform-vector? #*1010101010))
- (pass-if (array? #*1010101010)))
+ (pass-if (array? #*1010101010))
+ (pass-if (eq? (array-type #*1010101010) 'b)))
(with-test-prefix "equality"
@@ -36,23 +36,22 @@
(with-test-prefix "lists"
(pass-if (equal? (bitvector->list #*10010) '(#t #f #f #t #f)))
(pass-if (equal? (array->list #*10010) '(#t #f #f #t #f)))
- (pass-if (equal? (uniform-vector->list #*10010) '(#t #f #f #t #f)))
(pass-if (equal? #*10010 (list->bitvector '(#t #f #f #t #f)))))
(with-test-prefix "ref and set"
- (with-test-prefix "bv"
+ (with-test-prefix "as bitvector"
(let ((bv (list->bitvector '(#f #f #t #f #t))))
(pass-if (eqv? (bitvector-ref bv 0) #f))
(pass-if (eqv? (bitvector-ref bv 2) #t))
(bitvector-set! bv 0 #t)
(pass-if (eqv? (bitvector-ref bv 0) #t))))
- (with-test-prefix "uv"
+ (with-test-prefix "as array"
(let ((bv (list->bitvector '(#f #f #t #f #t))))
- (pass-if (eqv? (uniform-vector-ref bv 0) #f))
- (pass-if (eqv? (uniform-vector-ref bv 2) #t))
- (uniform-vector-set! bv 0 #t)
- (pass-if (eqv? (uniform-vector-ref bv 0) #t)))))
+ (pass-if (eqv? (array-ref bv 0) #f))
+ (pass-if (eqv? (array-ref bv 2) #t))
+ (array-set! bv #t 0)
+ (pass-if (eqv? (array-ref bv 0) #t)))))
(with-test-prefix "bit-set*!"
(pass-if "#t"
diff --git a/test-suite/tests/bytevectors.test
b/test-suite/tests/bytevectors.test
index de20721..c4ae1bb 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -1,6 +1,8 @@
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8;
-*-
;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013,
+;;;; 2014 Free Software Foundation, Inc.
+;;;;
;;;; Ludovic Courtès
;;;;
;;;; This library is free software; you can redistribute it and/or
@@ -393,7 +395,8 @@
;; Default to the C locale for the following tests.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
(with-test-prefix "2.9 Operations on Strings"
diff --git a/test-suite/tests/encoding-iso88591.test
b/test-suite/tests/encoding-iso88591.test
index 8265ff1..2af2b48 100644
--- a/test-suite/tests/encoding-iso88591.test
+++ b/test-suite/tests/encoding-iso88591.test
@@ -1,6 +1,6 @@
;;;; encoding-iso88591.test --- test suite for Guile's string encodings -*-
mode: scheme; coding: iso-8859-1 -*-
;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 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
@@ -25,9 +25,8 @@
(apply string (map integer->char args)))
;; Set locale to the environment's locale, so that the prints look OK.
-(define oldlocale #f)
-(if (defined? 'setlocale)
- (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+ (setlocale LC_ALL ""))
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@@ -177,7 +176,3 @@
(set-port-encoding! pt "ISO-8859-1")
(set-port-conversion-strategy! pt 'error)
(display (string-ints 256) pt))))
-
-;; Reset locales
-(if (defined? 'setlocale)
- (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-iso88597.test
b/test-suite/tests/encoding-iso88597.test
index a577b2a..e88b9d3 100644
--- a/test-suite/tests/encoding-iso88597.test
+++ b/test-suite/tests/encoding-iso88597.test
@@ -1,6 +1,6 @@
;;;; encoding-iso88697.test --- test suite for Guile's string encodings -*-
mode: scheme; coding: iso-8859-7 -*-
;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 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
@@ -24,9 +24,9 @@
(define (string-ints . args)
(apply string (map integer->char args)))
-(define oldlocale #f)
-(if (defined? 'setlocale)
- (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+ (setlocale LC_ALL ""))
+
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
(define alpha (integer->char #x03b1)) ; GREEK SMALL LETTER ALPHA
@@ -167,7 +167,3 @@
(set-port-encoding! pt "ISO-8859-7")
(set-port-conversion-strategy! pt 'error)
(display (string-ints #x0400) pt))))
-
-;; Reset locale
-(if (defined? 'setlocale)
- (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/encoding-utf8.test
b/test-suite/tests/encoding-utf8.test
index 1de3fa7..786170e 100644
--- a/test-suite/tests/encoding-utf8.test
+++ b/test-suite/tests/encoding-utf8.test
@@ -1,6 +1,6 @@
;;;; encoding-utf8.test --- test suite for Guile's string encodings -*-
mode: scheme; coding: utf-8 -*-
;;;;
-;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 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
@@ -24,9 +24,8 @@
(define (string-ints . args)
(apply string (map integer->char args)))
-(define oldlocale #f)
-(if (defined? 'setlocale)
- (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+ (setlocale LC_ALL ""))
(define ascii-a (integer->char 65)) ; LATIN CAPITAL LETTER A
(define a-acute (integer->char #x00c1)) ; LATIN CAPITAL LETTER A WITH ACUTE
@@ -189,6 +188,3 @@
(let ((è¥å·é¾ä¹ä» 1)
(ñ 2))
(eqv? (+ è¥å·é¾ä¹ä» ñ) 3))))
-
-(if (defined? 'setlocale)
- (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index a411b49..3349847 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -1,7 +1,8 @@
;;;; format.test --- test suite for Guile's CL-ish format -*- scheme -*-
;;;; Matthias Koeppe <address@hidden> --- June 2001
;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012 Free Software
Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012,
+;;;; 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
@@ -101,7 +102,9 @@
;;; ~h
;;;
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
+
(with-test-prefix "~h localized number"
(pass-if "1234.5"
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index bad4118..fb3299b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -243,7 +243,7 @@
(binary-test-string
(apply string
(map integer->char
- (uniform-vector->list
+ (array->list
(string->utf8 test-string))))))
(write-line test-string port)
(close-port port)
@@ -262,7 +262,7 @@
(binary-test-string
(apply string
(map integer->char
- (uniform-vector->list
+ (array->list
(string->utf8 test-string))))))
(write-line ";; coding: utf-8" port)
(write-line test-string port)
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index d25a3d4..2446dc7 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -2,7 +2,7 @@
;;;; Jim Blandy <address@hidden> --- September 1999
;;;;
;;;; Copyright (C) 1999, 2004, 2006, 2007, 2008, 2009, 2010,
-;;;; 2012, 2013 Free Software Foundation, Inc.
+;;;; 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
@@ -23,8 +23,8 @@
#:use-module (srfi srfi-1)
#:use-module (ice-9 regex))
-(if (defined? 'setlocale)
- (setlocale LC_ALL "C"))
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
;; Don't fail if we can't display a test name to stdout/stderr.
(set-port-conversion-strategy! (current-output-port) 'escape)
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
index 5f93760..f511f1c 100644
--- a/test-suite/tests/srfi-14.test
+++ b/test-suite/tests/srfi-14.test
@@ -2,7 +2,7 @@
;;;; --- Test suite for Guile's SRFI-14 functions.
;;;; Martin Grabmueller, 2001-07-16
;;;;
-;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2009, 2010, 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
@@ -745,9 +745,8 @@
(define (every? pred lst)
(not (not (every pred lst))))
-(define oldlocale #f)
-(if (defined? 'setlocale)
- (set! oldlocale (setlocale LC_ALL "")))
+(when (defined? 'setlocale)
+ (setlocale LC_ALL ""))
(with-test-prefix "Latin-1 (8-bit charset)"
@@ -844,6 +843,3 @@
(map (lambda (x) (+ #x80 x))
(iota #x20))))))
char-set:iso-control)))
-
-(if (defined? 'setlocale)
- (setlocale LC_ALL oldlocale))
diff --git a/test-suite/tests/srfi-19.test b/test-suite/tests/srfi-19.test
index 8819c4f..d63e622 100644
--- a/test-suite/tests/srfi-19.test
+++ b/test-suite/tests/srfi-19.test
@@ -2,7 +2,7 @@
;;;; Matthias Koeppe <address@hidden> --- June 2001
;;;;
;;;; Copyright (C) 2001, 2003, 2004, 2005, 2006, 2007, 2008,
-;;;; 2011 Free Software Foundation, Inc.
+;;;; 2011, 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
@@ -28,7 +28,8 @@
:use-module (ice-9 format))
;; Make sure we use the default locale.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
(define (with-tz* tz thunk)
"Temporarily set the TZ environment variable to the passed string
diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test
index 9b76c7a..ffb1851 100644
--- a/test-suite/tests/srfi-4.test
+++ b/test-suite/tests/srfi-4.test
@@ -1,7 +1,7 @@
;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-06-26
;;;;
-;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2010, 2011, 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
@@ -50,9 +50,9 @@
(equal? (u8vector->list (u8vector 1 2 3 4))
(u8vector->list (list->u8vector '(1 2 3 4)))))
- (pass-if "u8vector->list/uniform-vector->list"
+ (pass-if "u8vector->list/array->list"
(equal? (u8vector->list (u8vector 1 2 3 4))
- (uniform-vector->list (u8vector 1 2 3 4))))
+ (array->list (u8vector 1 2 3 4))))
(pass-if "make-u8vector"
(equal? (list->u8vector '(7 7 7 7))
@@ -87,9 +87,9 @@
(equal? (s8vector->list (s8vector 1 2 3 4))
(s8vector->list (list->s8vector '(1 2 3 4)))))
- (pass-if "s8vector->list/uniform-vector->list"
+ (pass-if "s8vector->list/array->list"
(equal? (s8vector->list (s8vector 1 2 3 4))
- (uniform-vector->list (s8vector 1 2 3 4))))
+ (array->list (s8vector 1 2 3 4))))
(pass-if "make-s8vector"
(equal? (list->s8vector '(7 7 7 7))
@@ -125,9 +125,9 @@
(equal? (u16vector->list (u16vector 1 2 3 4))
(u16vector->list (list->u16vector '(1 2 3 4)))))
- (pass-if "u16vector->list/uniform-vector->list"
+ (pass-if "u16vector->list/array->list"
(equal? (u16vector->list (u16vector 1 2 3 4))
- (uniform-vector->list (u16vector 1 2 3 4))))
+ (array->list (u16vector 1 2 3 4))))
(pass-if "make-u16vector"
(equal? (list->u16vector '(7 7 7 7))
@@ -162,9 +162,9 @@
(equal? (s16vector->list (s16vector 1 2 3 4))
(s16vector->list (list->s16vector '(1 2 3 4)))))
- (pass-if "s16vector->list/uniform-vector->list"
+ (pass-if "s16vector->list/array->list"
(equal? (s16vector->list (s16vector 1 2 3 4))
- (uniform-vector->list (s16vector 1 2 3 4))))
+ (array->list (s16vector 1 2 3 4))))
(pass-if "make-s16vector"
(equal? (list->s16vector '(7 7 7 7))
@@ -199,9 +199,9 @@
(equal? (u32vector->list (u32vector 1 2 3 4))
(u32vector->list (list->u32vector '(1 2 3 4)))))
- (pass-if "u32vector->list/uniform-vector->list"
+ (pass-if "u32vector->list/array->list"
(equal? (u32vector->list (u32vector 1 2 3 4))
- (uniform-vector->list (u32vector 1 2 3 4))))
+ (array->list (u32vector 1 2 3 4))))
(pass-if "make-u32vector"
(equal? (list->u32vector '(7 7 7 7))
@@ -236,9 +236,9 @@
(equal? (s32vector->list (s32vector 1 2 3 4))
(s32vector->list (list->s32vector '(1 2 3 4)))))
- (pass-if "s32vector->list/uniform-vector->list"
+ (pass-if "s32vector->list/array->list"
(equal? (s32vector->list (s32vector 1 2 3 4))
- (uniform-vector->list (s32vector 1 2 3 4))))
+ (array->list (s32vector 1 2 3 4))))
(pass-if "make-s32vector"
(equal? (list->s32vector '(7 7 7 7))
@@ -273,9 +273,9 @@
(equal? (u64vector->list (u64vector 1 2 3 4))
(u64vector->list (list->u64vector '(1 2 3 4)))))
- (pass-if "u64vector->list/uniform-vector->list"
+ (pass-if "u64vector->list/array->list"
(equal? (u64vector->list (u64vector 1 2 3 4))
- (uniform-vector->list (u64vector 1 2 3 4))))
+ (array->list (u64vector 1 2 3 4))))
(pass-if "make-u64vector"
(equal? (list->u64vector '(7 7 7 7))
@@ -310,9 +310,9 @@
(equal? (s64vector->list (s64vector 1 2 3 4))
(s64vector->list (list->s64vector '(1 2 3 4)))))
- (pass-if "s64vector->list/uniform-vector->list"
+ (pass-if "s64vector->list/array->list"
(equal? (s64vector->list (s64vector 1 2 3 4))
- (uniform-vector->list (s64vector 1 2 3 4))))
+ (array->list (s64vector 1 2 3 4))))
(pass-if "make-s64vector"
(equal? (list->s64vector '(7 7 7 7))
@@ -347,9 +347,9 @@
(equal? (f32vector->list (f32vector 1 2 3 4))
(f32vector->list (list->f32vector '(1 2 3 4)))))
- (pass-if "f32vector->list/uniform-vector->list"
+ (pass-if "f32vector->list/array->list"
(equal? (f32vector->list (f32vector 1 2 3 4))
- (uniform-vector->list (f32vector 1 2 3 4))))
+ (array->list (f32vector 1 2 3 4))))
(pass-if "make-f32vector"
(equal? (list->f32vector '(7 7 7 7))
@@ -387,9 +387,9 @@
(equal? (f64vector->list (f64vector 1 2 3 4))
(f64vector->list (list->f64vector '(1 2 3 4)))))
- (pass-if "f64vector->list/uniform-vector->list"
+ (pass-if "f64vector->list/array->list"
(equal? (f64vector->list (f64vector 1 2 3 4))
- (uniform-vector->list (f64vector 1 2 3 4))))
+ (array->list (f64vector 1 2 3 4))))
(pass-if "make-f64vector"
(equal? (list->f64vector '(7 7 7 7))
@@ -427,9 +427,9 @@
(equal? (c32vector->list (c32vector 1 2 3 4))
(c32vector->list (list->c32vector '(1 2 3 4)))))
- (pass-if "c32vector->list/uniform-vector->list"
+ (pass-if "c32vector->list/array->list"
(equal? (c32vector->list (c32vector 1 2 3 4))
- (uniform-vector->list (c32vector 1 2 3 4))))
+ (array->list (c32vector 1 2 3 4))))
(pass-if "make-c32vector"
(equal? (list->c32vector '(7 7 7 7))
@@ -486,9 +486,9 @@
(equal? (c64vector->list (c64vector 1 2 3 4))
(c64vector->list (list->c64vector '(1 2 3 4)))))
- (pass-if "c64vector->list/uniform-vector->list"
+ (pass-if "c64vector->list/array->list"
(equal? (c64vector->list (c64vector 1 2 3 4))
- (uniform-vector->list (c64vector 1 2 3 4))))
+ (array->list (c64vector 1 2 3 4))))
(pass-if "make-c64vector"
(equal? (list->c64vector '(7 7 7 7))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index c2e6c65..0f6d945 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,8 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <address@hidden> --- May 2009
;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation,
Inc.
+;;;; Copyright (C) 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
@@ -200,7 +201,8 @@
;;;
;; Make sure we get English messages.
-(setlocale LC_ALL "C")
+(when (defined? 'setlocale)
+ (setlocale LC_ALL "C"))
(define (call-with-warnings thunk)
(let ((port (open-output-string)))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-711-g8051cf2,
Andy Wingo <=