mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-14 23:50:19 +02:00
Merge commit 'fb7dd00169
'
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
This commit is contained in:
commit
8051cf2304
11 changed files with 91 additions and 331 deletions
|
@ -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,
|
||||
@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.
|
||||
|
||||
@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.
|
||||
@var{uvec_type} should be something that
|
||||
@code{uniform-vector-element-type} 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
|
||||
|
|
|
@ -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
|
||||
|
||||
@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
|
||||
@subsubsection SRFI-4 - Relation to bytevectors
|
||||
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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)
|
||||
{
|
||||
|
|
|
@ -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 */
|
||||
|
||||
/*
|
||||
|
|
|
@ -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)
|
||||
(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)
|
||||
(if (bitvector? obj)
|
||||
;; Bitvectors are addressed in
|
||||
;; 32-bit units.
|
||||
4
|
||||
(uniform-vector-element-size 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)
|
||||
|
|
|
@ -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))))))))
|
||||
|
||||
;;;
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue