From 1e868858fd2de0d1125e6191be5e28df22fe6665 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 27 Mar 2018 20:05:58 -0400 Subject: tests: Use invoke and return #t from all builders. * tests/packages.scm ("package-source-derivation, snippet", "trivial") ("trivial with local file as input", "trivial with source") ("trivial with system-dependent input", "trivial with #:allowed-references") ("--search-paths with pattern", "--search-paths with single-item search path") ("replacement also grafted"): In the builders, raise an exception on errors and otherwise return #t. Use invoke. --- tests/profiles.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'tests/profiles.scm') diff --git a/tests/profiles.scm b/tests/profiles.scm index 92eb08cb9e..eba79d4e31 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -453,7 +453,8 @@ (define (entry->sexp entry) (mkdir (string-append out "/etc")) (call-with-output-file (string-append out "/etc/foo") (lambda (port) - (display "foo!" port)))))))) + (display "foo!" port))) + #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() @@ -482,7 +483,8 @@ (define (entry->sexp entry) (symlink "foo" (string-append out "/etc")) (call-with-output-file (string-append out "/etc/bar") (lambda (port) - (display "foo!" port)))))))) + (display "foo!" port))) + #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() -- cgit v1.2.3 From ede121de426f9c56820852888a0b370f0ccbce49 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Sun, 8 Apr 2018 16:51:42 -0700 Subject: guix: Separate the package name and version with "@", not "-". * guix/packages.scm (package-full-name): By default, use "@" to separate the package name and package version. Add an optional delimiter argument so that there is still a way to explicitly use a different delimiter. * gnu/packages/commencement.scm (gcc-boot0) : Adjust accordingly. * tests/graph.scm: Adjust accordingly. * tests/profiles.scm: Adjust accordingly. * NEWS: Mention the change. Fixes: . Reported by Pierre Neidhardt . --- NEWS | 5 +++++ gnu/packages/commencement.scm | 2 +- guix/packages.go.134WZR | 0 guix/packages.scm | 13 +++++++++---- tests/graph.scm | 2 +- tests/profiles.scm | 11 +++++------ 6 files changed, 21 insertions(+), 12 deletions(-) create mode 100644 guix/packages.go.134WZR (limited to 'tests/profiles.scm') diff --git a/NEWS b/NEWS index 2c898e65f9..ca57f5d1fc 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,11 @@ Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès Please send Guix bug reports to bug-guix@gnu.org. +* Changes in 0.15.0 (since 0.14.0) +** Programming interfaces + +*** package-full-name (guix packages) now uses "@" as its delimiter. + () * Changes in 0.14.0 (since 0.13.0) ** Package management diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index 1026ee8929..2791409bf9 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -282,7 +282,7 @@ (define gcc-boot0 ;; Drop trailing letters, as gmp-6.0.0a unpacks ;; into gmp-6.0.0. `(symlink ,(string-trim-right - (package-full-name lib) + (package-full-name lib "-") char-set:letter) ,(package-name lib))) (list gmp-6.0 mpfr mpc)))) diff --git a/guix/packages.go.134WZR b/guix/packages.go.134WZR new file mode 100644 index 0000000000..e69de29bb2 diff --git a/guix/packages.scm b/guix/packages.scm index b5c0b60440..e0ab72086c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -388,10 +388,11 @@ (define-condition-type &package-input-error &package-error (define-condition-type &package-cross-build-system-error &package-error package-cross-build-system-error?) - -(define (package-full-name package) - "Return the full name of PACKAGE--i.e., `NAME-VERSION'." - (string-append (package-name package) "-" (package-version package))) +(define* (package-full-name package #:optional (delimiter "@")) + "Return the full name of PACKAGE--i.e., `NAME@VERSION'. By specifying +DELIMITER (a string), you can customize what will appear between the name and +the version. By default, DELIMITER is \"@\"." + (string-append (package-name package) delimiter (package-version package))) (define (%standard-patch-inputs) (let* ((canonical (module-ref (resolve-interface '(gnu packages base)) @@ -935,6 +936,10 @@ (define* (package->bag package #:optional (($ name version source build-system args inputs propagated-inputs native-inputs self-native-input? outputs) + ;; Even though we prefer to use "@" to separate the package + ;; name from the package version in various user-facing parts + ;; of Guix, checkStoreName (in nix/libstore/store-api.cc) + ;; prohibits the use of "@", so use "-" instead. (or (make-bag build-system (string-append name "-" version) #:system system #:target target diff --git a/tests/graph.scm b/tests/graph.scm index 5faa19298a..b86ae4a32f 100644 --- a/tests/graph.scm +++ b/tests/graph.scm @@ -134,7 +134,7 @@ (define (edge->tuple source target) (map (lambda (destination) (list "p-0.drv" (string-append - (package-full-name destination) + (package-full-name destination "-") ".drv"))) implicit))))))) diff --git a/tests/profiles.scm b/tests/profiles.scm index 92eb08cb9e..8d3cfe91d3 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -242,8 +242,8 @@ (define glibc #:hooks '() #:locales? #t #:target target))) - (define (find-input name) - (let ((name (string-append name ".drv"))) + (define (find-input package) + (let ((name (string-append (package-full-name package "-") ".drv"))) (any (lambda (input) (let ((input (derivation-input-path input))) (and (string-suffix? name input) input))) @@ -252,12 +252,11 @@ (define (find-input name) ;; The inputs for grep and sed should be cross-build derivations, but that ;; for the glibc-utf8-locales should be a native build. (return (and (string=? (derivation-system drv) (%current-system)) - (string=? (find-input (package-full-name packages:grep)) + (string=? (find-input packages:grep) (derivation-file-name grep)) - (string=? (find-input (package-full-name packages:sed)) + (string=? (find-input packages:sed) (derivation-file-name sed)) - (string=? (find-input - (package-full-name packages:glibc-utf8-locales)) + (string=? (find-input packages:glibc-utf8-locales) (derivation-file-name locales)))))) (test-assert "package->manifest-entry defaults to \"out\"" -- cgit v1.2.3 From e00ade3fb81f89cd7c030f998ccd3e07ef2628f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 Apr 2018 22:20:36 +0200 Subject: profiles: Optionally use relative file names for symlink targets. * guix/build/union.scm (symlink-relative): New procedure. * guix/build/profiles.scm: Re-export it. (build-profile): Add #:symlink and pass it to 'union-build'. * guix/profiles.scm (profile-derivation): Add #:relative-symlinks?. Pass #:symlink to 'build-profile'. * tests/profiles.scm ("profile-derivation relative symlinks, one entry") ("profile-derivation relative symlinks, two entries"): New tests. --- guix/build/profiles.scm | 14 +++++++++----- guix/build/union.scm | 9 ++++++++- guix/profiles.scm | 7 +++++++ tests/profiles.scm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 70 insertions(+), 6 deletions(-) (limited to 'tests/profiles.scm') diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm index b4160fba1b..819688a913 100644 --- a/guix/build/profiles.scm +++ b/guix/build/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017 Ludovic Courtès +;;; Copyright © 2015, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +24,7 @@ (define-module (guix build profiles) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) + #:re-export (symlink-relative) ;for convenience #:export (ensure-writable-directory build-profile)) @@ -129,12 +130,15 @@ (define (unsymlink link) (apply throw args)))))) (define* (build-profile output inputs - #:key manifest search-paths) - "Build a user profile from INPUTS in directory OUTPUT. Write MANIFEST, an -sexp, to OUTPUT/manifest. Create OUTPUT/etc/profile with Bash definitions for --all the variables listed in SEARCH-PATHS." + #:key manifest search-paths + (symlink symlink)) + "Build a user profile from INPUTS in directory OUTPUT, using SYMLINK to +create symlinks. Write MANIFEST, an sexp, to OUTPUT/manifest. Create +OUTPUT/etc/profile with Bash definitions for -all the variables listed in +SEARCH-PATHS." ;; Make the symlinks. (union-build output inputs + #:symlink symlink #:log-port (%make-void-port "w")) ;; Store meta-data. diff --git a/guix/build/union.scm b/guix/build/union.scm index 82d6199d9e..24b366af45 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -29,7 +29,8 @@ (define-module (guix build union) warn-about-collision - relative-file-name)) + relative-file-name + symlink-relative)) ;;; Commentary: ;;; @@ -213,4 +214,10 @@ (define (finish) (finish))))))) file)) +(define (symlink-relative old new) + "Assuming both OLD and NEW are absolute file names, make NEW a symlink to +OLD, but using a relative file name." + (symlink (relative-file-name (dirname new) old) + new)) + ;;; union.scm ends here diff --git a/guix/profiles.scm b/guix/profiles.scm index 95dc9746bd..c17961c987 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1202,6 +1202,7 @@ (define* (profile-derivation manifest (hooks %default-profile-hooks) (locales? #t) (allow-collisions? #f) + (relative-symlinks? #f) system target) "Return a derivation that builds a profile (aka. 'user environment') with the given MANIFEST. The profile includes additional derivations returned by @@ -1213,6 +1214,9 @@ (define* (profile-derivation manifest When LOCALES? is true, the build is performed under a UTF-8 locale; this adds a dependency on the 'glibc-utf8-locales' package. +When RELATIVE-SYMLINKS? is true, use relative file names for symlink targets. +This is one of the things to do for the result to be relocatable. + When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST are cross-built for TARGET." (mlet* %store-monad ((system (if system @@ -1275,6 +1279,9 @@ (define search-paths (manifest-entries manifest)))))) (build-profile #$output '#$inputs + #:symlink #$(if relative-symlinks? + #~symlink-relative + #~symlink) #:manifest '#$(manifest->gexp manifest) #:search-paths search-paths)))) diff --git a/tests/profiles.scm b/tests/profiles.scm index 8d3cfe91d3..c668c2b831 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -223,6 +223,52 @@ (define glibc (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) +(test-assertm "profile-derivation relative symlinks, one entry" + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)) + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (string=? (readlink bindir) + (string-append "../" + (basename + (derivation->output-path guile)) + "/bin")))))) + +(unless (network-reachable?) (test-skip 1)) +(test-assertm "profile-derivation relative symlinks, two entries" + (mlet* %store-monad + ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0)) + (manifest -> (packages->manifest + (list %bootstrap-guile gnu-make-boot0))) + (guile (package->derivation %bootstrap-guile)) + (make (package->derivation gnu-make-boot0)) + (drv (profile-derivation manifest + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (file-exists? (string-append bindir "/make")) + (string=? (readlink (string-append bindir "/guile")) + (string-append "../../" + (basename + (derivation->output-path guile)) + "/bin/guile")) + (string=? (readlink (string-append bindir "/make")) + (string-append "../../" + (basename + (derivation->output-path make)) + "/bin/make")))))) + (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) -- cgit v1.2.3