Export binary-port-position and set-binary-port-position!.

Currently busted for output ports.

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 040fe0a204dc2b1efbf4321f4e5cb88e7b4d58d8..52cfee9588ae0e59ab993659a67f09a17daff218 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2564,6 +2564,7 @@ USA.
          binary-i/o-port?
          binary-input-port?
          binary-output-port?
+         binary-port-position
          binary-port?
          call-with-output-bytevector
          get-output-bytevector
@@ -2573,6 +2574,7 @@ USA.
          read-bytevector
          read-bytevector!
          read-u8
+         set-binary-port-position!
          textual->binary-port
          u8-ready?
          write-bytevector

diff --git a/tests/runtime/test-binary-port.scm b/tests/runtime/test-binary-port.scm
index 5f4e7311849c4e12603f5ae9cad47e1f7e0ac10d..f2751f42356373e94624e41fd68dc8a2883c062a 100644 (file)
--- a/tests/runtime/test-binary-port.scm
+++ b/tests/runtime/test-binary-port.scm
@@ -179,4 +179,28 @@ USA.
   (assert-false (textual-port? port))
   (assert-false (input-port? port))
   (assert-true (output-port? port))
-  (assert-false (i/o-port? port)))
\ No newline at end of file
+  (assert-false (i/o-port? port)))
+
+(define-test 'position
+  (lambda ()
+    (call-with-temporary-file-pathname
+      (lambda (pathname)
+       (call-with-binary-output-file pathname
+         (lambda (port)
+           (assert-= (binary-port-position port) 0)
+           (write-u8 42 port)
+           (expect-failure
+            (lambda ()
+              (assert-= (binary-port-position port) 1)))
+           (write-bytevector (make-bytevector 1000 0) port)
+           (expect-failure
+            (lambda ()
+              (assert-= (binary-port-position port) 1001)))))
+       (call-with-binary-input-file pathname
+         (lambda (port)
+           (assert-= (binary-port-position port) 0)
+           (assert-= (read-u8 port) 42)
+           (assert-= (binary-port-position port) 1)
+           (assert-equal (read-bytevector 1000 port)
+                         (make-bytevector 1000 0))
+           (assert-= (binary-port-position port) 1001)))))))
\ No newline at end of file