me
/
guix
Archived
1
0
Fork 0
Code

serialization: 'fold-archive' notifies about directory processing completion. 

* guix/serialization.scm (fold-archive): Call PROC with a
'directory-complete tag when done with a directory.
(restore-file): Handle it.
* guix/scripts/archive.scm (list-contents): Likewise.
* guix/scripts/challenge.scm (archive-contents): Likewise.
* tests/nar.scm ("write-file-tree + fold-archive"): Adjust accordingly.
master
Ludovic Courtès 2020-12-09 21:50:21 +01:00
parent 7a2897149d
commit 465d2cb286
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
guix/scripts/archive.scm
View File

@ -347,6 +347,8 @@ output port."
(match type (match type
('directory ('directory
(format #t "D ~a~%" file)) (format #t "D ~a~%" file))
('directory-complete
#t)
('symlink ('symlink
(format #t "S ~a -> ~a~%" file content)) (format #t "S ~a -> ~a~%" file content))
((or 'regular 'executable) ((or 'regular 'executable)

1
guix/scripts/challenge.scm
View File

@ -210,6 +210,7 @@ taken since we do not import the archives."
(cons `(,file ,type ,(port-sha256* port size)) (cons `(,file ,type ,(port-sha256* port size))
result)))) result))))
('directory result) ('directory result)
('directory-complete result)
('symlink ('symlink
(cons `(,file ,type ,contents) result)))) (cons `(,file ,type ,contents) result))))
'() '()

5
guix/serialization.scm
View File

@ -444,7 +444,8 @@ depends on TYPE."
(file file) (file file)
(token x)))))) (token x))))))
(loop (read-string port) result))))) (loop (read-string port) result)))))
(")" result) ;done with DIR (")" ;done with DIR
(proc file 'directory-complete #f result))
(x (x
(raise (raise
(condition (condition
@ -463,6 +464,8 @@ Restore it as FILE."
(match type (match type
('directory ('directory
(mkdir file)) (mkdir file))
('directory-complete
#t)
('symlink ('symlink
(symlink content file)) (symlink content file))
((or 'regular 'executable) ((or 'regular 'executable)

6
tests/nar.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -218,8 +218,10 @@
'(("R" directory #f) '(("R" directory #f)
("R/dir" directory #f) ("R/dir" directory #f)
("R/dir/exe" executable "1234") ("R/dir/exe" executable "1234")
("R/dir" directory-complete #f)
("R/foo" regular "abcdefg") ("R/foo" regular "abcdefg")
("R/lnk" symlink "foo")) ("R/lnk" symlink "foo")
("R" directory-complete #f))
(let () (let ()
(define-values (port get-bytevector) (define-values (port get-bytevector)