[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#36378: Guix Cuirass Issue with Input channels
From: |
Clément Lassieur |
Subject: |
bug#36378: Guix Cuirass Issue with Input channels |
Date: |
Sun, 17 Nov 2019 17:16:32 +0100 |
User-agent: |
mu4e 1.2.0; emacs 26.3 |
Clément Lassieur <address@hidden> writes:
>> So it's indeed a bug in Guix, introduced by commit
>> b5f8c2c88543158e8aca76aa98f9009f6b9e743a (hydra: Compute jobs in an
>> inferior). We can't just take the first input we find, build it and
>> open an inferior for it. I believe we should take the input whose name
>> is "guix" (as we do with manifests[2]).
>
> Well, we need something a bit more subtle, because in
> https://ci.guix.info Guix inputs are named "core-updates", "guix",
> "guix-modular", "staging", "version-1.0.0", "version-1.0.1",
> "wip-haskell-updates".
Attached is a patch that makes sure the checkout is from the Guix input
providing the 'proc'.
I'm not sure about one thing: in gnu/ci.scm I call FIND-CURRENT-CHECKOUT
in case the current Guix is not an inferior. But I don't know if it can
happen. If it can't happen, we could just do:
(define checkout
(assq-ref arguments 'superior-guix-checkout))
What do you think?
Clément
>From f484bba1b8a202dce6e6ac01d19eaee0b40b2501 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Lassieur?= <address@hidden>
Date: Sun, 17 Nov 2019 13:29:19 +0100
Subject: [PATCH] ci: Make sure the Guix checkout is the one providing Cuirass
proc.
Fixes <https://bugs.gnu.org/36378>.
Reported by Reza Alizadeh Majd <address@hidden>.
* 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.
---
build-aux/hydra/gnu-system.scm | 36 +++++++++++++++++++++-------------
gnu/ci.scm | 22 +++++++++++++--------
2 files changed, 36 insertions(+), 22 deletions(-)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index 775bbd9db2..f54302cf63 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès
<address@hidden>
;;; Copyright © 2017 Jan Nieuwenhuizen <address@hidden>
-;;; Copyright © 2018 Clément Lassieur <address@hidden>
+;;; Copyright © 2018, 2019 Clément Lassieur <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -34,16 +34,22 @@
(setvbuf (current-error-port) _IOLBF)
(set-current-output-port (current-error-port))
+(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)))
+
(define (hydra-jobs store arguments)
"Return a list of jobs where each job is a NAME/THUNK pair."
+
(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))
+ (find-current-checkout arguments))
(define commit
(assq-ref checkout 'revision))
@@ -70,9 +76,11 @@
((name . fields)
;; Hydra expects a thunk, so here it is.
(cons name (lambda () fields))))
- (inferior-eval-with-store inferior store
- `(lambda (store)
- (map (match-lambda
- ((name . thunk)
- (cons name (thunk))))
- (hydra-jobs store ',arguments)))))))
+ (inferior-eval-with-store
+ inferior store
+ `(lambda (store)
+ (map (match-lambda
+ ((name . thunk)
+ (cons name (thunk))))
+ (hydra-jobs store '((superior-guix-checkout . ,checkout)
+ ,@arguments))))))))
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
<address@hidden>
;;; Copyright © 2017 Jan Nieuwenhuizen <address@hidden>
-;;; Copyright © 2018 Clément Lassieur <address@hidden>
+;;; Copyright © 2018, 2019 Clément Lassieur <address@hidden>
;;;
;;; 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))
--
2.23.0