diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2025-06-02 23:36:13 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2025-06-02 23:36:13 -0700 |
| commit | 44197f9fbe62af4a62d35bf526fd4b5b651a3728 (patch) | |
| tree | 9824dff94cd66810dc96512f0322e080f40202cf | |
| parent | 8d08bf87e575d3d156347593aed6c3dc85683257 (diff) | |
| download | txr-44197f9fbe62af4a62d35bf526fd4b5b651a3728.tar.gz txr-44197f9fbe62af4a62d35bf526fd4b5b651a3728.tar.bz2 txr-44197f9fbe62af4a62d35bf526fd4b5b651a3728.zip | |
*-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.
| -rw-r--r-- | stdlib/getput.tl | 9 | ||||
| -rw-r--r-- | 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))) |