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=e082b13b662309021c73bae1561fb5c6d191d258 The branch, stable-2.0 has been updated via e082b13b662309021c73bae1561fb5c6d191d258 (commit) via ef405f8ba73fc57706d7155a2e008352416debcf (commit) from d316047326fde9d63ca52c0051fbf09124ef297e (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 e082b13b662309021c73bae1561fb5c6d191d258 Author: Mark H Weaver <[email protected]> Date: Sun Feb 26 15:53:11 2012 -0500 pmatch: always wrap with let, even if the expression appears atomic * module/system/base/pmatch.scm (pmatch): Always wrap with 'let', even if the expression appears atomic, because in the presence of 'identifier-syntax', we cannot know what an atomic expression will later expand to. Also use '#:export-syntax' instead of '#:export' to export 'pmatch'. commit ef405f8ba73fc57706d7155a2e008352416debcf Author: Mark H Weaver <[email protected]> Date: Thu Mar 1 16:07:28 2012 -0500 Fix <TAG>vector-length when applied to other uniform vector types * module/srfi/srfi-4.scm, module/srfi/srfi-4/gnu.scm (define-bytevector-type): Fix definition of <TAG>vector-length when applied to uniform vectors of different element sizes. Thanks to Tobias Brandt <[email protected]> for reporting this bug. * test-suite/tests/srfi-4.test: Add tests. ----------------------------------------------------------------------- Summary of changes: module/srfi/srfi-4.scm | 6 ++++-- module/srfi/srfi-4/gnu.scm | 5 +++-- module/system/base/pmatch.scm | 16 ++++++++-------- test-suite/tests/srfi-4.test | 25 +++++++++++++++++++++++++ 4 files changed, 40 insertions(+), 12 deletions(-) diff --git a/module/srfi/srfi-4.scm b/module/srfi/srfi-4.scm index 818ae7a..43f5ef6 100644 --- a/module/srfi/srfi-4.scm +++ b/module/srfi/srfi-4.scm @@ -1,6 +1,7 @@ ;;; srfi-4.scm --- Homogeneous Numeric Vector Datatypes -;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2004, 2006, 2009, 2010, +;; 2012 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 @@ -79,7 +80,8 @@ (apply make-srfi-4-vector ',tag len fill)) (define (,(symbol-append tag 'vector-length) v) (let ((len (* (uniform-vector-length v) - (/ ,size (uniform-vector-element-size v))))) + (uniform-vector-element-size v) + (/ ,size)))) (if (integer? len) len (error "fractional length" v ',tag ,size)))) diff --git a/module/srfi/srfi-4/gnu.scm b/module/srfi/srfi-4/gnu.scm index ac22809..39d6350 100644 --- a/module/srfi/srfi-4/gnu.scm +++ b/module/srfi/srfi-4/gnu.scm @@ -1,6 +1,6 @@ ;;; Extensions to SRFI-4 -;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 2009, 2010, 2011, 2012 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 @@ -52,7 +52,8 @@ (apply make-srfi-4-vector ',tag len fill)) (define (,(symbol-append tag 'vector-length) v) (let ((len (* (uniform-vector-length v) - (/ ,size (uniform-vector-element-size v))))) + (uniform-vector-element-size v) + (/ ,size)))) (if (integer? len) len (error "fractional length" v ',tag ,size)))) diff --git a/module/system/base/pmatch.scm b/module/system/base/pmatch.scm index 00563f6..e9b9eb2 100644 --- a/module/system/base/pmatch.scm +++ b/module/system/base/pmatch.scm @@ -1,6 +1,6 @@ ;;; pmatch, a simple matcher -;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc +;;; Copyright (C) 2009, 2010, 2012 Free Software Foundation, Inc ;;; Copyright (C) 2005,2006,2007 Oleg Kiselyov ;;; Copyright (C) 2007 Daniel P. Friedman ;;; @@ -35,22 +35,22 @@ ;;; Code: (define-module (system base pmatch) - #:export (pmatch)) + #:export-syntax (pmatch)) -(define-syntax pmatch +(define-syntax-rule (pmatch e cs ...) + (let ((v e)) (pmatch1 v cs ...))) + +(define-syntax pmatch1 (syntax-rules (else guard) - ((_ (op arg ...) cs ...) - (let ((v (op arg ...))) - (pmatch v cs ...))) ((_ v) (if #f #f)) ((_ v (else e0 e ...)) (let () e0 e ...)) ((_ v (pat (guard g ...) e0 e ...) cs ...) - (let ((fk (lambda () (pmatch v cs ...)))) + (let ((fk (lambda () (pmatch1 v cs ...)))) (ppat v pat (if (and g ...) (let () e0 e ...) (fk)) (fk)))) ((_ v (pat e0 e ...) cs ...) - (let ((fk (lambda () (pmatch v cs ...)))) + (let ((fk (lambda () (pmatch1 v cs ...)))) (ppat v pat (let () e0 e ...) (fk)))))) (define-syntax ppat diff --git a/test-suite/tests/srfi-4.test b/test-suite/tests/srfi-4.test index 2e7f0d5..033e39f 100644 --- a/test-suite/tests/srfi-4.test +++ b/test-suite/tests/srfi-4.test @@ -515,3 +515,28 @@ (pass-if-exception "generalized-vector-set!, out-of-range" exception:out-of-range (generalized-vector-set! (c64vector 1.0) 1 2.0))) + +(with-test-prefix "accessing uniform vectors of different types" + + (pass-if "u32vector-length of u16vector" + (= 2 (u32vector-length (make-u16vector 4)))) + + (pass-if "u32vector-length of u8vector" + (= 2 (u32vector-length (make-u8vector 8)))) + + (pass-if "u8vector-length of u16vector" + (= 4 (u8vector-length (make-u16vector 2)))) + + (pass-if "u8vector-length of u32vector" + (= 8 (u8vector-length (make-u32vector 2)))) + + (pass-if "u32vector-set! of u16vector" + (let ((v (make-u16vector 4 #xFFFF))) + (u32vector-set! v 1 0) + (equal? v #u16(#xFFFF #xFFFF 0 0)))) + + (pass-if "u16vector-set! of u32vector" + (let ((v (make-u32vector 2 #xFFFFFFFF))) + (u16vector-set! v 2 0) + (u16vector-set! v 3 0) + (equal? v #u32(#xFFFFFFFF 0))))) hooks/post-receive -- GNU Guile
