1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-25 12:40:26 +02:00

Fix breakage of SRFI-4 C accessors

* libguile/srfi-4.c (DEFINE_SRFI_4_C_FUNCS): Fix bad assumption that
  width was a byte width.  Thanks very much to Barry Fishman for the
  report, and to Daniel Llorens for tracking it down.

* test-suite/standalone/Makefile.am (test_srfi_4_CFLAGS):
* test-suite/standalone/test-srfi-4.c: Add test.
This commit is contained in:
Andy Wingo 2014-03-19 22:41:19 +01:00
parent 92b793da2b
commit 2be7131ee0
3 changed files with 97 additions and 2 deletions

View file

@ -137,12 +137,13 @@
scm_t_array_handle *h, \ scm_t_array_handle *h, \
size_t *lenp, ssize_t *incp) \ size_t *lenp, ssize_t *incp) \
{ \ { \
size_t byte_width = width * sizeof (ctype); \
if (!scm_is_bytevector (uvec) \ 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_wrong_type_arg_msg (NULL, 0, uvec, #tag "vector"); \
scm_array_get_handle (uvec, h); \ scm_array_get_handle (uvec, h); \
if (lenp) \ if (lenp) \
*lenp = scm_c_bytevector_length (uvec) / width; \ *lenp = scm_c_bytevector_length (uvec) / byte_width; \
if (incp) \ if (incp) \
*incp = 1; \ *incp = 1; \
return ((ctype *)h->writable_elements); \ return ((ctype *)h->writable_elements); \

View file

@ -211,6 +211,13 @@ test_scm_c_bind_keyword_arguments_LDADD = $(LIBGUILE_LDADD)
check_PROGRAMS += test-scm-c-bind-keyword-arguments check_PROGRAMS += test-scm-c-bind-keyword-arguments
TESTS += 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 if HAVE_SHARED_LIBRARIES
# test-extensions # test-extensions

View file

@ -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;
}