From 10679f4c59fcffb0657219e28e38d15df8ad09a0 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 11 Nov 2014 23:14:26 -0500 Subject: [PATCH] Fix bytevector-copy when applied to SRFI-4 homogeneous numeric vectors. Fixes . Reported by tantalum . * libguile/bytevectors.c (scm_bytevector_copy): Always create a VU8 bytevector. * test-suite/tests/bytevectors.test: Add test. --- libguile/bytevectors.c | 4 ++-- test-suite/tests/bytevectors.test | 15 ++++++++++++--- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index b21044038..b976c2110 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2009, 2010, 2011, 2012, 2014 Free Software Foundation, Inc. +/* Copyright (C) 2009-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 @@ -606,7 +606,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0, c_len = SCM_BYTEVECTOR_LENGTH (bv); c_bv = SCM_BYTEVECTOR_CONTENTS (bv); - copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv)); + copy = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8); c_copy = SCM_BYTEVECTOR_CONTENTS (copy); memcpy (c_copy, c_bv, c_len); diff --git a/test-suite/tests/bytevectors.test b/test-suite/tests/bytevectors.test index 637d6d4dd..8abda4a8e 100644 --- a/test-suite/tests/bytevectors.test +++ b/test-suite/tests/bytevectors.test @@ -1,7 +1,6 @@ ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, -;;;; 2014 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc. ;;;; ;;;; Ludovic Courtès ;;;; @@ -22,7 +21,8 @@ (define-module (test-bytevector) :use-module (test-suite lib) :use-module (system base compile) - :use-module (rnrs bytevectors)) + :use-module (rnrs bytevectors) + :use-module (srfi srfi-4)) ;;; Some of the tests in here are examples taken from the R6RS Standard ;;; Libraries document. @@ -689,6 +689,15 @@ (let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) (= (bytevector-length bv) 2)))) + +(with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors" + + ;; This failed prior to Guile 2.0.12. + ;; See . + (pass-if-equal "bytevector-copy on srfi-4 arrays" + (make-bytevector 8 #xFF) + (bytevector-copy (make-u32vector 2 #xFFFFFFFF)))) + ;;; Local Variables: ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1) ;;; End: -- 2.20.1