From 74cd03b1a08a73c349818312cf2e0be9f54e0d4e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 1 Jul 2012 17:32:03 +0200
Subject: [PATCH] build-system/gnu: Add a `patch' phase.
* guix/build/gnu-build-system.scm (patch): New procedure.
(%standard-phases): Add `patch'.
* guix/build-system/gnu.scm (gnu-build): Add `patches' and `patch-flags'
parameters. Pass them on.
---
guix/build-system/gnu.scm | 6 +++++-
guix/build/gnu-build-system.scm | 10 +++++++++-
2 files changed, 14 insertions(+), 2 deletions(-)
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 0f931dc582b..6876342b459 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -43,7 +43,9 @@ (define %standard-inputs
(define* (gnu-build store name source inputs
#:key (outputs '("out")) (configure-flags ''())
- (make-flags ''()) (phases '%standard-phases)
+ (make-flags ''())
+ (patches ''()) (patch-flags ''("--batch" "-p1"))
+ (phases '%standard-phases)
(system (%current-system))
(modules '((guix build gnu-build-system)
(guix build utils))))
@@ -57,6 +59,8 @@ (define builder
source)
#:outputs %outputs
#:inputs %build-inputs
+ #:patches ,patches
+ #:patch-flags ,patch-flags
#:phases ,phases
#:configure-flags ,configure-flags
#:make-flags ,make-flags)))
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 6ee9afc845b..566903ed732 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -56,6 +56,14 @@ (define* (unpack #:key source #:allow-other-keys)
(and (zero? (system* "tar" "xvf" source))
(chdir (first-subdirectory "."))))
+(define* (patch #:key (patches '()) (patch-flags '("--batch" "-p1"))
+ #:allow-other-keys)
+ (every (lambda (p)
+ (format #t "applying patch `~a'~%" p)
+ (zero? (apply system* "patch"
+ (append patch-flags (list p)))))
+ patches))
+
(define* (configure #:key outputs (configure-flags '()) #:allow-other-keys)
(let* ((prefix (assoc-ref outputs "out"))
(libdir (assoc-ref outputs "lib"))
@@ -94,7 +102,7 @@ (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 configure build check install)))
+ (phases set-paths unpack patch configure build check install)))
(define* (gnu-build #:key (source #f) (outputs #f) (inputs #f)
--
GitLab