utils: Call the progress-report proc when 'dump-port' starts.

* guix/build/utils.scm (dump-port): Add call to PROGRESS at the
  beginning.
This commit is contained in:
Ludovic Courtès 2015-02-27 14:56:01 +01:00
parent 251e8b2ee8
commit 2c1fb35377
1 changed files with 12 additions and 7 deletions

View File

@ -588,22 +588,27 @@ match the terminating newline of a line."
(define* (dump-port in out (define* (dump-port in out
#:key (buffer-size 16384) #:key (buffer-size 16384)
(progress (lambda (t k) (k)))) (progress (lambda (t k) (k))))
"Read as much data as possible from IN and write it to OUT, using "Read as much data as possible from IN and write it to OUT, using chunks of
chunks of BUFFER-SIZE bytes. Call PROGRESS after each successful BUFFER-SIZE bytes. Call PROGRESS at the beginning and after each successful
transfer of BUFFER-SIZE bytes or less, passing it the total number of transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes
bytes transferred and the continuation of the transfer as a thunk." transferred and the continuation of the transfer as a thunk."
(define buffer (define buffer
(make-bytevector buffer-size)) (make-bytevector buffer-size))
(let loop ((total 0) (define (loop total bytes)
(bytes (get-bytevector-n! in buffer 0 buffer-size)))
(or (eof-object? bytes) (or (eof-object? bytes)
(let ((total (+ total bytes))) (let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes) (put-bytevector out buffer 0 bytes)
(progress total (progress total
(lambda () (lambda ()
(loop total (loop total
(get-bytevector-n! in buffer 0 buffer-size)))))))) (get-bytevector-n! in buffer 0 buffer-size)))))))
;; Make sure PROGRESS is called when we start so that it can measure
;; throughput.
(progress 0
(lambda ()
(loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
(define (set-file-time file stat) (define (set-file-time file stat)
"Set the atime/mtime of FILE to that specified by STAT." "Set the atime/mtime of FILE to that specified by STAT."