summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-28 22:19:16 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-28 22:19:16 +0200
commiteb6ac6efcdb6fe72fdecb4aa7161e86d0e1d3282 (patch)
treedcc655a2e1773f798e20e9de7626a38a1c73e010
parent1baa2159307c34683e8ede54f38f65010fc594b0 (diff)
downloadguile-eb6ac6efcdb6fe72fdecb4aa7161e86d0e1d3282.tar.gz
tests: Add test for <http://bugs.gnu.org/17466>.
* test-suite/tests/r6rs-ports.test ("7.2.8 Binary Input")("http://bugs.gnu.org/17466"): New test.
-rw-r--r--test-suite/tests/r6rs-ports.test20
1 files changed, 20 insertions, 0 deletions
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 07c9f4465..dba803601 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -137,6 +137,26 @@
(close-port port)
(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]"
(let* ((port (open-input-string "GNU Guile"))
(bv (make-bytevector 4))