mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 21:40:34 +02:00
Code Activity

Merge remote-tracking branch 'origin/stable-2.0'

Browse source
This commit is contained in:
Andy Wingo 2011-05-09 00:13:04 +02:00
commit e690a3cbf2
20 changed files with 1726 additions and 359 deletions
Download patch file Download diff file Expand all files Collapse all files

28
test-suite/tests/foreign.test
View file

@ -124,24 +124,32 @@
(pass-if "pointer from bits"
(let* ((bytes (iota (sizeof '*)))
(bv (u8-list->bytevector bytes)))
(bv (u8-list->bytevector bytes))
(fold (case (native-endianness)
((little) fold-right)
((big) fold)
(else (error "unsupported endianness")))))
(= (pointer-address
(make-pointer (bytevector-uint-ref bv 0 (native-endianness)
(sizeof '*))))
(fold-right (lambda (byte address)
(+ byte (* 256 address)))
0
bytes))))
(fold (lambda (byte address)
(+ byte (* 256 address)))
0
bytes))))
(pass-if "dereference-pointer"
(let* ((bytes (iota (sizeof '*)))
(bv (u8-list->bytevector bytes)))
(bv (u8-list->bytevector bytes))
(fold (case (native-endianness)
((little) fold-right)
((big) fold)
(else (error "unsupported endianness")))))
(= (pointer-address
(dereference-pointer (bytevector->pointer bv)))
(fold-right (lambda (byte address)
(+ byte (* 256 address)))
0
bytes)))))
(fold (lambda (byte address)
(+ byte (* 256 address)))
0
bytes)))))
(with-test-prefix "pointer<->string"

7
test-suite/tests/hash.test
View file

@ -1,6 +1,6 @@
;;;; hash.test --- test guile hashing -*- scheme -*-
;;;;
;;;; Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
;;;; Copyright (C) 2004, 2005, 2006, 2008, 2011 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
@ -32,7 +32,10 @@
(hash #t 0))
(pass-if (= 0 (hash #t 1)))
(pass-if (= 0 (hash #f 1)))
(pass-if (= 0 (hash noop 1))))
(pass-if (= 0 (hash noop 1)))
(pass-if (= 0 (hash +inf.0 1)))
(pass-if (= 0 (hash -inf.0 1)))
(pass-if (= 0 (hash +nan.0 1))))
;;;
;;; hashv

23
test-suite/tests/ports.test
View file

@ -572,21 +572,40 @@
eof))
(test-decoding-error (#xc2 #x41 #x42) "UTF-8"
(error ;; 41: should be in the 80..BF range
;; Section 3.9 of Unicode 6.0.0 reads:
;; "If the converter encounters an ill-formed UTF-8 code unit
;; sequence which starts with a valid first byte, but which does
;; not continue with valid successor bytes (see Table 3-7), it
;; must not consume the successor bytes".
;; Glibc/libiconv do not conform to it and instead swallow the
;; #x41. This example appears literally in Section 3.9.
(error ;; 41: invalid successor
#\A ;; 41: valid starting byte
#\B
eof))
(test-decoding-error (#xe0 #x88 #x88) "UTF-8"
(test-decoding-error (#xf0 #x80 #x80 #x41) "UTF-8"
;; According to Unicode 6.0.0, Section 3.9, "the only formal
;; requirement mandated by Unicode conformance for a converter is
;; that the <41> be processed and correctly interpreted as
;; <U+0041>".
(error ;; 2nd byte should be in the A0..BF range
error ;; 80: not a valid starting byte
error ;; 80: not a valid starting byte
#\A
eof))
(test-decoding-error (#xe0 #xa0 #x41 #x42) "UTF-8"
(error ;; 3rd byte should be in the 80..BF range
#\A
#\B
eof))
(test-decoding-error (#xf0 #x88 #x88 #x88) "UTF-8"
(error ;; 2nd byte should be in the 90..BF range
error ;; 88: not a valid starting byte
error ;; 88: not a valid starting byte
error ;; 88: not a valid starting byte
eof))))
(with-test-prefix "call-with-output-string"

7
test-suite/tests/vlist.test
View file

@ -301,6 +301,13 @@
(alist (fold alist-cons '() keys values)))
(equal? alist (reverse (vhash-fold alist-cons '() vh)))))
(pass-if "vhash-fold-right"
(let* ((keys '(a b c d e f g d h i))
(values '(1 2 3 4 5 6 7 0 8 9))
(vh (fold vhash-cons vlist-null keys values))
(alist (fold alist-cons '() keys values)))
(equal? alist (vhash-fold-right alist-cons '() vh))))
(pass-if "alist->vhash"
(let* ((keys '(a b c d e f g d h i))
(values '(1 2 3 4 5 6 7 0 8 9))