diff options
-rw-r--r-- | libguile/srfi-4.c | 5 | ||||
-rw-r--r-- | test-suite/standalone/Makefile.am | 7 | ||||
-rw-r--r-- | test-suite/standalone/test-srfi-4.c | 87 |
3 files changed, 97 insertions, 2 deletions
diff --git a/libguile/srfi-4.c b/libguile/srfi-4.c index 7b25a3b4d..8257b2e45 100644 --- a/libguile/srfi-4.c +++ b/libguile/srfi-4.c @@ -137,12 +137,13 @@ scm_t_array_handle *h, \ size_t *lenp, ssize_t *incp) \ { \ + size_t byte_width = width * sizeof (ctype); \ if (!scm_is_bytevector (uvec) \ - || (scm_c_bytevector_length (uvec) % width)) \ + || (scm_c_bytevector_length (uvec) % byte_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; \ + *lenp = scm_c_bytevector_length (uvec) / byte_width; \ if (incp) \ *incp = 1; \ return ((ctype *)h->writable_elements); \ diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index a2cde42b9..7c4633a25 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -211,6 +211,13 @@ test_scm_c_bind_keyword_arguments_LDADD = $(LIBGUILE_LDADD) check_PROGRAMS += test-scm-c-bind-keyword-arguments TESTS += test-scm-c-bind-keyword-arguments +# test-srfi-4 +test_srfi_4_SOURCES = test-srfi-4.c +test_srfi_4_CFLAGS = ${test_cflags} +test_srfi_4_LDADD = $(LIBGUILE_LDADD) +check_PROGRAMS += test-srfi-4 +TESTS += test-srfi-4 + if HAVE_SHARED_LIBRARIES # test-extensions diff --git a/test-suite/standalone/test-srfi-4.c b/test-suite/standalone/test-srfi-4.c new file mode 100644 index 000000000..22e079c1b --- /dev/null +++ b/test-suite/standalone/test-srfi-4.c @@ -0,0 +1,87 @@ +/* Copyright (C) 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 + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#ifdef HAVE_CONFIG_H +# include <config.h> +#endif + +#include <libguile.h> + +#include <stdio.h> +#include <assert.h> + +static void +test_writable_elements () +{ + SCM elts = scm_list_4 (scm_from_int (1), scm_from_int (2), + scm_from_int (3), scm_from_int (4)); + + { + SCM v = scm_u32vector (elts); + size_t len; + ssize_t inc; + scm_t_array_handle h; + scm_t_uint32 *elts = scm_u32vector_writable_elements (v, &h, &len, &inc); + assert (len == 4); + assert (inc == 1); + assert (elts[0] == 1); + assert (elts[3] == 4); + scm_array_handle_release (&h); + } + + { + SCM v = scm_f32vector (elts); + size_t len; + ssize_t inc; + scm_t_array_handle h; + float *elts = scm_f32vector_writable_elements (v, &h, &len, &inc); + assert (len == 4); + assert (inc == 1); + assert (elts[0] == 1.0); + assert (elts[3] == 4.0); + scm_array_handle_release (&h); + } + + { + SCM v = scm_c32vector (elts); + size_t len; + ssize_t inc; + scm_t_array_handle h; + float *elts = scm_c32vector_writable_elements (v, &h, &len, &inc); + assert (len == 4); + assert (inc == 1); + assert (elts[0] == 1.0); + assert (elts[1] == 0.0); + assert (elts[6] == 4.0); + assert (elts[7] == 0.0); + scm_array_handle_release (&h); + } +} + +static void +tests (void *data, int argc, char **argv) +{ + test_writable_elements (); +} + +int +main (int argc, char *argv[]) +{ + scm_boot_guile (argc, argv, tests, NULL); + return 0; +} |