From 2820b9fc9981c9c6aef47844b858ae7b1e8a7ab9 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sat, 7 Feb 2009 11:23:00 -0600
Subject: [PATCH] better error handling on unix seek, unit tests

---
 core/io/io-tests.factor | 65 ++++++++++++++++++++++++++++++++++++++++-
 core/io/io.factor       |  1 +
 2 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor
index 009ba3a9e7..8bfc52432d 100644
--- a/core/io/io-tests.factor
+++ b/core/io/io-tests.factor
@@ -1,6 +1,6 @@
 USING: arrays io io.files kernel math parser strings system
 tools.test words namespaces make io.encodings.8-bit
-io.encodings.binary sequences ;
+io.encodings.binary sequences io.files.unique ;
 IN: io.tests
 
 [ f ] [
@@ -10,3 +10,66 @@ IN: io.tests
 
 ! Make sure we use correct to_c_string form when writing
 [ ] [ "\0" write ] unit-test
+
+[ B{ 3 2 3 4 5 } ]
+[
+    "seek-test1" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 0 seek-absolute seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 3 } ]
+[
+    "seek-test2" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush -1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 1 2 3 4 5 0 3 } ]
+[
+    "seek-test3" unique-file binary
+    [
+        [
+            B{ 1 2 3 4 5 } write flush 1 seek-relative seek-output
+            B{ 3 } write
+        ] with-file-writer
+    ] [
+        file-contents
+    ] 2bi
+] unit-test
+
+[ B{ 3 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test4" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            -3 seek-end seek-input 1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
+
+[ B{ 2 } ]
+[
+    B{ 1 2 3 4 5 } "seek-test5" unique-file binary [
+        set-file-contents
+    ] [
+        [
+            3 seek-absolute seek-input
+            -2 seek-relative seek-input
+            1 read
+        ] with-file-reader
+    ] 2bi
+] unit-test
diff --git a/core/io/io.factor b/core/io/io.factor
index 1cfdaf526e..11a2a6d1a8 100644
--- a/core/io/io.factor
+++ b/core/io/io.factor
@@ -15,6 +15,7 @@ GENERIC: stream-write ( seq stream -- )
 GENERIC: stream-flush ( stream -- )
 GENERIC: stream-nl ( stream -- )
 
+ERROR: bad-seek-type type ;
 SINGLETONS: seek-absolute seek-relative seek-end ;
 GENERIC: stream-seek ( n seek-type stream -- )