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

tests: Add test for <http://bugs.gnu.org/17466>.

Browse source 
* test-suite/tests/r6rs-ports.test ("7.2.8 Binary
  Input")("http://bugs.gnu.org/17466"): New test.
This commit is contained in:
Ludovic Courtès 2014-05-28 22:19:16 +02:00
parent 1baa215930
commit eb6ac6efcd
1 changed files with 20 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

20
test-suite/tests/r6rs-ports.test
View file

@ -137,6 +137,26 @@
(close-port port) (close-port port)
(get-bytevector-n port 3))) (get-bytevector-n port 3)))
(let ((expected (make-bytevector 20 (char->integer #\a))))
(pass-if-equal "http://bugs.gnu.org/17466"
;; <http://bugs.gnu.org/17466> is about a memory corruption
;; whereas bytevector shrunk in 'get-bytevector-n' would keep
;; referring to the previous (larger) bytevector.
expected
(let loop ((count 50))
(if (zero? count)
expected
(let ((bv (call-with-input-string "aaaaaaaaaaaaaaaaaaaa"
(lambda (port)
(get-bytevector-n port 4096)))))
;; Cause the 4 KiB bytevector initially created by
;; 'get-bytevector-n' to be reclaimed.
(make-bytevector 4096)
(if (equal? bv expected)
(loop (- count 1))
bv))))))
(pass-if "get-bytevector-n! [short]" (pass-if "get-bytevector-n! [short]"
(let* ((port (open-input-string "GNU Guile")) (let* ((port (open-input-string "GNU Guile"))
(bv (make-bytevector 4)) (bv (make-bytevector 4))