me
/
guix
Archived
1
0
Fork 0
Code

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

* guix/build/gnu-build-system.scm (patch-shebangs): New procedure.
  (%standard-phases): Add it.

* guix/build-system/gnu.scm (gnu-build): New `patch-shebangs?' keyword
  parameter.  Pass it to the builder's `gnu-build'.
master
Ludovic Courtès 2012-08-19 17:54:54 +02:00
parent ebe2f31f19
commit 437fd80992
2 changed files with 28 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -48,6 +48,7 @@
(patches ''()) (patch-flags ''("--batch" "-p1"))
(tests? #t)
(parallel-build? #t) (parallel-tests? #t)
(patch-shebangs? #t)
(phases '%standard-phases)
(system (%current-system))
(modules '((guix build gnu-build-system)
@ -69,7 +70,8 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
#:make-flags ,make-flags
#:tests? ,tests?
#:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?)))
#:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?)))
(build-expression->derivation store name system
builder

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

@ -21,6 +21,7 @@
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases
gnu-build))
@ -117,11 +118,34 @@
(define* (install #:key (make-flags '()) #:allow-other-keys)
(zero? (apply system* "make" "install" make-flags)))
(define* (patch-shebangs #:key outputs (patch-shebangs? #t)
#:allow-other-keys)
(define (list-of-files dir)
(map (cut string-append dir "/" <>)
(or (scandir dir (lambda (f)
(let ((s (stat (string-append dir "/" f))))
(eq? 'regular (stat:type s)))))
'())))
(define bindirs
(append-map (match-lambda
((_ . dir)
(list (string-append dir "/bin")
(string-append dir "/sbin"))))
outputs))
(for-each (lambda (dir)
(let ((files (list-of-files dir)))
(for-each patch-shebang files)))
bindirs)
#t)
(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)))
(phases set-paths unpack patch configure build check install
patch-shebangs)))
(define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)