summaryrefslogtreecommitdiff
path: root/gnu/ci.scm
diff options
context:
space:
mode:
authorClément Lassieur <clement@lassieur.org>2019-11-17 13:29:19 +0100
committerClément Lassieur <clement@lassieur.org>2019-12-01 11:26:11 +0100
commitf71b0a0012d46bd30ead1a14ed58fd59647415e2 (patch)
treec5ab18f066db9d12255c325a5aed1998cab8f156 /gnu/ci.scm
parentdb1106e2b5693aff5063b74d4a78eef3c0a4d900 (diff)
ci: Make sure the Guix checkout is the one providing Cuirass proc.
Fixes <https://bugs.gnu.org/36378>. Reported by Reza Alizadeh Majd <r.majd@pantherx.org>. * build-aux/hydra/gnu-system.scm (find-current-checkout): New procedure. (hydra-jobs): Use FIND-CURRENT-CHECKOUT to define CHECKOUT. Pass it to the inferior Guix as an extra argument whose key is 'superior-guix-checkout'. * gnu/ci.scm (find-current-checkout): New procedure. (hydra-jobs): Use FIND-CURRENT-CHECKOUT to define CHECKOUT. This will return '#f' if the current Guix is an inferior. In that case, use the 'superior-guix-checkout' argument provided by the superior Guix.
Diffstat (limited to 'gnu/ci.scm')
-rw-r--r--gnu/ci.scm22
1 files changed, 14 insertions, 8 deletions
diff --git a/gnu/ci.scm b/gnu/ci.scm
index f24049e772..d6eb2d018f 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
-;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018, 2019 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -374,6 +374,17 @@ valid."
load-manifest)
manifests))))
+(define (find-current-checkout arguments)
+ "Find the first checkout of ARGUMENTS that provided the current file.
+Return #f if no such checkout is found."
+ (let ((current-root
+ (canonicalize-path
+ (string-append (dirname (current-filename)) "/.."))))
+ (find (lambda (argument)
+ (and=> (assq-ref argument 'file-name)
+ (lambda (name)
+ (string=? name current-root)))) arguments)))
+
;;;
;;; Hydra entry point.
@@ -396,13 +407,8 @@ valid."
((? string? str) (call-with-input-string str read))))
(define checkout
- ;; Extract metadata about the 'guix' checkout. Its key in ARGUMENTS may
- ;; vary, so pick up the first one that's neither 'subset' nor 'systems'.
- (any (match-lambda
- ((key . value)
- (and (not (memq key '(systems subset)))
- value)))
- arguments))
+ (or (find-current-checkout arguments)
+ (assq-ref arguments 'superior-guix-checkout)))
(define commit
(assq-ref checkout 'revision))