ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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'.
This commit is contained in:
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 @@ (define* (gnu-build store name source inputs
(patches ''()) (patch-flags ''("--batch" "-p1")) (patches ''()) (patch-flags ''("--batch" "-p1"))
(tests? #t) (tests? #t)
(parallel-build? #t) (parallel-tests? #t) (parallel-build? #t) (parallel-tests? #t)
(patch-shebangs? #t)
(phases '%standard-phases) (phases '%standard-phases)
(system (%current-system)) (system (%current-system))
(modules '((guix build gnu-build-system) (modules '((guix build gnu-build-system)
@ -69,7 +70,8 @@ (define builder
#:make-flags ,make-flags #:make-flags ,make-flags
#:tests? ,tests? #:tests? ,tests?
#:parallel-build? ,parallel-build? #:parallel-build? ,parallel-build?
#:parallel-tests? ,parallel-tests?))) #:parallel-tests? ,parallel-tests?
#:patch-shebangs? ,patch-shebangs?)))
(build-expression->derivation store name system (build-expression->derivation store name system
builder builder

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

@ -21,6 +21,7 @@ (define-module (guix build gnu-build-system)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%standard-phases #:export (%standard-phases
gnu-build)) gnu-build))
@ -117,11 +118,34 @@ (define* (check #:key (make-flags '()) (tests? #t) (test-target "check")
(define* (install #:key (make-flags '()) #:allow-other-keys) (define* (install #:key (make-flags '()) #:allow-other-keys)
(zero? (apply system* "make" "install" make-flags))) (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 (define %standard-phases
;; Standard build phases, as a list of symbol/procedure pairs. ;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules () (let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...))))) ((_ 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) (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)