~ruther/guix-local

e815763e69c621412830cada8ded53ccd1b8247f — Ludovic Courtès 13 years ago 8420997
build-system/gnu: Add a `strip' phase.

* 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.
2 files changed, 39 insertions(+), 2 deletions(-)

M guix/build-system/gnu.scm
M guix/build/gnu-build-system.scm
M guix/build-system/gnu.scm => guix/build-system/gnu.scm +8 -1
@@ 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

M guix/build/gnu-build-system.scm => guix/build/gnu-build-system.scm +31 -1
@@ 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)