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 5971384d31aa86d28ba95a2ce1b6ab39ff49fb22..aa93612e394ef1f65cef30ccf4936790744ca1f8 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2656,6 +2656,7 @@ USA.
          binary-i/o-port?
          binary-input-port?
          binary-output-port?
+         binary-port-position
          binary-port?
          call-with-output-bytevector
          get-output-bytevector
@@ -2665,6 +2666,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 9a3f7b8c27b0a159f1f1ec037ff12f07972b337d..bc5308c0061f2cc80494518a3c0389a8e725d4c6 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