port-tell.patch

diff --git a/src/portapi.c b/src/portapi.c
index 6d4e12b..7782117 100644
--- a/src/portapi.c
+++ b/src/portapi.c
@@ -951,17 +951,30 @@ int Scm_CharReadyUnsafe(ScmPort *p)
  * PortSeek
  */
 
+#ifndef PORT_UNREAD_BYTES       /* common part */
+#define PORT_UNREAD_BYTES port_unread_bytes
+static off_t port_unread_bytes(ScmPort *p)
+{
+    off_t unread_bytes = p->scrcnt;
+    if (p->ungotten != SCM_CHAR_INVALID) {
+        unread_bytes += SCM_CHAR_NBYTES(p->ungotten);
+    }
+    return unread_bytes;
+}
+#endif /*PORT_UNREAD_BYTES*/
+
 #ifndef SEEK_ISTR               /* common part */
 #define SEEK_ISTR seek_istr
 static off_t seek_istr(ScmPort *p, off_t o, int whence, int nomove)
 {
     off_t r;
+    long unread_bytes = port_unread_bytes(p);
     if (nomove) {
-        r = (off_t)(p->src.istr.current - p->src.istr.start);
+        r = (off_t)(p->src.istr.current - p->src.istr.start - unread_bytes);
     } else {
         long z = (long)o;
         if (whence == SEEK_CUR) {
-            z += (long)(p->src.istr.current - p->src.istr.start);
+            z += (long)(p->src.istr.current - p->src.istr.start - unread_bytes);
         } else if (whence == SEEK_END) {
             z += (long)(p->src.istr.end - p->src.istr.start);
         }
@@ -993,6 +1006,7 @@ ScmObj Scm_PortSeekUnsafe(ScmPort *p, ScmObj off, int whence)
                       "attempt to seek on closed port: %S", p);
     }
     LOCK(p);
+    off_t unread_bytes = port_unread_bytes(p);
     switch (SCM_PORT_TYPE(p)) {
     case SCM_PORT_FILE:
         /* NB: we might be able to skip calling seeker if we keep the
@@ -1005,7 +1019,7 @@ ScmObj Scm_PortSeekUnsafe(ScmPort *p, ScmObj off, int whence)
         if (nomove) {
             SAFE_CALL(p, r = p->src.buf.seeker(p, 0, SEEK_CUR));
             if (SCM_PORT_DIR(p)&SCM_PORT_INPUT) {
-                r -= (off_t)(p->src.buf.end - p->src.buf.current);
+                r -= (off_t)(p->src.buf.end - p->src.buf.current) + unread_bytes;
             } else {
                 r += (off_t)(p->src.buf.current - p->src.buf.buffer);
             }
@@ -1015,7 +1029,7 @@ ScmObj Scm_PortSeekUnsafe(ScmPort *p, ScmObj off, int whence)
             if (SCM_PORT_DIR(p)&SCM_PORT_INPUT) {
                 char *c = p->src.buf.current; /* save current ptr */
                 if (whence == SEEK_CUR) {
-                    o -= (off_t)(p->src.buf.end - c);
+                    o -= (off_t)(p->src.buf.end - c) + unread_bytes;
                 }
                 p->src.buf.current = p->src.buf.end; /* invalidate buffer */
                 SAFE_CALL(p, r = p->src.buf.seeker(p, o, whence));
@@ -1045,7 +1059,22 @@ ScmObj Scm_PortSeekUnsafe(ScmPort *p, ScmObj off, int whence)
         break;
     case SCM_PORT_PROC:
         if (p->src.vt.Seek) {
-            SAFE_CALL(p, r = p->src.vt.Seek(p, o, whence));
+            if (nomove) {
+                SAFE_CALL(p, r = p->src.vt.Seek(p, 0, SEEK_CUR));
+                if (r != (off_t)-1) {
+                    r -= unread_bytes;
+                }
+            } else {
+                if (whence == SEEK_CUR) {
+                    o -= unread_bytes;
+                }
+                SAFE_CALL(p, r = p->src.vt.Seek(p, o, whence));
+                if (r != (off_t)-1) {
+                    /* Invalidate ungotten char */
+                    p->ungotten = SCM_CHAR_INVALID;
+                    p->scrcnt = 0;
+                }
+            }
         }
         break;
     }
diff --git a/test/io.scm b/test/io.scm
index 36521b0..70ebfa1 100644
--- a/test/io.scm
+++ b/test/io.scm
@@ -473,6 +473,15 @@
            (let1 c1 (peek-char)
              (port-seek (current-input-port) 0 SEEK_CUR)
              (list c1 (peek-char))))))
+(test* "seek (istr, with peek-char)" '(#\a 0 #\b)
+       (with-input-from-string "ab"
+         (^()
+           (let* ((c0 (peek-char))
+                  (pos (port-tell (current-input-port)))
+                  (c1 (begin
+                        (port-seek  (current-input-port) 1 SEEK_CUR)
+                        (read-char))))
+             (list c0 pos c1)))))
 (test* "seek (istr, with peek-byte)" '(#x61 #x62)
        (with-input-from-string (rlet1 s (make-byte-string 2 #x61)
                                  (string-byte-set! s 1 #x62))