mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source 
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.
This commit is contained in:
Mark H Weaver 2014-11-11 23:14:26 -05:00
parent 03242f398f
commit 10679f4c59
2 changed files with 14 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/bytevectors.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = SCM_BYTEVECTOR_CONTENTS (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); c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
memcpy (c_copy, c_bv, c_len); memcpy (c_copy, c_bv, c_len);

15
test-suite/tests/bytevectors.test
View file

@ -1,7 +1,6 @@
;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013, ;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;;;; 2014 Free Software Foundation, Inc.
;;;; ;;;;
;;;; Ludovic Courtès ;;;; Ludovic Courtès
;;;; ;;;;
@ -22,7 +21,8 @@
(define-module (test-bytevector) (define-module (test-bytevector)
:use-module (test-suite lib) :use-module (test-suite lib)
:use-module (system base compile) :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 ;;; Some of the tests in here are examples taken from the R6RS Standard
;;; Libraries document. ;;; Libraries document.
@ -689,6 +689,15 @@
(let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
(= (bytevector-length bv) 2)))) (= (bytevector-length bv) 2))))
(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: ;;; Local Variables:
;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1) ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
;;; End: ;;; End: