graft: Correctly replace references near the end of the scan buffer.
Fixes <http://bugs.gnu.org/28212>. Reported by Leo Famulari <leo@famulari.name>. * guix/build/graft.scm (replace-store-references): When I >= END, check whether WRITTEN > END and call 'get-bytevector-n!' when it is. * tests/grafts.scm (buffer-size): New variable. ("replace-store-references, <http://bugs.gnu.org/28212>"): New test.
This commit is contained in:
parent
5e60bef980
commit
94e86a6b67
|
@ -164,7 +164,11 @@ bytevectors to the same value."
|
|||
;; not to unget bytes that have already been written, because
|
||||
;; that would cause them to be written again from the next
|
||||
;; buffer. In practice, this case occurs when a replacement is
|
||||
;; made near the end of the buffer.
|
||||
;; made near or beyond the end of the buffer. When REPLACEMENT
|
||||
;; went beyond END, we consume the extra bytes from INPUT.
|
||||
(begin
|
||||
(if (> written end)
|
||||
(get-bytevector-n! input buffer 0 (- written end))
|
||||
(let* ((unwritten (- end written))
|
||||
(unget-size (if (= end request-size)
|
||||
(min hash-length unwritten)
|
||||
|
@ -172,7 +176,7 @@ bytevectors to the same value."
|
|||
(write-size (- unwritten unget-size)))
|
||||
(put-bytevector output buffer written write-size)
|
||||
(unget-bytevector input buffer (+ written write-size)
|
||||
unget-size)
|
||||
unget-size)))
|
||||
(loop)))))))))
|
||||
|
||||
(define (rename-matching-files directory mapping)
|
||||
|
|
|
@ -28,7 +28,9 @@
|
|||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs io ports))
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (ice-9 vlist))
|
||||
|
||||
(define %store
|
||||
(open-connection-for-tests))
|
||||
|
@ -442,4 +444,34 @@
|
|||
(and (file-exists? (string-append out "/p2/replacement"))
|
||||
(file-exists? (string-append out "/p2/p1/replacement")))))))
|
||||
|
||||
(define buffer-size
|
||||
;; Must be equal to REQUEST-SIZE in 'replace-store-references'.
|
||||
(expt 2 20))
|
||||
|
||||
(test-equal "replace-store-references, <http://bugs.gnu.org/28212>"
|
||||
(string-append (make-string (- buffer-size 47) #\a)
|
||||
"/gnu/store/" (make-string 32 #\8)
|
||||
"-SoMeTHiNG"
|
||||
(list->string (map integer->char (iota 77 33))))
|
||||
|
||||
;; Create input data where the right-hand-size of the dash ("-something"
|
||||
;; here) goes beyond the end of the internal buffer of
|
||||
;; 'replace-store-references'.
|
||||
(let* ((content (string-append (make-string (- buffer-size 47) #\a)
|
||||
"/gnu/store/" (make-string 32 #\7)
|
||||
"-something"
|
||||
(list->string
|
||||
(map integer->char (iota 77 33)))))
|
||||
(replacement (alist->vhash
|
||||
`((,(make-string 32 #\7)
|
||||
. ,(string->utf8 (string-append
|
||||
(make-string 32 #\8)
|
||||
"-SoMeTHiNG")))))))
|
||||
(call-with-output-string
|
||||
(lambda (output)
|
||||
((@@ (guix build graft) replace-store-references)
|
||||
(open-input-string content) output
|
||||
replacement
|
||||
"/gnu/store")))))
|
||||
|
||||
(test-end)
|
||||
|
|
Loading…
Reference in New Issue