[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-81-gcd48c32

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=cd48c32cf4c1f627e9f9eeb8f7e077e0a414eab8

The branch, master has been updated
       via  cd48c32cf4c1f627e9f9eeb8f7e077e0a414eab8 (commit)
       via  29553c54b597880d329013c6b4b435e2949a9872 (commit)
       via  0f3eacf74c634a3c40aa2f4abefe4d0e7d69f1bf (commit)
      from  1ebe6a63686b341b55848b0dc0532e7b0d665c15 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit cd48c32cf4c1f627e9f9eeb8f7e077e0a414eab8
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 15 23:29:50 2009 +0200

    Fix compilation of literal bitvectors.
    
    * libguile/arrays.c (scm_from_contiguous_typed_array): Fix BYTE_LEN
      sanity check for bitvectors.
    
    * test-suite/tests/unif.test ("syntax")["bitvector is self-evaluating"]:
      New test.
    
    * module/ice-9/deprecated.scm (#\y): Fix deprecation comment: `#*' is
      not a read syntax.

commit 29553c54b597880d329013c6b4b435e2949a9872
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 15 23:24:19 2009 +0200

    Fix segfault for `(uniform-array->bytevector (bitvector))'.
    
    * libguile/bytevectors.c (scm_uniform_array_to_bytevector): Fix BYTE_LEN
      computation for bitvectors.
    
    * test-suite/tests/bytevectors.test ("uniform-array->bytevector"): New
      test prefix.

commit 0f3eacf74c634a3c40aa2f4abefe4d0e7d69f1bf
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 15 21:55:54 2009 +0200

    Fix `gitlog-to-changelog' on NixOS.

-----------------------------------------------------------------------

Summary of changes:
 build-aux/gitlog-to-changelog     |    5 ++++-
 libguile/arrays.c                 |    3 ++-
 libguile/bytevectors.c            |    5 ++---
 module/ice-9/deprecated.scm       |    2 +-
 test-suite/tests/bytevectors.test |   25 ++++++++++++++++++++++---
 test-suite/tests/unif.test        |    7 +++++--
 6 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index 1cc53eb..270b8cf 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -1,4 +1,7 @@
-#!/usr/bin/perl
+#!/bin/sh
+# Accommodate systems where /usr/bin/perl is not the right path.
+exec perl -x "$0" "$@"
+#!perl
 # Convert git log output to ChangeLog format.
 
 my $VERSION = '2009-06-04 08:53'; # UTC
diff --git a/libguile/arrays.c b/libguile/arrays.c
index b9386ea..1fd6d92 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -243,7 +243,8 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
     }
   else
     {
-      if (rlen * (sz / 8) + rlen * (sz % 8) / 8 != byte_len)
+      /* byte_len ?= ceil (rlen * sz / 8) */
+      if (byte_len != (rlen * sz + 7) / 8)
         SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
     }
 
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index a3233ea..e099819 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -605,9 +605,8 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, 
"uniform-array->bytevector",
   if (sz >= 8 && ((sz % 8) == 0))
     byte_len = len * (sz / 8);
   else
-    /* uf. tricky, and i'm not sure i'm avoiding overflow. */
-    byte_len = len * (sz / 8)
-      + (((len * (sz % 8)) - 1) / 8) + 1;
+    /* byte_len = ceil (len * sz / 8) */
+    byte_len = (len * sz + 7) / 8;
 
   ret = make_bytevector (byte_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), elts, byte_len);
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index c55e13b..838df2d 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -190,7 +190,7 @@
  #\y
  (lambda (c port)
    (issue-deprecation-warning
-    "The `#y' bitvector syntax is deprecated.  Use `#*' instead.")
+    "The `#y' bitvector syntax is deprecated.  Use `bitvector' instead.")
    (let ((x (read port)))
      (cond
       ((list? x)
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index 26d7cf6..fe54b02 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -672,11 +672,30 @@
 
   (pass-if-exception "make-typed-array [out-of-range]"
     exception:out-of-range
-    (make-typed-array 'vu8 256 77))
+    (make-typed-array 'vu8 256 77)))
 
-  (pass-if "uniform-array->bytevector"
+
+(with-test-prefix "uniform-array->bytevector"
+
+  (pass-if "bytevector"
     (let ((bv #vu8(0 1 128 255)))
-      (equal? bv (uniform-array->bytevector bv)))))
+      (equal? bv (uniform-array->bytevector bv))))
+
+  (pass-if "empty bitvector"
+    (let ((bv (uniform-array->bytevector (make-bitvector 0))))
+      (equal? bv #vu8())))
+
+  (pass-if "bitvector < 8"
+    (let ((bv (uniform-array->bytevector (make-bitvector 4 #t))))
+      (= (bytevector-length bv) 1)))
+
+  (pass-if "bitvector == 8"
+    (let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
+      (= (bytevector-length bv) 1)))
+
+  (pass-if "bitvector > 8"
+    (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
+      (= (bytevector-length bv) 2))))
 
 
 ;;; Local Variables:
diff --git a/test-suite/tests/unif.test b/test-suite/tests/unif.test
index 5d584e8..092f7aa 100644
--- a/test-suite/tests/unif.test
+++ b/test-suite/tests/unif.test
@@ -17,7 +17,8 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
 
 (define-module (test-suite test-unif)
-    #:use-module (test-suite lib))
+  #:use-module ((system base compile) #:select (compile))
+  #:use-module (test-suite lib))
 
 ;;;
 ;;; array?
@@ -546,8 +547,10 @@
             (eq? 'b (array-ref a -2)))))
 
   (pass-if-exception "negative length" exception:length-non-negative
-     (with-input-from-string "'#1:-3(#t #t)" read)))
+     (with-input-from-string "'#1:-3(#t #t)" read))
 
+  (pass-if "bitvector is self-evaluating"
+     (equal? (compile (bitvector)) (bitvector))))
 
 ;;;
 ;;; equal? with vector and one-dimensional array


hooks/post-receive
-- 
GNU Guile