mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
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'.
This commit is contained in:
parent
f5db54eaa5
commit
c71cd4a61f
2 changed files with 8 additions and 3 deletions
|
@ -101,6 +101,7 @@ output port."
|
||||||
(open-sha256-md))
|
(open-sha256-md))
|
||||||
|
|
||||||
(define digest #f)
|
(define digest #f)
|
||||||
|
(define position 0)
|
||||||
|
|
||||||
(define (finalize!)
|
(define (finalize!)
|
||||||
(let ((ptr (md-read sha256-md 0)))
|
(let ((ptr (md-read sha256-md 0)))
|
||||||
|
@ -114,14 +115,18 @@ output port."
|
||||||
0)
|
0)
|
||||||
(let ((ptr (bytevector->pointer bv offset)))
|
(let ((ptr (bytevector->pointer bv offset)))
|
||||||
(md-write sha256-md ptr len)
|
(md-write sha256-md ptr len)
|
||||||
|
(set! position (+ position len))
|
||||||
len)))
|
len)))
|
||||||
|
|
||||||
|
(define (get-position)
|
||||||
|
position)
|
||||||
|
|
||||||
(define (close)
|
(define (close)
|
||||||
(unless digest
|
(unless digest
|
||||||
(finalize!)))
|
(finalize!)))
|
||||||
|
|
||||||
(values (make-custom-binary-output-port "sha256"
|
(values (make-custom-binary-output-port "sha256"
|
||||||
write! #f #f
|
write! get-position #f
|
||||||
close)
|
close)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(unless digest
|
(unless digest
|
||||||
|
|
|
@ -64,12 +64,12 @@
|
||||||
(get)))
|
(get)))
|
||||||
|
|
||||||
(test-equal "open-sha256-port, hello"
|
(test-equal "open-sha256-port, hello"
|
||||||
%hello-sha256
|
(list %hello-sha256 (string-length "hello world"))
|
||||||
(let-values (((port get)
|
(let-values (((port get)
|
||||||
(open-sha256-port)))
|
(open-sha256-port)))
|
||||||
(put-bytevector port (string->utf8 "hello world"))
|
(put-bytevector port (string->utf8 "hello world"))
|
||||||
(force-output port)
|
(force-output port)
|
||||||
(get)))
|
(list (get) (port-position port))))
|
||||||
|
|
||||||
(test-assert "port-sha256"
|
(test-assert "port-sha256"
|
||||||
(let* ((file (search-path %load-path "ice-9/psyntax.scm"))
|
(let* ((file (search-path %load-path "ice-9/psyntax.scm"))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue