ソースを参照

profiles: Add lowerable <profile> record type.

* guix/profiles.scm (<profile>): New record type.
* tests/profiles.scm ("<profile>"): New test.
gn-latest-20200428
Ludovic Courtès 5ヶ月前
コミット
ef674a24c5
この署名に対応する既知のキーがデータベースに存在しません GPGキーID: 90B11993D9AEBB5
2個のファイルの変更48行の追加1行の削除
  1. +36
    -0
      guix/profiles.scm
  2. +12
    -1
      tests/profiles.scm

+ 36
- 0
guix/profiles.scm ファイルの表示

@@ -125,6 +125,15 @@
profile-derivation
profile-search-paths

profile
profile?
profile-name
profile-content
profile-hooks
profile-locales?
profile-allow-collisions?
profile-relative-symlinks?

generation-number
generation-profile
generation-numbers
@@ -1656,6 +1665,33 @@ are cross-built for TARGET."
. ,(length
(manifest-entries manifest))))))))

;; Declarative profile.
(define-record-type* <profile> profile make-profile
profile?
(name profile-name (default "profile")) ;string
(content profile-content) ;<manifest>
(hooks profile-hooks ;list of procedures
(default %default-profile-hooks))
(locales? profile-locales? ;Boolean
(default #t))
(allow-collisions? profile-allow-collisions? ;Boolean
(default #f))
(relative-symlinks? profile-relative-symlinks? ;Boolean
(default #f)))

(define-gexp-compiler (profile-compiler (profile <profile>) system target)
"Compile PROFILE to a derivation."
(match profile
(($ <profile> name manifest hooks
locales? allow-collisions? relative-symlinks?)
(profile-derivation manifest
#:name name
#:hooks hooks
#:locales? locales?
#:allow-collisions? allow-collisions?
#:relative-symlinks? relative-symlinks?
#:system system #:target target))))

(define* (profile-search-paths profile
#:optional (manifest (profile-manifest profile))
#:key (getenv (const #f)))


+ 12
- 1
tests/profiles.scm ファイルの表示

@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -223,6 +223,17 @@
(string=? (dirname (readlink bindir))
(derivation->output-path guile))))))

(test-assertm "<profile>"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
(profile -> (profile (hooks '()) (locales? #f)
(content (manifest (list entry)))))
(drv (lower-object profile))
(profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin"))
(_ (built-derivations (list drv))))
(return (file-exists? (string-append bindir "/guile")))))

(test-assertm "profile-derivation relative symlinks, one entry"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))


読み込み中…
キャンセル
保存