mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix compilation of literal bitvectors.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2009-10-15 23:29:50 +02:00
parent 29553c54b5
commit cd48c32cf4
3 changed files with 8 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/arrays.c
View file

@ -243,7 +243,8 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, const void *bytes,
} }
else 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); SCM_MISC_ERROR ("byte length and dimensions do not match", SCM_EOL);
} }

2
module/ice-9/deprecated.scm
View file

@ -190,7 +190,7 @@
#\y #\y
(lambda (c port) (lambda (c port)
(issue-deprecation-warning (issue-deprecation-warning
"The `#y' bitvector syntax is deprecated. Use `#*' instead.") "The `#y' bitvector syntax is deprecated. Use `bitvector' instead.")
(let ((x (read port))) (let ((x (read port)))
(cond (cond
((list? x) ((list? x)

5
test-suite/tests/unif.test
View file

@ -17,6 +17,7 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-unif) (define-module (test-suite test-unif)
#:use-module ((system base compile) #:select (compile))
#:use-module (test-suite lib)) #:use-module (test-suite lib))
;;; ;;;
@ -546,8 +547,10 @@
(eq? 'b (array-ref a -2))))) (eq? 'b (array-ref a -2)))))
(pass-if-exception "negative length" exception:length-non-negative (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 ;;; equal? with vector and one-dimensional array