Fix bytevector-copy when applied to SRFI-4 homogeneous numeric vectors.

Fixes <http://bugs.gnu.org/18866>.
Reported by tantalum <sph@posteo.eu>.

* libguile/bytevectors.c (scm_bytevector_copy): Always create a VU8
  bytevector.

* test-suite/tests/bytevectors.test: Add test.

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index b210440..b976c21 100644 (file)
--- 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 637d6d4..8abda4a 100644 (file)
--- 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))))
 
+\f
+(with-test-prefix "srfi-4 homogeneous numeric vectors as bytevectors"
+
+  ;; This failed prior to Guile 2.0.12.
+  ;; See <http://bugs.gnu.org/18866>.
+  (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: