From 44197f9fbe62af4a62d35bf526fd4b5b651a3728 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 2 Jun 2025 23:36:13 -0700 Subject: *-get-buf: bug in skipping non-seekable streams. * stdlib/getput.tl (sys:get-buf-common); Fix incorrect algorithm for skipping forward in a stream that doesn't support seek-stream. The problem is that when the seek amont is greater than 4096, it does nothing but 4096 byte reads, which will overshoot the target position if it isn't divisible by 4096. The last read must be adjusted to the remaining seek amount. * tests/018/getput.tl: New test case using property-based approach to show that the read-based skip in get-buf-common fetches the same data as the seek-based skip. --- stdlib/getput.tl | 9 +++++---- tests/018/getput.tl | 6 ++++++ 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/stdlib/getput.tl b/stdlib/getput.tl index 518e4b6b..77cf1aff 100644 --- a/stdlib/getput.tl +++ b/stdlib/getput.tl @@ -30,13 +30,14 @@ (o 0)) (when (plusp seek) (unless (ignerr (seek-stream s seek :from-current)) - (let ((b (make-buf (min seek 4096))) - (c 0)) - (while (< c seek) + (let* ((b (make-buf (min seek 4096)))) + (while (plusp seek) + (if (< seek 4096) + (buf-set-length b seek)) (let ((p (fill-buf b 0 s))) (if (zerop p) (return)) - (inc c p)))))) + (dec seek p)))))) (while (or (null bytes) (< (len b) bytes)) (let ((p (fill-buf-adjust b o s))) (when (= p o) diff --git a/tests/018/getput.tl b/tests/018/getput.tl index ed5a4e5f..9c0a878d 100644 --- a/tests/018/getput.tl +++ b/tests/018/getput.tl @@ -39,3 +39,9 @@ (map-process-str "tr" '#"[a-z] [A-Z]" "abc") "ABC" (map-command-buf "tr '[a-z]' '[A-Z]'" #b'616263') #b'414243' (map-process-buf "tr" '#"[a-z] [A-Z]" #b'616263') #b'414243') + +(each-prod ((sz 0..10000..1000) + (off 0..16000..2000)) + (mvtest + (file-get-buf txr-exe-path sz off) + (command-get-buf `cat '@{txr-exe-path}'` sz off))) -- cgit v1.2.3