[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-296-g5cc9877

[Andy Wingo]

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=5cc987760bc148a8c753ec2a498ed5ee783f14ec

The branch, master has been updated
       via  5cc987760bc148a8c753ec2a498ed5ee783f14ec (commit)
       via  0142d376b85f963269f8aa1788d92a4910b0b9a9 (commit)
      from  44d65b23cebad7001d0384ed181a44b500129f83 (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 5cc987760bc148a8c753ec2a498ed5ee783f14ec
Author: Andy Wingo <address@hidden>
Date:   Sun Aug 29 21:01:54 2010 -0700

    fix #y back-compat shim
    
    * module/ice-9/deprecated.scm (#\y): #y was in fact a syntax for
      s8vectors, not bitvectors. Fix.

commit 0142d376b85f963269f8aa1788d92a4910b0b9a9
Author: Andy Wingo <address@hidden>
Date:   Sun Aug 29 20:48:32 2010 -0700

    bitvector work
    
    * test-suite/Makefile.am:
    * test-suite/tests/bitvectors.test: Add a new file to test bitvectors.
    
    * libguile/uniform.c (scm_c_uniform_vector_length): Don't call
      scm_uniform_vector_elements, as we don't need to be able to access the
      elements with pointers to bytes. Fixes uniform-vector-length on
      bitvectors.

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

Summary of changes:
 libguile/uniform.c               |   14 ++++-----
 module/ice-9/deprecated.scm      |   13 ++------
 test-suite/Makefile.am           |    1 +
 test-suite/tests/bitvectors.test |   59 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 69 insertions(+), 18 deletions(-)
 create mode 100644 test-suite/tests/bitvectors.test

diff --git a/libguile/uniform.c b/libguile/uniform.c
index 229c092..cab976e 100644
--- a/libguile/uniform.c
+++ b/libguile/uniform.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010 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
@@ -99,13 +99,11 @@ scm_is_uniform_vector (SCM obj)
 size_t
 scm_c_uniform_vector_length (SCM uvec)
 {
-  scm_t_array_handle h;
-  size_t len;
-  ssize_t inc;
-  
-  scm_uniform_vector_elements (uvec, &h, &len, &inc);
-  scm_array_handle_release (&h);
-  return len;
+  if (!scm_is_uniform_vector (uvec))
+    scm_wrong_type_arg_msg ("uniform-vector-length", 1, uvec,
+                            "uniform vector");
+
+  return scm_c_generalized_vector_length (uvec);
 }
 
 SCM_DEFINE (scm_uniform_vector_p, "uniform-vector?", 1, 0, 0,
diff --git a/module/ice-9/deprecated.scm b/module/ice-9/deprecated.scm
index d6cc3b9..c0fa921 100644
--- a/module/ice-9/deprecated.scm
+++ b/module/ice-9/deprecated.scm
@@ -250,18 +250,11 @@
  #\y
  (lambda (c port)
    (issue-deprecation-warning
-    "The `#y' bitvector syntax is deprecated.  Use `#*' instead.")
+    "The `#y' bytevector syntax is deprecated.  Use `#s8' instead.")
    (let ((x (read port)))
      (cond
-      ((list? x)
-       (list->bitvector
-        (map (lambda (x)
-               (cond ((zero? x) #f)
-                     ((eqv? x 1) #t)
-                     (else (error "invalid #y element" x))))
-             x)))
-      (else
-       (error "#y needs to be followed by a list" x))))))
+      ((list? x) (list->s8vector x))
+      (else (error "#y needs to be followed by a list" x))))))
 
 (define (unmemoize-expr . args)
   (issue-deprecation-warning
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index eab1cd5..eaa7512 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -28,6 +28,7 @@ SCM_TESTS = tests/00-initial-env.test         \
            tests/arrays.test                   \
            tests/asm-to-bytecode.test          \
            tests/bit-operations.test           \
+           tests/bitvectors.test               \
            tests/brainfuck.test                \
            tests/bytevectors.test              \
            tests/c-api.test                    \
diff --git a/test-suite/tests/bitvectors.test b/test-suite/tests/bitvectors.test
new file mode 100644
index 0000000..9833b3b
--- /dev/null
+++ b/test-suite/tests/bitvectors.test
@@ -0,0 +1,59 @@
+;;;; bitvectors.test --- tests guile's bitvectors     -*- scheme -*-
+;;;;
+;;;; Copyright 2010 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
+
+(define-module (test-suite test-bitvectors)
+  #:use-module (test-suite lib))
+
+
+(with-test-prefix "predicates"
+  (pass-if (bitvector? #*1010101010))
+  (pass-if (generalized-vector? #*1010101010))
+  (pass-if (uniform-vector? #*1010101010))
+  (pass-if (array? #*1010101010)))
+
+
+(with-test-prefix "equality"
+  (pass-if (equal? #*1010101 #*1010101))
+  (pass-if (array-equal? #*1010101 #*1010101))
+
+  (pass-if (not (equal? #*10101010 #*1010101)))
+  (pass-if (not (array-equal? #*10101010 #*1010101))))
+
+(with-test-prefix "lists"
+  (pass-if (equal? (bitvector->list #*10010) '(#t #f #f #t #f)))
+  (pass-if (equal? (array->list #*10010) '(#t #f #f #t #f)))
+  (pass-if (equal? (uniform-vector->list #*10010) '(#t #f #f #t #f)))
+  (pass-if (equal? #*10010 (list->bitvector '(#t #f #f #t #f)))))
+
+(with-test-prefix "ref and set"
+  (with-test-prefix "bv"
+    (let ((bv (list->bitvector '(#f #f #t #f #t))))
+      (pass-if (eqv? (bitvector-ref bv 0) #f))
+      (pass-if (eqv? (bitvector-ref bv 2) #t))
+      (bitvector-set! bv 0 #t)
+      (pass-if (eqv? (bitvector-ref bv 0) #t))))
+
+  (with-test-prefix "uv"
+    (let ((bv (list->bitvector '(#f #f #t #f #t))))
+      (pass-if (eqv? (uniform-vector-ref bv 0) #f))
+      (pass-if (eqv? (uniform-vector-ref bv 2) #t))
+      (uniform-vector-set! bv 0 #t)
+      (pass-if (eqv? (uniform-vector-ref bv 0) #t)))))
+
+
+


hooks/post-receive
-- 
GNU Guile