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 <l...@gnu.org> 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 <l...@gnu.org> 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
