X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/32e18e9b9471e863e5857a89683f358bfb91c157..4e94744dd9da1fde73328d810b8f7d92e12b7ca1:/gnu/ci.scm diff --git a/gnu/ci.scm b/gnu/ci.scm index 5d5a826647..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 ;;; Copyright © 2017 Jan Nieuwenhuizen -;;; Copyright © 2018 Clément Lassieur +;;; Copyright © 2018, 2019 Clément Lassieur ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,7 +54,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:export (hydra-jobs)) + #:export (channel-instance->package + hydra-jobs)) ;;; Commentary: ;;; @@ -373,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. @@ -395,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))