From a7384d5de6cebd2a1170809c68bf1aed06f32b70 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 7 Jul 2010 02:26:03 -0400
Subject: [PATCH] io.ports: fix stream-tell implementation

---
 basis/io/ports/ports.factor      | 27 ++++++++++++++++-----------
 core/io/files/files-tests.factor | 28 ++++++++++++++++++++++++----
 2 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 6a30a1ed07..3864b37e48 100644
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -105,7 +105,8 @@ TUPLE: output-port < buffered-port ;
     [ nip ] [ buffer>> buffer-capacity <= ] 2bi
     [ drop ] [ stream-flush ] if ; inline
 
-M: output-port stream-element-type stream>> stream-element-type ; inline
+M: output-port stream-element-type
+    stream>> stream-element-type ; inline
 
 M: output-port stream-write1
     dup check-disposed
@@ -128,13 +129,24 @@ M: output-port stream-write
 
 HOOK: (wait-to-write) io-backend ( port -- )
 
+: port-flush ( port -- )
+    dup buffer>> buffer-empty?
+    [ drop ] [ dup (wait-to-write) port-flush ] if ;
+
+M: output-port stream-flush ( port -- )
+    [ check-disposed ] [ port-flush ] bi ;
+
 HOOK: tell-handle os ( handle -- n )
+
 HOOK: seek-handle os ( n seek-type handle -- )
 
-M: buffered-port stream-tell ( stream -- n )
+M: input-port stream-tell ( stream -- n )
     [ check-disposed ]
-    [ handle>> tell-handle ]
-    [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
+    [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi - ] bi ;
+
+M: output-port stream-tell ( stream -- n )
+    [ check-disposed ]
+    [ [ handle>> tell-handle ] [ buffer>> buffer-length ] bi + ] bi ;
 
 M: input-port stream-seek ( n seek-type stream -- )
     [ check-disposed ]
@@ -150,13 +162,6 @@ GENERIC: shutdown ( handle -- )
 
 M: object shutdown drop ;
 
-: port-flush ( port -- )
-    dup buffer>> buffer-empty?
-    [ drop ] [ dup (wait-to-write) port-flush ] if ;
-
-M: output-port stream-flush ( port -- )
-    [ check-disposed ] [ port-flush ] bi ;
-
 M: output-port dispose*
     [
         {
diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor
index ff6eed4514..4986fedd79 100644
--- a/core/io/files/files-tests.factor
+++ b/core/io/files/files-tests.factor
@@ -161,8 +161,12 @@ CONSTANT: pt-array-1
     "seek-test1" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write 0 seek-absolute seek-output
+            B{ 1 2 3 4 5 } write
+            tell-output 5 assert=
+            0 seek-absolute seek-output
+            tell-output 0 assert=
             B{ 3 } write
+            tell-output 1 assert=
         ] with-file-writer
     ] [
         file-contents
@@ -174,8 +178,12 @@ CONSTANT: pt-array-1
     "seek-test2" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write -1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write
+            tell-output 5 assert=
+            -1 seek-relative seek-output
+            tell-output 4 assert=
             B{ 3 } write
+            tell-output 5 assert=
         ] with-file-writer
     ] [
         file-contents
@@ -187,8 +195,12 @@ CONSTANT: pt-array-1
     "seek-test3" unique-file binary
     [
         [
-            B{ 1 2 3 4 5 } write 1 seek-relative seek-output
+            B{ 1 2 3 4 5 } write
+            tell-output 5 assert=
+            1 seek-relative seek-output
+            tell-output 6 assert=
             B{ 3 } write
+            tell-output 7 assert=
         ] with-file-writer
     ] [
         file-contents
@@ -201,7 +213,11 @@ CONSTANT: pt-array-1
         set-file-contents
     ] [
         [
-            -3 seek-end seek-input 1 read
+            tell-input 0 assert=
+            -3 seek-end seek-input
+            tell-input 2 assert=
+            1 read
+            tell-input 3 assert=
         ] with-file-reader
     ] 2bi
 ] unit-test
@@ -212,9 +228,13 @@ CONSTANT: pt-array-1
         set-file-contents
     ] [
         [
+            tell-input 0 assert=
             3 seek-absolute seek-input
+            tell-input 3 assert=
             -2 seek-relative seek-input
+            tell-input 1 assert=
             1 read
+            tell-input 2 assert=
         ] with-file-reader
     ] 2bi
 ] unit-test