TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

build-system/gnu: Honor the patch-shebangs?' and strip-binaries?' parameters.

Browse source 
* guix/build/gnu-build-system.scm (patch-shebangs): Honor
  PATCH-SHEBANGS?.
  (strip): Honor STRIP-BINARIES?.  Display a message from `strip-dir'.
This commit is contained in:
Ludovic Courtès 2012-08-31 23:58:21 +02:00
parent 8759a648ba
commit 877217b85a
1 changed files with 19 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
guix/build/gnu-build-system.scm
View file

@ -152,13 +152,14 @@ (define bindirs
(string-append dir "/sbin")))) (string-append dir "/sbin"))))
outputs)) outputs))
(let ((path (append bindirs (when patch-shebangs?
(search-path-as-string->list (getenv "PATH"))))) (let ((path (append bindirs
(for-each (lambda (dir) (search-path-as-string->list (getenv "PATH")))))
(let ((files (list-of-files dir))) (for-each (lambda (dir)
(for-each (cut patch-shebang <> path) files))) (let ((files (list-of-files dir)))
bindirs) (for-each (cut patch-shebang <> path) files)))
#t)) bindirs)))
#t)
(define* (strip #:key outputs (strip-binaries? #t) (define* (strip #:key outputs (strip-binaries? #t)
(strip-flags '("--strip-debug")) (strip-flags '("--strip-debug"))
@ -166,6 +167,8 @@ (define* (strip #:key outputs (strip-binaries? #t)
"bin" "sbin")) "bin" "sbin"))
#:allow-other-keys) #:allow-other-keys)
(define (strip-dir dir) (define (strip-dir dir)
(format #t "stripping binaries in ~s with flags ~s~%"
dir strip-flags)
(file-system-fold (const #t) (file-system-fold (const #t)
(lambda (path stat result) ; leaf (lambda (path stat result) ; leaf
(zero? (apply system* "strip" (zero? (apply system* "strip"
@ -181,14 +184,15 @@ (define (strip-dir dir)
#t #t
dir)) dir))
(every strip-dir (or (not strip-binaries?)
(append-map (match-lambda (every strip-dir
((_ . dir) (append-map (match-lambda
(filter-map (lambda (d) ((_ . dir)
(let ((sub (string-append dir "/" d))) (filter-map (lambda (d)
(and (directory-exists? sub) sub))) (let ((sub (string-append dir "/" d)))
strip-directories))) (and (directory-exists? sub) sub)))
outputs))) strip-directories)))
outputs))))
(define %standard-phases (define %standard-phases
;; Standard build phases, as a list of symbol/procedure pairs. ;; Standard build phases, as a list of symbol/procedure pairs.