From c71cd4a61fc8085ccb17169aad826d6f9ee1718b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 19 Jul 2018 17:08:53 +0200
Subject: hash: sha256 port now implements 'port-position'.

* guix/hash.scm (open-sha256-port)[position]: New variable.
[get-position]: New procedure.
Pass it to 'make-custom-binary-output-port'.
* tests/hash.scm ("open-sha256-port, hello"): Test 'port-position'.
---
 guix/hash.scm  | 7 ++++++-
 tests/hash.scm | 4 ++--
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/guix/hash.scm b/guix/hash.scm
index 39834043e1..8d7ba21425 100644
--- a/guix/hash.scm
+++ b/guix/hash.scm
@@ -101,6 +101,7 @@ output port."
     (open-sha256-md))
 
   (define digest #f)
+  (define position 0)
 
   (define (finalize!)
     (let ((ptr (md-read sha256-md 0)))
@@ -114,14 +115,18 @@ output port."
           0)
         (let ((ptr (bytevector->pointer bv offset)))
           (md-write sha256-md ptr len)
+          (set! position (+ position len))
           len)))
 
+  (define (get-position)
+    position)
+
   (define (close)
     (unless digest
       (finalize!)))
 
   (values (make-custom-binary-output-port "sha256"
-                                          write! #f #f
+                                          write! get-position #f
                                           close)
           (lambda ()
             (unless digest
diff --git a/tests/hash.scm b/tests/hash.scm
index da87616eec..47dff3915b 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -64,12 +64,12 @@
     (get)))
 
 (test-equal "open-sha256-port, hello"
-  %hello-sha256
+  (list %hello-sha256 (string-length "hello world"))
   (let-values (((port get)
                 (open-sha256-port)))
     (put-bytevector port (string->utf8 "hello world"))
     (force-output port)
-    (get)))
+    (list (get) (port-position port))))
 
 (test-assert "port-sha256"
   (let* ((file     (search-path %load-path "ice-9/psyntax.scm"))
-- 
cgit v1.2.3