1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 03:54:12 +02:00

Deprecate general "uniform-vector" interface

* libguile/uniform.h:
* libguile/uniform.c (scm_is_uniform_vector, scm_uniform_vector_p)
  (scm_c_uniform_vector_length, scm_uniform_vector_length)
  (scm_uniform_vector_element_type, scm_uniform_vector_element_size)
  (scm_c_uniform_vector_ref, scm_uniform_vector_ref):
  (scm_c_uniform_vector_set_x, scm_uniform_vector_set_x):
  (scm_uniform_vector_to_list)
  (scm_uniform_vector_elements, scm_uniform_vector_writable_elements):
  Deprecate.  This interface lacked both generality and specificity.
  The general replacement is array-length, array-ref, and friends on the
  scheme side, or the array handle interface on the C side.  On the
  specific side of things, there are the specific bytevector, srfi-4,
  and bitvector interfaces.

* test-suite/tests/arrays.test:
* test-suite/tests/bitvectors.test:
* test-suite/tests/ports.test:
* test-suite/tests/srfi-4.test: Update to use array interfaces.

* doc/ref/api-foreign.texi (Void Pointers and Byte Access):
* doc/ref/srfi-modules.texi (SRFI-4): Update.
This commit is contained in:
Andy Wingo 2014-02-08 14:18:40 +01:00
parent dc65b88d83
commit fb7dd00169
8 changed files with 134 additions and 141 deletions

View file

@ -1,7 +1,7 @@
@c -*-texinfo-*- @c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual. @c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008, @c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008,
@c 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. @c 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions. @c See the file guile.texi for copying conditions.
@node Foreign Function Interface @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 Return a bytevector aliasing the @var{len} bytes pointed to by
@var{pointer}. @var{pointer}.
The user may specify an alternate default interpretation for The user may specify an alternate default interpretation for the memory
the memory by passing the @var{uvec_type} argument, to indicate by passing the @var{uvec_type} argument, to indicate that the memory is
that the memory is an array of elements of that type. an array of elements of that type. @var{uvec_type} should be something
@var{uvec_type} should be something that that @code{array-type} would return, like @code{f32} or @code{s16}.
@code{uniform-vector-element-type} would return, like @code{f32}
or @code{s16}.
When @var{offset} is passed, it specifies the offset in bytes relative When @var{offset} is passed, it specifies the offset in bytes relative
to @var{pointer} of the memory region aliased by the returned to @var{pointer} of the memory region aliased by the returned

View file

@ -1345,7 +1345,6 @@ C had modules!)
@menu @menu
* SRFI-4 Overview:: The warp and weft of uniform numeric vectors. * SRFI-4 Overview:: The warp and weft of uniform numeric vectors.
* SRFI-4 API:: Uniform vectors, from Scheme and from C. * 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 and Bytevectors:: SRFI-4 vectors are backed by bytevectors.
* SRFI-4 Extensions:: Guile-specific extensions to the standard. * SRFI-4 Extensions:: Guile-specific extensions to the standard.
@end menu @end menu
@ -1730,65 +1729,6 @@ C}), but returns a pointer to the elements of a uniform numeric vector
of the indicated kind. of the indicated kind.
@end deftypefn @end deftypefn
@node SRFI-4 Generic Operations
@subsubsection 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.
@deftypefn {C Function} int scm_is_uniform_vector (SCM uvec)
Return non-zero when @var{uvec} is a uniform numeric vector, zero
otherwise.
@end deftypefn
@deftypefn {C Function} size_t scm_c_uniform_vector_length (SCM uvec)
Return the number of elements of @var{uvec} as a @code{size_t}.
@end deftypefn
@deffn {Scheme Procedure} uniform-vector? obj
@deffnx {C Function} scm_uniform_vector_p (obj)
Return @code{#t} if @var{obj} is a homogeneous numeric vector of the
indicated type.
@end deffn
@deffn {Scheme Procedure} uniform-vector-length vec
@deffnx {C Function} scm_uniform_vector_length (vec)
Return the number of elements in @var{vec}.
@end deffn
@deffn {Scheme Procedure} uniform-vector-ref vec i
@deffnx {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.
@end deffn
@deffn {Scheme Procedure} uniform-vector-set! vec i value
@deffnx {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.
@end deffn
@deffn {Scheme Procedure} uniform-vector->list vec
@deffnx {C Function} scm_uniform_vector_to_list (vec)
Return a newly allocated list holding all elements of @var{vec}.
@end deffn
@deftypefn {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.
@end deftypefn
@deftypefn {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.
@end 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 @node SRFI-4 and Bytevectors
@subsubsection SRFI-4 - Relation to bytevectors @subsubsection SRFI-4 - Relation to bytevectors

View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -23,10 +23,13 @@
# include <config.h> # include <config.h>
#endif #endif
#define SCM_BUILDING_DEPRECATED_CODE
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/__scm.h" #include "libguile/__scm.h"
#include "libguile/uniform.h" #include "libguile/uniform.h"
#include "libguile/deprecation.h"
const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = { const size_t scm_i_array_element_type_sizes[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = {
@ -81,12 +84,18 @@ scm_array_handle_uniform_writable_elements (scm_t_array_handle *h)
return ret; return ret;
} }
#if SCM_ENABLE_DEPRECATED
int int
scm_is_uniform_vector (SCM obj) scm_is_uniform_vector (SCM obj)
{ {
scm_t_array_handle h; scm_t_array_handle h;
int ret = 0; int ret = 0;
scm_c_issue_deprecation_warning
("scm_is_uniform_vector is deprecated. "
"Use scm_is_bytevector || scm_is_bitvector instead.");
if (scm_is_generalized_vector (obj)) if (scm_is_generalized_vector (obj))
{ {
scm_generalized_vector_get_handle (obj, &h); scm_generalized_vector_get_handle (obj, &h);
@ -99,6 +108,10 @@ scm_is_uniform_vector (SCM obj)
size_t size_t
scm_c_uniform_vector_length (SCM uvec) scm_c_uniform_vector_length (SCM uvec)
{ {
scm_c_issue_deprecation_warning
("scm_c_uniform_vector_length is deprecated. "
"Use scm_c_array_length instead.");
if (!scm_is_uniform_vector (uvec)) if (!scm_is_uniform_vector (uvec))
scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec, scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
"uniform vector"); "uniform vector");
@ -111,6 +124,10 @@ SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
"Return @code{#t} if @var{obj} is a uniform vector.") "Return @code{#t} if @var{obj} is a uniform vector.")
#define FUNC_NAME s_scm_uniform_vector_p #define FUNC_NAME s_scm_uniform_vector_p
{ {
scm_c_issue_deprecation_warning
("uniform-vector? is deprecated. Use bytevector? and bitvector?, or "
"use array-type and array-rank instead.");
return scm_from_bool (scm_is_uniform_vector (obj)); return scm_from_bool (scm_is_uniform_vector (obj));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -123,6 +140,9 @@ SCM_DEFINE (scm_uniform_vector_element_type, "uniform-vector-element-type", 1, 0
scm_t_array_handle h; scm_t_array_handle h;
SCM ret; SCM ret;
scm_c_issue_deprecation_warning
("uniform-vector-element-type is deprecated. Use array-type instead.");
if (!scm_is_uniform_vector (v)) if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector"); scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, v, "uniform vector");
scm_array_get_handle (v, &h); scm_array_get_handle (v, &h);
@ -142,6 +162,11 @@ SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0
size_t len; size_t len;
ssize_t inc; ssize_t inc;
SCM ret; SCM ret;
scm_c_issue_deprecation_warning
("uniform-vector-element-size is deprecated. Instead, treat the "
"uniform vector as a bytevector.");
scm_uniform_vector_elements (v, &h, &len, &inc); scm_uniform_vector_elements (v, &h, &len, &inc);
ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h)); ret = scm_from_size_t (scm_array_handle_uniform_element_size (&h));
scm_array_handle_release (&h); scm_array_handle_release (&h);
@ -152,6 +177,9 @@ SCM_DEFINE (scm_uniform_vector_element_size, "uniform-vector-element-size", 1, 0
SCM SCM
scm_c_uniform_vector_ref (SCM v, size_t idx) scm_c_uniform_vector_ref (SCM v, size_t idx)
{ {
scm_c_issue_deprecation_warning
("scm_c_uniform_vector_ref is deprecated. Use scm_c_array_ref_1 instead.");
if (!scm_is_uniform_vector (v)) if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
return scm_c_generalized_vector_ref (v, idx); return scm_c_generalized_vector_ref (v, idx);
@ -163,6 +191,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
"homogeneous numeric vector @var{v}.") "homogeneous numeric vector @var{v}.")
#define FUNC_NAME s_scm_uniform_vector_ref #define FUNC_NAME s_scm_uniform_vector_ref
{ {
scm_c_issue_deprecation_warning
("uniform-vector-ref is deprecated. Use array-ref instead.");
return scm_c_uniform_vector_ref (v, scm_to_size_t (idx)); return scm_c_uniform_vector_ref (v, scm_to_size_t (idx));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -170,6 +201,10 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
void void
scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val) scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val)
{ {
scm_c_issue_deprecation_warning
("scm_c_uniform_vector_set_x is deprecated. Instead, use "
"scm_c_array_set_1_x, but note the change in the order of the arguments.");
if (!scm_is_uniform_vector (v)) if (!scm_is_uniform_vector (v))
scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector"); scm_wrong_type_arg_msg (NULL, 0, v, "uniform vector");
scm_c_generalized_vector_set_x (v, idx, val); scm_c_generalized_vector_set_x (v, idx, val);
@ -181,6 +216,10 @@ SCM_DEFINE (scm_uniform_vector_set_x, "uniform-vector-set!", 3, 0, 0,
"homogeneous numeric vector @var{v} to @var{val}.") "homogeneous numeric vector @var{v} to @var{val}.")
#define FUNC_NAME s_scm_uniform_vector_set_x #define FUNC_NAME s_scm_uniform_vector_set_x
{ {
scm_c_issue_deprecation_warning
("uniform-vector-set! is deprecated. Instead, use array-set!, "
"but note the change in the order of the arguments.");
scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val); scm_c_uniform_vector_set_x (v, scm_to_size_t (idx), val);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -191,6 +230,9 @@ SCM_DEFINE (scm_uniform_vector_to_list, "uniform-vector->list", 1, 0, 0,
"Convert the uniform numeric vector @var{uvec} to a list.") "Convert the uniform numeric vector @var{uvec} to a list.")
#define FUNC_NAME s_scm_uniform_vector_to_list #define FUNC_NAME s_scm_uniform_vector_to_list
{ {
scm_c_issue_deprecation_warning
("uniform-vector->list is deprecated. Use array->list instead.");
if (!scm_is_uniform_vector (uvec)) if (!scm_is_uniform_vector (uvec))
scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector"); scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, uvec, "uniform vector");
return scm_array_to_list (uvec); return scm_array_to_list (uvec);
@ -202,6 +244,10 @@ scm_uniform_vector_elements (SCM uvec,
scm_t_array_handle *h, scm_t_array_handle *h,
size_t *lenp, ssize_t *incp) size_t *lenp, ssize_t *incp)
{ {
scm_c_issue_deprecation_warning
("scm_uniform_vector_elements is deprecated. Use "
"scm_array_handle_uniform_elements instead.");
return scm_uniform_vector_writable_elements (uvec, h, lenp, incp); return scm_uniform_vector_writable_elements (uvec, h, lenp, incp);
} }
@ -211,6 +257,11 @@ scm_uniform_vector_writable_elements (SCM uvec,
size_t *lenp, ssize_t *incp) size_t *lenp, ssize_t *incp)
{ {
void *ret; void *ret;
scm_c_issue_deprecation_warning
("scm_uniform_vector_writable_elements is deprecated. Use "
"scm_array_handle_uniform_writable_elements instead.");
scm_generalized_vector_get_handle (uvec, h); scm_generalized_vector_get_handle (uvec, h);
/* FIXME nonlocal exit */ /* FIXME nonlocal exit */
ret = scm_array_handle_uniform_writable_elements (h); ret = scm_array_handle_uniform_writable_elements (h);
@ -228,11 +279,17 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
"Return the number of elements in the uniform vector @var{v}.") "Return the number of elements in the uniform vector @var{v}.")
#define FUNC_NAME s_scm_uniform_vector_length #define FUNC_NAME s_scm_uniform_vector_length
{ {
scm_c_issue_deprecation_warning
("uniform-vector-length is deprecated. Use array-length instead.");
return scm_from_size_t (scm_c_uniform_vector_length (v)); return scm_from_size_t (scm_c_uniform_vector_length (v));
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* SCM_ENABLE_DEPRECATED */
void void
scm_init_uniform (void) scm_init_uniform (void)
{ {

View file

@ -3,7 +3,8 @@
#ifndef SCM_UNIFORM_H #ifndef SCM_UNIFORM_H
#define SCM_UNIFORM_H #define SCM_UNIFORM_H
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
* 2014 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -44,29 +45,34 @@ 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 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 void *scm_array_handle_uniform_writable_elements (scm_t_array_handle *h);
SCM_API SCM scm_uniform_vector_p (SCM v); #if SCM_ENABLE_DEPRECATED
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_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_DEPRECATED SCM scm_uniform_vector_p (SCM v);
SCM_API size_t scm_c_uniform_vector_length (SCM v); SCM_DEPRECATED SCM scm_uniform_vector_length (SCM v);
SCM_API SCM scm_c_uniform_vector_ref (SCM v, size_t idx); SCM_DEPRECATED SCM scm_uniform_vector_element_type (SCM v);
SCM_API void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val); SCM_DEPRECATED SCM scm_uniform_vector_element_size (SCM v);
SCM_API const void *scm_uniform_vector_elements (SCM uvec, SCM_DEPRECATED SCM scm_uniform_vector_ref (SCM v, SCM idx);
scm_t_array_handle *h, SCM_DEPRECATED SCM scm_uniform_vector_set_x (SCM v, SCM idx, SCM val);
size_t *lenp, ssize_t *incp); SCM_DEPRECATED SCM scm_uniform_vector_to_list (SCM v);
SCM_API void *scm_uniform_vector_writable_elements (SCM uvec, SCM_DEPRECATED SCM scm_uniform_vector_read_x (SCM v, SCM port_or_fd,
scm_t_array_handle *h, SCM start, SCM end);
size_t *lenp, SCM_DEPRECATED SCM scm_uniform_vector_write (SCM v, SCM port_or_fd,
ssize_t *incp); SCM start, SCM end);
SCM_DEPRECATED int scm_is_uniform_vector (SCM obj);
SCM_DEPRECATED size_t scm_c_uniform_vector_length (SCM v);
SCM_DEPRECATED SCM scm_c_uniform_vector_ref (SCM v, size_t idx);
SCM_DEPRECATED void scm_c_uniform_vector_set_x (SCM v, size_t idx, SCM val);
SCM_DEPRECATED const void *scm_uniform_vector_elements (SCM uvec,
scm_t_array_handle *h,
size_t *lenp,
ssize_t *incp);
SCM_DEPRECATED void *scm_uniform_vector_writable_elements (SCM uvec,
scm_t_array_handle *h,
size_t *lenp,
ssize_t *incp);
#endif
SCM_INTERNAL void scm_init_uniform (void); SCM_INTERNAL void scm_init_uniform (void);

View file

@ -1,6 +1,6 @@
;;;; unif.test --- tests guile's uniform arrays -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -33,13 +33,6 @@
(cons 'read-error ".*array length must be non-negative.*")) (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?" (with-test-prefix "array?"
(let ((bool (make-typed-array 'b #t '(5 6))) (let ((bool (make-typed-array 'b #t '(5 6)))
@ -574,10 +567,10 @@
(eqv? 8 (array-ref s2 2)))))) (eqv? 8 (array-ref s2 2))))))
;;; ;;;
;;; uniform-vector-ref ;;; typed array-ref
;;; ;;;
(with-test-prefix "uniform-vector-ref" (with-test-prefix "typed array-ref"
(with-test-prefix "byte" (with-test-prefix "byte"
@ -586,15 +579,15 @@
(pass-if "0" (pass-if "0"
(begin (begin
(array-set! a 0 0) (array-set! a 0 0)
(= 0 (uniform-vector-ref a 0)))) (= 0 (array-ref a 0))))
(pass-if "127" (pass-if "127"
(begin (begin
(array-set! a 127 0) (array-set! a 127 0)
(= 127 (uniform-vector-ref a 0)))) (= 127 (array-ref a 0))))
(pass-if "-128" (pass-if "-128"
(begin (begin
(array-set! a -128 0) (array-set! a -128 0)
(= -128 (uniform-vector-ref a 0))))))) (= -128 (array-ref a 0)))))))
;;; ;;;
;;; syntax ;;; syntax

View file

@ -1,6 +1,6 @@
;;;; bitvectors.test --- tests guile's bitvectors -*- scheme -*- ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -22,8 +22,8 @@
(with-test-prefix "predicates" (with-test-prefix "predicates"
(pass-if (bitvector? #*1010101010)) (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" (with-test-prefix "equality"
@ -36,23 +36,22 @@
(with-test-prefix "lists" (with-test-prefix "lists"
(pass-if (equal? (bitvector->list #*10010) '(#t #f #f #t #f))) (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? (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))))) (pass-if (equal? #*10010 (list->bitvector '(#t #f #f #t #f)))))
(with-test-prefix "ref and set" (with-test-prefix "ref and set"
(with-test-prefix "bv" (with-test-prefix "as bitvector"
(let ((bv (list->bitvector '(#f #f #t #f #t)))) (let ((bv (list->bitvector '(#f #f #t #f #t))))
(pass-if (eqv? (bitvector-ref bv 0) #f)) (pass-if (eqv? (bitvector-ref bv 0) #f))
(pass-if (eqv? (bitvector-ref bv 2) #t)) (pass-if (eqv? (bitvector-ref bv 2) #t))
(bitvector-set! bv 0 #t) (bitvector-set! bv 0 #t)
(pass-if (eqv? (bitvector-ref 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)))) (let ((bv (list->bitvector '(#f #f #t #f #t))))
(pass-if (eqv? (uniform-vector-ref bv 0) #f)) (pass-if (eqv? (array-ref bv 0) #f))
(pass-if (eqv? (uniform-vector-ref bv 2) #t)) (pass-if (eqv? (array-ref bv 2) #t))
(uniform-vector-set! bv 0 #t) (array-set! bv #t 0)
(pass-if (eqv? (uniform-vector-ref bv 0) #t))))) (pass-if (eqv? (array-ref bv 0) #t)))))
(with-test-prefix "bit-set*!" (with-test-prefix "bit-set*!"
(pass-if "#t" (pass-if "#t"

View file

@ -243,7 +243,7 @@
(binary-test-string (binary-test-string
(apply string (apply string
(map integer->char (map integer->char
(uniform-vector->list (array->list
(string->utf8 test-string)))))) (string->utf8 test-string))))))
(write-line test-string port) (write-line test-string port)
(close-port port) (close-port port)
@ -262,7 +262,7 @@
(binary-test-string (binary-test-string
(apply string (apply string
(map integer->char (map integer->char
(uniform-vector->list (array->list
(string->utf8 test-string)))))) (string->utf8 test-string))))))
(write-line ";; coding: utf-8" port) (write-line ";; coding: utf-8" port)
(write-line test-string port) (write-line test-string port)

View file

@ -1,7 +1,7 @@
;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*- ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-06-26 ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -50,9 +50,9 @@
(equal? (u8vector->list (u8vector 1 2 3 4)) (equal? (u8vector->list (u8vector 1 2 3 4))
(u8vector->list (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)) (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" (pass-if "make-u8vector"
(equal? (list->u8vector '(7 7 7 7)) (equal? (list->u8vector '(7 7 7 7))
@ -87,9 +87,9 @@
(equal? (s8vector->list (s8vector 1 2 3 4)) (equal? (s8vector->list (s8vector 1 2 3 4))
(s8vector->list (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)) (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" (pass-if "make-s8vector"
(equal? (list->s8vector '(7 7 7 7)) (equal? (list->s8vector '(7 7 7 7))
@ -125,9 +125,9 @@
(equal? (u16vector->list (u16vector 1 2 3 4)) (equal? (u16vector->list (u16vector 1 2 3 4))
(u16vector->list (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)) (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" (pass-if "make-u16vector"
(equal? (list->u16vector '(7 7 7 7)) (equal? (list->u16vector '(7 7 7 7))
@ -162,9 +162,9 @@
(equal? (s16vector->list (s16vector 1 2 3 4)) (equal? (s16vector->list (s16vector 1 2 3 4))
(s16vector->list (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)) (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" (pass-if "make-s16vector"
(equal? (list->s16vector '(7 7 7 7)) (equal? (list->s16vector '(7 7 7 7))
@ -199,9 +199,9 @@
(equal? (u32vector->list (u32vector 1 2 3 4)) (equal? (u32vector->list (u32vector 1 2 3 4))
(u32vector->list (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)) (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" (pass-if "make-u32vector"
(equal? (list->u32vector '(7 7 7 7)) (equal? (list->u32vector '(7 7 7 7))
@ -236,9 +236,9 @@
(equal? (s32vector->list (s32vector 1 2 3 4)) (equal? (s32vector->list (s32vector 1 2 3 4))
(s32vector->list (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)) (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" (pass-if "make-s32vector"
(equal? (list->s32vector '(7 7 7 7)) (equal? (list->s32vector '(7 7 7 7))
@ -273,9 +273,9 @@
(equal? (u64vector->list (u64vector 1 2 3 4)) (equal? (u64vector->list (u64vector 1 2 3 4))
(u64vector->list (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)) (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" (pass-if "make-u64vector"
(equal? (list->u64vector '(7 7 7 7)) (equal? (list->u64vector '(7 7 7 7))
@ -310,9 +310,9 @@
(equal? (s64vector->list (s64vector 1 2 3 4)) (equal? (s64vector->list (s64vector 1 2 3 4))
(s64vector->list (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)) (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" (pass-if "make-s64vector"
(equal? (list->s64vector '(7 7 7 7)) (equal? (list->s64vector '(7 7 7 7))
@ -347,9 +347,9 @@
(equal? (f32vector->list (f32vector 1 2 3 4)) (equal? (f32vector->list (f32vector 1 2 3 4))
(f32vector->list (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)) (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" (pass-if "make-f32vector"
(equal? (list->f32vector '(7 7 7 7)) (equal? (list->f32vector '(7 7 7 7))
@ -387,9 +387,9 @@
(equal? (f64vector->list (f64vector 1 2 3 4)) (equal? (f64vector->list (f64vector 1 2 3 4))
(f64vector->list (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)) (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" (pass-if "make-f64vector"
(equal? (list->f64vector '(7 7 7 7)) (equal? (list->f64vector '(7 7 7 7))
@ -427,9 +427,9 @@
(equal? (c32vector->list (c32vector 1 2 3 4)) (equal? (c32vector->list (c32vector 1 2 3 4))
(c32vector->list (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)) (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" (pass-if "make-c32vector"
(equal? (list->c32vector '(7 7 7 7)) (equal? (list->c32vector '(7 7 7 7))
@ -486,9 +486,9 @@
(equal? (c64vector->list (c64vector 1 2 3 4)) (equal? (c64vector->list (c64vector 1 2 3 4))
(c64vector->list (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)) (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" (pass-if "make-c64vector"
(equal? (list->c64vector '(7 7 7 7)) (equal? (list->c64vector '(7 7 7 7))