diff options
| author | Clément Lassieur <clement@lassieur.org> | 2019-11-17 13:29:19 +0100 |
|---|---|---|
| committer | Clément Lassieur <clement@lassieur.org> | 2019-12-01 11:26:11 +0100 |
| commit | f71b0a0012d46bd30ead1a14ed58fd59647415e2 (patch) | |
| tree | c5ab18f066db9d12255c325a5aed1998cab8f156 /gnu/ci.scm | |
| parent | db1106e2b5693aff5063b74d4a78eef3c0a4d900 (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.scm | 22 |
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)) |