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

* 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

View file

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