io.ports: fix stream-seek with seek-relative seek type (reported by Joe Groff)

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 3864b37e48a09b9193cfe1222296611c5113590e..8517910b0f117127ff4208eb2e348ea9b5f56250 100644 (file)
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -4,7 +4,8 @@ USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations classes byte-arrays namespaces splitting grouping
 dlists alien alien.c-types assocs io.encodings.binary summary
-accessors destructors combinators fry specialized-arrays ;
+accessors destructors combinators fry specialized-arrays
+locals ;
 SPECIALIZED-ARRAY: uchar
 IN: io.ports
 
@@ -148,12 +149,21 @@ M: output-port stream-tell ( stream -- n )
     [ check-disposed ]
     [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
 
+:: do-seek-relative ( n seek-type stream -- n seek-type stream )
+    ! seek-relative needs special handling here, because of the
+    ! buffer.
+    seek-type seek-relative eq?
+    [ n stream stream-tell + seek-absolute ] [ n seek-type ] if
+    stream ;
+
 M: input-port stream-seek ( n seek-type stream -- )
+    do-seek-relative
     [ check-disposed ]
     [ buffer>> 0 swap buffer-reset ]
     [ handle>> seek-handle ] tri ;
 
 M: output-port stream-seek ( n seek-type stream -- )
+    do-seek-relative
     [ check-disposed ]
     [ stream-flush ]
     [ handle>> seek-handle ] tri ;

diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index 4986fedd791cf9542cadef176dd00d2550d5db13..8b578750bc6e2f6bbdfa4fceba7800e845df4697 100644 (file)
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -245,6 +245,15 @@ CONSTANT: pt-array-1
     ] with-file-reader
 ] must-fail
 
+[ ] [
+    "resource:misc/icons/Factor_48x48.png" binary [
+        44 read drop
+        tell-input 44 assert=
+        -44 seek-relative seek-input
+        tell-input 0 assert=
+    ] with-file-reader
+] unit-test
+
 [
     "non-string-error" unique-file ascii [
         { } write