nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: patch-and-repack: Use invoke instead of system*. 

* guix/packages.scm (patch-and-repack): Use invoke and remove vestigial
plumbing.
This commit is contained in:
Mark H Weaver 2018-03-16 03:38:27 -04:00
parent 80420f114c
commit 7ac1b4084f
No known key found for this signature in database
GPG Key ID: 7CEF29847562C516
1 changed files with 61 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
guix/packages.scm
View File

@ -519,9 +519,9 @@ specifies modules in scope when evaluating SNIPPET."
;; Use '--force' so that patches that do not apply perfectly are ;; Use '--force' so that patches that do not apply perfectly are
;; rejected. Use '--no-backup-if-mismatch' to prevent making ;; rejected. Use '--no-backup-if-mismatch' to prevent making
;; "*.orig" file if a patch is applied with offset. ;; "*.orig" file if a patch is applied with offset.
(zero? (system* (string-append #+patch "/bin/patch") (invoke (string-append #+patch "/bin/patch")
"--force" "--no-backup-if-mismatch" "--force" "--no-backup-if-mismatch"
#+@flags "--input" patch))) #+@flags "--input" patch))
(define (first-file directory) (define (first-file directory)
;; Return the name of the first file in DIRECTORY. ;; Return the name of the first file in DIRECTORY.
@ -546,26 +546,27 @@ specifies modules in scope when evaluating SNIPPET."
#+decomp "/bin")) #+decomp "/bin"))
;; SOURCE may be either a directory or a tarball. ;; SOURCE may be either a directory or a tarball.
(and (if (file-is-directory? #+source) (if (file-is-directory? #+source)
(let* ((store (%store-directory)) (let* ((store (%store-directory))
(len (+ 1 (string-length store))) (len (+ 1 (string-length store)))
(base (string-drop #+source len)) (base (string-drop #+source len))
(dash (string-index base #\-)) (dash (string-index base #\-))
(directory (string-drop base (+ 1 dash)))) (directory (string-drop base (+ 1 dash))))
(mkdir directory) (mkdir directory)
(copy-recursively #+source directory) (copy-recursively #+source directory))
#t)
#+(if (string=? decompression-type "unzip") #+(if (string=? decompression-type "unzip")
#~(zero? (system* "unzip" #+source)) #~(invoke "unzip" #+source)
#~(zero? (system* (string-append #+tar "/bin/tar") #~(invoke (string-append #+tar "/bin/tar")
"xvf" #+source)))) "xvf" #+source)))
(let ((directory (first-file "."))) (let ((directory (first-file ".")))
(format (current-error-port) (format (current-error-port)
"source is under '~a'~%" directory) "source is under '~a'~%" directory)
(chdir directory) (chdir directory)
(and (every apply-patch '#+patches) (for-each apply-patch '#+patches)
#+@(if snippet
(unless #+@(if snippet
#~((let ((module (make-fresh-user-module))) #~((let ((module (make-fresh-user-module)))
(module-use-interfaces! (module-use-interfaces!
module module
@ -576,8 +577,10 @@ specifies modules in scope when evaluating SNIPPET."
#:opts %auto-compilation-options #:opts %auto-compilation-options
#:env module))) #:env module)))
#~()) #~())
(format (current-error-port)
"snippet returned false, indicating failure~%"))
(begin (chdir "..") #t) (chdir "..")
(unless tar-supports-sort? (unless tar-supports-sort?
(call-with-output-file ".file_list" (call-with-output-file ".file_list"
@ -587,7 +590,7 @@ specifies modules in scope when evaluating SNIPPET."
(find-files directory (find-files directory
#:directories? #t #:directories? #t
#:fail-on-error? #t))))) #:fail-on-error? #t)))))
(zero? (apply system* (apply invoke
(string-append #+tar "/bin/tar") (string-append #+tar "/bin/tar")
"cvf" #$output "cvf" #$output
;; The bootstrap xz does not support ;; The bootstrap xz does not support
@ -603,7 +606,7 @@ specifies modules in scope when evaluating SNIPPET."
`("--sort=name" `("--sort=name"
,directory) ,directory)
'("--no-recursion" '("--no-recursion"
"--files-from=.file_list")))))))))) "--files-from=.file_list")))))))
(let ((name (tarxz-name original-file-name))) (let ((name (tarxz-name original-file-name)))
(gexp->derivation name build (gexp->derivation name build