kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

build-system/gnu: Add a `strip' phase.

Browse Source 
* guix/build/gnu-build-system.scm (strip): New procedure.
  (%standard-phases): Add it.

* guix/build-system/gnu.scm (gnu-build): New `strip-binaries?',
  `strip-flags', and `strip-directories' keyword parameters.  Pass them
  to BUILDER.
This commit is contained in:
Ludovic Courtès 2012-08-31 17:04:53 +02:00
parent 84209975fd
commit e815763e69
2 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
guix/build-system/gnu.scm
View File

@ -50,6 +50,10 @@
(tests? #t)
(parallel-build? #t) (parallel-tests? #t)
(patch-shebangs? #t)
(strip-binaries? #t)
(strip-flags ''("--strip-debug"))
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '%standard-phases)
(system (%current-system))
(modules '((guix build gnu-build-system)
@ -73,7 +77,10 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?)))
#:patch-shebangs? ,patch-shebangs?
#:strip-binaries? ,strip-binaries?
#:strip-flags ,strip-flags
#:strip-directories ,strip-directories)))
(build-expression->derivation store name system
builder

32
guix/build/gnu-build-system.scm
View File

@ -160,12 +160,42 @@
bindirs)
#t))
(define* (strip #:key outputs (strip-binaries? #t)
(strip-flags '("--strip-debug"))
(strip-directories '("lib" "lib64" "libexec"
"bin" "sbin"))
#:allow-other-keys)
(define (strip-dir dir)
(file-system-fold (const #t)
(lambda (path stat result) ; leaf
(zero? (apply system* "strip"
(append strip-flags (list path)))))
(const #t) ; down
(const #t) ; up
(const #t) ; skip
(lambda (path stat errno result)
(format (current-error-port)
"strip: failed to access `~a': ~a~%"
path (strerror errno))
#f)
#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)))
(define %standard-phases
;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...)))))
(phases set-paths unpack patch configure build check install
patch-shebangs)))
patch-shebangs strip)))
(define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)