[Guile-commits] GNU Guile branch, master, updated. 0ba0b3848913ca871235ad4b2f8ef184bf8f552b

[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=0ba0b3848913ca871235ad4b2f8ef184bf8f552b

The branch, master has been updated
       via  0ba0b3848913ca871235ad4b2f8ef184bf8f552b (commit)
       via  55bf8cb7af47cde26e6a70dae056752c8265508d (commit)
      from  b242715b288b8f076d1617668e77f1ef44dfeeb3 (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 0ba0b3848913ca871235ad4b2f8ef184bf8f552b
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 19 00:47:11 2009 +0200

    Implement R6RS bytevector read syntax.
    
    * libguile/read.c (scm_read_bytevector): New function.
      (scm_read_sharp): Add `v' case for bytevectors.
    
    * test-suite/lib.scm (exception:read-error): New variable.
    
    * test-suite/tests/bytevectors.test ("Datum Syntax"): New test set.

commit 55bf8cb7af47cde26e6a70dae056752c8265508d
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 19 00:10:21 2009 +0200

    Fix `equal?' on bytevectors.
    
    * libguile/bytevectors.c (bytevector_equal_p): New function.
    
    * test-suite/tests/bytevectors.test ("2.3 Operations on Bytes and
      Octets")["equal?"]: New test.

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

Summary of changes:
 libguile/bytevectors.c            |    5 +++
 libguile/read.c                   |   29 +++++++++++++++++-
 test-suite/lib.scm                |    5 ++-
 test-suite/tests/bytevectors.test |   61 ++++++++++++++++++++++++++++++++++++-
 4 files changed, 97 insertions(+), 3 deletions(-)

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index 0846d91..2484a64 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -300,6 +300,11 @@ SCM_SMOB_PRINT (scm_tc16_bytevector, print_bytevector,
   return 1;
 }
 
+SCM_SMOB_EQUALP (scm_tc16_bytevector, bytevector_equal_p, bv1, bv2)
+{
+  return scm_bytevector_eq_p (bv1, bv2);
+}
+
 SCM_SMOB_FREE (scm_tc16_bytevector, free_bytevector, bv)
 {
 
diff --git a/libguile/read.c b/libguile/read.c
index 6fafc43..bd028ea 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007, 2008 
Free Software
+/* Copyright (C) 1995,1996,1997,1999,2000,2001,2003, 2004, 2006, 2007, 2008, 
2009 Free Software
  * Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
@@ -29,6 +29,7 @@
 #include <string.h>
 
 #include "libguile/_scm.h"
+#include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/eval.h"
 #include "libguile/unif.h"
@@ -883,6 +884,30 @@ scm_read_srfi4_vector (int chr, SCM port)
 }
 
 static SCM
+scm_read_bytevector (int chr, SCM port)
+{
+  chr = scm_getc (port);
+  if (chr != 'u')
+    goto syntax;
+
+  chr = scm_getc (port);
+  if (chr != '8')
+    goto syntax;
+
+  chr = scm_getc (port);
+  if (chr != '(')
+    goto syntax;
+
+  return scm_u8_list_to_bytevector (scm_read_sexp (chr, port));
+
+ syntax:
+  scm_i_input_error ("read_bytevector", port,
+                    "invalid bytevector prefix",
+                    SCM_MAKE_CHAR (chr));
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
 scm_read_guile_bit_vector (int chr, SCM port)
 {
   /* Read the `#*10101'-style read syntax for bit vectors in Guile.  This is
@@ -1050,6 +1075,8 @@ scm_read_sharp (int chr, SCM port)
     case 'f':
       /* This one may return either a boolean or an SRFI-4 vector.  */
       return (scm_read_srfi4_vector (chr, port));
+    case 'v':
+      return (scm_read_bytevector (chr, port));
     case '*':
       return (scm_read_guile_bit_vector (chr, port));
     case 't':
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 0a01a27..8190d1f 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,5 +1,5 @@
 ;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software 
Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009 Free Software 
Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -32,6 +32,7 @@
  exception:system-error
  exception:miscellaneous-error
  exception:string-contains-nul
+ exception:read-error
 
  ;; Reporting passes and failures.
  run-test
@@ -265,6 +266,8 @@
   (cons 'system-error ".*"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
+(define exception:read-error
+  (cons 'read-error "^.*$"))
 
 ;; as per throw in scm_to_locale_stringn()
 (define exception:string-contains-nul
diff --git a/test-suite/tests/bytevectors.test 
b/test-suite/tests/bytevectors.test
index c7697b1..342f08a 100644
--- a/test-suite/tests/bytevectors.test
+++ b/test-suite/tests/bytevectors.test
@@ -123,7 +123,12 @@
       (bytevector-sint-set! b 0 -16 (endianness big) 2)
       (bytevector-sint-set! b 1 -16 (endianness little) 2)
       (equal? (bytevector->u8-list b)
-             '(#xff #xf0 #xff)))))
+             '(#xff #xf0 #xff))))
+
+  (pass-if "equal?"
+    (let ((bv1 (u8-list->bytevector (iota 123)))
+          (bv2 (u8-list->bytevector (iota 123))))
+      (equal? bv1 bv2))))
 
 
 (with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
@@ -525,6 +530,60 @@
                                                4)))))))
 
 
+
+(with-test-prefix "Datum Syntax"
+
+  (pass-if "empty"
+    (equal? (with-input-from-string "#vu8()" read)
+            (make-bytevector 0)))
+
+  (pass-if "simple"
+    (equal? (with-input-from-string "#vu8(1 2 3   4 5)" read)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if ">127"
+    (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
+            (u8-list->bytevector '(0 255 127 128))))
+
+  (pass-if "self-evaluating"
+    (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
+                  (current-module))
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "quoted"
+    (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read)
+                  (current-module))
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "literal simple"
+    (equal? #vu8(1 2 3   4 5)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if "literal >127"
+    (equal? #vu8(0 255 127 128)
+            (u8-list->bytevector '(0 255 127 128))))
+
+  (pass-if "literal quoted"
+    (equal? '#vu8(1 2 3   4 5)
+            (u8-list->bytevector '(1 2 3 4 5))))
+
+  (pass-if-exception "incorrect prefix"
+    exception:read-error
+    (with-input-from-string "#vi8(1 2 3)" read))
+
+  (pass-if-exception "extraneous space"
+    exception:read-error
+    (with-input-from-string "#vu8 (1 2 3)" read))
+
+  (pass-if-exception "negative integers"
+    exception:wrong-type-arg
+    (with-input-from-string "#vu8(-1 -2 -3)" read))
+
+  (pass-if-exception "out-of-range integers"
+    exception:wrong-type-arg
+    (with-input-from-string "#vu8(0 256)" read)))
+
+
 ;;; Local Variables:
 ;;; coding: latin-1
 ;;; mode: scheme


hooks/post-receive
-- 
GNU Guile