From 2876b9892583bc1245d77fd10286025cd8433ede Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Nov 2013 16:57:48 +0100 Subject: ui: Factorize package specification parsing. * guix/ui.scm (package-specification->name+version+output): New procedure. * guix/scripts/package.scm (specification->package+output): Use it. * tests/ui.scm ("package-specification->name+version+output"): New test. --- tests/ui.scm | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'tests') diff --git a/tests/ui.scm b/tests/ui.scm index 3d5c3e7969..08ee3967a8 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -65,6 +65,23 @@ interface, and powerful string processing.") 10) #\newline)) +(test-equal "package-specification->name+version+output" + '(("guile" #f "out") + ("guile" "2.0.9" "out") + ("guile" #f "debug") + ("guile" "2.0.9" "debug") + ("guile-cairo" "1.4.1" "out")) + (map (lambda (spec) + (call-with-values + (lambda () + (package-specification->name+version+output spec)) + list)) + '("guile" + "guile-2.0.9" + "guile:debug" + "guile-2.0.9:debug" + "guile-cairo-1.4.1"))) + (test-equal "integer" '(1) (string->generations "1")) -- cgit v1.2.3 From a20787706c246a9451b69db075a30ee91d28538b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Nov 2013 23:11:17 +0100 Subject: guix package: Allow removal of a specific package output. Fixes . * guix/profiles.scm (): New record type. (remove-manifest-entry): Remove. (entry-predicate, manifest-matching-entries): New procedures. (manifest-remove): Accept a list of . (manifest-installed?): Replace 'name' parameter by 'pattern', a . * guix/scripts/package.scm (options->removable): Return a list of . (guix-package)[process-action]: Use 'manifest-matching-entries' to compute the list of packages to remove. * tests/profiles.scm: New file. * Makefile.am (SCM_TESTS): Add it. --- .dir-locals.el | 2 + Makefile.am | 3 +- guix/profiles.scm | 70 ++++++++++++++++++++++++---------- guix/scripts/package.scm | 26 ++++++++----- tests/profiles.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 168 insertions(+), 30 deletions(-) create mode 100644 tests/profiles.scm (limited to 'tests') diff --git a/.dir-locals.el b/.dir-locals.el index dc1a3d724d..240fae1c12 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -14,6 +14,8 @@ (eval . (put 'substitute* 'scheme-indent-function 1)) (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'package 'scheme-indent-function 0)) + (eval . (put 'manifest-entry 'scheme-indent-function 0)) + (eval . (put 'manifest-pattern 'scheme-indent-function 0)) (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) (eval . (put 'with-error-handling 'scheme-indent-function 0)) (eval . (put 'with-mutex 'scheme-indent-function 1)) diff --git a/Makefile.am b/Makefile.am index 1960b1b76d..9462878d1c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -115,7 +115,8 @@ SCM_TESTS = \ tests/store.scm \ tests/monads.scm \ tests/nar.scm \ - tests/union.scm + tests/union.scm \ + tests/profiles.scm SH_TESTS = \ tests/guix-build.sh \ diff --git a/guix/profiles.scm b/guix/profiles.scm index 528f3c574b..1f62099e45 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -42,11 +42,15 @@ manifest-entry-path manifest-entry-dependencies + manifest-pattern + manifest-pattern? + read-manifest write-manifest manifest-remove manifest-installed? + manifest-matching-entries manifest=? profile-manifest @@ -90,6 +94,15 @@ (inputs manifest-entry-inputs ; list of inputs to build (default '()))) ; this entry +(define-record-type* manifest-pattern + make-manifest-pattern + manifest-pattern? + (name manifest-pattern-name) ; string + (version manifest-pattern-version ; string | #f + (default #f)) + (output manifest-pattern-output ; string | #f + (default "out"))) + (define (profile-manifest profile) "Return the PROFILE's manifest." (let ((file (string-append profile "/manifest"))) @@ -148,29 +161,48 @@ "Write MANIFEST to PORT." (write (manifest->sexp manifest) port)) -(define (remove-manifest-entry name lst) - "Remove the manifest entry named NAME from LST." - (remove (match-lambda - (($ entry-name) - (string=? name entry-name))) - lst)) - -(define (manifest-remove manifest names) - "Remove entries for each of NAMES from MANIFEST." - (make-manifest (fold remove-manifest-entry +(define (entry-predicate pattern) + "Return a procedure that returns #t when passed a manifest entry that +matches NAME/OUTPUT/VERSION. OUTPUT and VERSION may be #f, in which case they +are ignored." + (match pattern + (($ name version output) + (match-lambda + (($ entry-name entry-version entry-output) + (and (string=? entry-name name) + (or (not entry-output) (not output) + (string=? entry-output output)) + (or (not version) + (string=? entry-version version)))))))) + +(define (manifest-remove manifest patterns) + "Remove entries for each of PATTERNS from MANIFEST. Each item in PATTERNS +must be a manifest-pattern." + (define (remove-entry pattern lst) + (remove (entry-predicate pattern) lst)) + + (make-manifest (fold remove-entry (manifest-entries manifest) - names))) - -(define (manifest-installed? manifest name) - "Return #t if MANIFEST has an entry for NAME, #f otherwise." - (define (->bool x) - (not (not x))) + patterns))) - (->bool (find (match-lambda - (($ entry-name) - (string=? entry-name name))) +(define (manifest-installed? manifest pattern) + "Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern), +#f otherwise." + (->bool (find (entry-predicate pattern) (manifest-entries manifest)))) +(define (manifest-matching-entries manifest patterns) + "Return all the entries of MANIFEST that match one of the PATTERNS." + (define predicates + (map entry-predicate patterns)) + + (define (matches? entry) + (any (lambda (pred) + (pred entry)) + predicates)) + + (filter matches? (manifest-entries manifest))) + (define (manifest=? m1 m2) "Return #t if manifests M1 and M2 are equal. This differs from 'equal?' in that the 'inputs' field is ignored for the comparison, since it is know to diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index e0c7b6ed15..77406c7f39 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -693,15 +693,20 @@ return the new list of manifest entries." (append to-upgrade to-install)) (define (options->removable options manifest) - "Given options, return the list of manifest entries to be removed from -MANIFEST." - (let ((remove (filter-map (match-lambda - (('remove . package) - package) - (_ #f)) - options))) - (filter (cut manifest-installed? manifest <>) - remove))) + "Given options, return the list of manifest patterns of packages to be +removed from MANIFEST." + (filter-map (match-lambda + (('remove . spec) + (call-with-values + (lambda () + (package-specification->name+version+output spec)) + (lambda (name version output) + (manifest-pattern + (name name) + (version version) + (output output))))) + (_ #f)) + options)) ;;; @@ -871,7 +876,8 @@ more information.~%")) (if (manifest=? new manifest) (format (current-error-port) (_ "nothing to be done~%")) - (let ((prof-drv (profile-derivation (%store) new))) + (let ((prof-drv (profile-derivation (%store) new)) + (remove (manifest-matching-entries manifest remove))) (show-what-to-remove/install remove install dry-run?) (show-what-to-build (%store) (list prof-drv) #:use-substitutes? diff --git a/tests/profiles.scm b/tests/profiles.scm new file mode 100644 index 0000000000..8ead6e6968 --- /dev/null +++ b/tests/profiles.scm @@ -0,0 +1,97 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-profiles) + #:use-module (guix profiles) + #:use-module (ice-9 match) + #:use-module (srfi srfi-64)) + +;; Test the (guix profile) module. + + +;; Example manifest entries. + +(define guile-2.0.9 + (manifest-entry + (name "guile") + (version "2.0.9") + (path "/gnu/store/...") + (output "out"))) + +(define guile-2.0.9:debug + (manifest-entry (inherit guile-2.0.9) + (output "debug"))) + + +(test-begin "profiles") + +(test-assert "manifest-installed?" + (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug)))) + (and (manifest-installed? m (manifest-pattern (name "guile"))) + (manifest-installed? m (manifest-pattern + (name "guile") (output "debug"))) + (manifest-installed? m (manifest-pattern + (name "guile") (output "out") + (version "2.0.9"))) + (not (manifest-installed? + m (manifest-pattern (name "guile") (version "1.8.8")))) + (not (manifest-installed? + m (manifest-pattern (name "guile") (output "foobar"))))))) + +(test-assert "manifest-matching-entries" + (let* ((e (list guile-2.0.9 guile-2.0.9:debug)) + (m (manifest e))) + (and (null? (manifest-matching-entries m + (list (manifest-pattern + (name "python"))))) + (equal? e + (manifest-matching-entries m + (list (manifest-pattern + (name "guile") + (output #f))))) + (equal? (list guile-2.0.9) + (manifest-matching-entries m + (list (manifest-pattern + (name "guile") + (version "2.0.9")))))))) + +(test-assert "manifest-remove" + (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) + (m1 (manifest-remove m0 + (list (manifest-pattern (name "guile"))))) + (m2 (manifest-remove m1 + (list (manifest-pattern (name "guile"))))) ; same + (m3 (manifest-remove m2 + (list (manifest-pattern + (name "guile") (output "debug"))))) + (m4 (manifest-remove m3 + (list (manifest-pattern (name "guile")))))) + (match (manifest-entries m2) + ((($ "guile" "2.0.9" "debug")) + (and (equal? m1 m2) + (null? (manifest-entries m3)) + (null? (manifest-entries m4))))))) + +(test-end "profiles") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'dummy-package 'scheme-indent-function 1) +;;; End: -- cgit v1.2.3 From bde2d9cf8d4cbb2fdd12fc6cafc96f20d56d73a3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Nov 2013 23:06:13 +0100 Subject: tests: Add the builder as an input to raw derivations. * tests/derivations.scm ("build derivation with 1 source", "derivation with local file as input", "derivation with a fixed-output input", "multiple-output derivation", "multiple-output derivation, non-alphabetic order", "user of multiple-output derivation"): Add %BASH as an input, needed in chroot builds. --- tests/derivations.scm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 1b32ab5ffd..5f1ca56b50 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -125,7 +125,7 @@ #:env-vars '(("HOME" . "/homeless") ("zzz" . "Z!") ("AAA" . "A!")) - #:inputs `((,builder)))) + #:inputs `((,%bash) (,builder)))) (succeeded? (build-derivations %store (list drv)))) (and succeeded? @@ -149,7 +149,8 @@ ;; builder. #:env-vars `(("in" . ,input*)) - #:inputs `((,builder) + #:inputs `((,%bash) + (,builder) (,input))))) ; ← local file name (and (build-derivations %store (list drv)) ;; Note: we can't compare the files because the above trick alters @@ -211,11 +212,11 @@ (final1 (derivation %store "final" %bash `(,builder3) #:env-vars `(("in" . ,fixed-out)) - #:inputs `((,builder3) (,fixed1)))) + #:inputs `((,%bash) (,builder3) (,fixed1)))) (final2 (derivation %store "final" %bash `(,builder3) #:env-vars `(("in" . ,fixed-out)) - #:inputs `((,builder3) (,fixed2)))) + #:inputs `((,%bash) (,builder3) (,fixed2)))) (succeeded? (build-derivations %store (list final1 final2)))) (and succeeded? @@ -231,7 +232,7 @@ #:env-vars '(("HOME" . "/homeless") ("zzz" . "Z!") ("AAA" . "A!")) - #:inputs `((,builder)) + #:inputs `((,%bash) (,builder)) #:outputs '("out" "second"))) (succeeded? (build-derivations %store (list drv)))) (and succeeded? @@ -251,7 +252,7 @@ '())) (drv (derivation %store "fixed" %bash `(,builder) - #:inputs `((,builder)) + #:inputs `((,%bash) (,builder)) #:outputs '("out" "AAA"))) (succeeded? (build-derivations %store (list drv)))) (and succeeded? @@ -285,7 +286,7 @@ '())) (mdrv (derivation %store "multiple-output" %bash `(,builder1) - #:inputs `((,builder1)) + #:inputs `((,%bash) (,builder1)) #:outputs '("out" "two"))) (builder2 (add-text-to-store %store "my-mo-user-builder.sh" "read x < $one; @@ -300,7 +301,8 @@ ("two" . ,(derivation->output-path mdrv "two"))) - #:inputs `((,builder2) + #:inputs `((,%bash) + (,builder2) ;; two occurrences of MDRV: (,mdrv) (,mdrv "two"))))) -- cgit v1.2.3 From 01e82af55fa9823be36e2bd94868bb7b32f0fd73 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Nov 2013 23:41:33 +0100 Subject: tests: Fix max-silent-time test. * tests/derivations.scm ("build-expression->derivation and max-silent-time"): Use STORE instead of %STORE. Change BUILDER to succeed by default. Return #f when no exception is raised. --- tests/derivations.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index 5f1ca56b50..273db22765 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -419,8 +419,8 @@ (let* ((store (let ((s (open-connection))) (set-build-options s #:max-silent-time 1) s)) - (builder '(sleep 100)) - (drv (build-expression->derivation %store "silent" + (builder '(begin (sleep 100) (mkdir %output) #t)) + (drv (build-expression->derivation store "silent" (%current-system) builder '())) (out-path (derivation->output-path drv))) @@ -428,7 +428,8 @@ (and (string-contains (nix-protocol-error-message c) "failed") (not (valid-path? store out-path))))) - (build-derivations %store (list drv))))) + (build-derivations store (list drv)) + #f))) (test-assert "build-expression->derivation and derivation-prerequisites-to-build" (let ((drv (build-expression->derivation %store "fail" (%current-system) -- cgit v1.2.3 From f9cc897105850dbbf5e12df63e800cb28b0f293f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Nov 2013 22:41:21 +0100 Subject: packages: Add a 'snippet' field to . * guix/packages.scm (): Add 'snippet', 'modules', and 'imported-modules' fields. (patch-and-repack): Make 'inputs' a keyword parameter. Add 'snippet', 'modules', and 'imported-modules' parameters. Accept SOURCE as a raw file name. Insert SNIPPET in BUILDER. Pass IMPORTED-MODULES to 'build-expression->derivation'. (package-source-derivation): Pass the extra arguments to 'patch-and-repack'. * tests/packages.scm ("package-source-derivation, snippet"): New test. * doc/guix.texi (Defining Packages): Mention the 'patches' and 'snippet' fields. (Invoking guix build): Tell that --source has patches and snippets applied. (Software Freedom): Mention packages that contain non-free code. --- doc/guix.texi | 17 ++++++++++++ guix/packages.scm | 81 +++++++++++++++++++++++++++++++++++++++++------------- tests/packages.scm | 61 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 140 insertions(+), 19 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 43e7935b4c..4fb14063d0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -985,6 +985,11 @@ base32 representation of the hash. You can obtain this information with @code{guix download} (@pxref{Invoking guix download}) and @code{guix hash} (@pxref{Invoking guix hash}). +@cindex patches +When needed, the @code{origin} form can also have a @code{patches} field +listing patches to be applied, and a @code{snippet} field giving a +Scheme expression to modify the source code. + @item @cindex GNU Build System The @code{build-system} field is set to @var{gnu-build-system}. The @@ -1479,6 +1484,10 @@ themselves. For instance, @code{guix build -S gcc} returns something like @file{/nix/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball. +The returned source tarball is the result of applying any patches and +code snippets specified in the package's @code{origin} (@pxref{Defining +Packages}). + @item --system=@var{system} @itemx -s @var{system} Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of @@ -1878,6 +1887,14 @@ software distribution guidelines}. Among other things, these guidelines reject non-free firmware, recommendations of non-free software, and discuss ways to deal with trademarks and patents. +Some packages contain a small and optional subset that violates the +above guidelines, for instance because this subset is itself non-free +code. When that happens, the offending items are removed with +appropriate patches or code snippets in the package definition's +@code{origin} form (@pxref{Defining Packages}). That way, @code{guix +build --source} returns the ``freed'' source rather than the unmodified +upstream source. + @node Package Naming @subsection Package Naming diff --git a/guix/packages.scm b/guix/packages.scm index 44f683f776..d4a295e3ac 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -41,6 +41,9 @@ origin-patch-flags origin-patch-inputs origin-patch-guile + origin-snippet + origin-modules + origin-imported-modules base32 @@ -107,10 +110,15 @@ (sha256 origin-sha256) ; bytevector (file-name origin-file-name (default #f)) ; optional file name (patches origin-patches (default '())) ; list of file names + (snippet origin-snippet (default #f)) ; sexp or #f (patch-flags origin-patch-flags ; list of strings (default '("-p1"))) (patch-inputs origin-patch-inputs ; input list or #f (default #f)) + (modules origin-modules ; list of module names + (default '())) + (imported-modules origin-imported-modules ; list of module names + (default '())) (patch-guile origin-patch-guile ; derivation or #f (default #f))) @@ -270,26 +278,38 @@ corresponds to the arguments expected by `set-path-environment-variable'." (guile (module-ref distro 'guile-final))) (package-derivation store guile system))) -(define* (patch-and-repack store source patches inputs +(define* (patch-and-repack store source patches #:key + (inputs '()) + (snippet #f) (flags '("-p1")) + (modules '()) + (imported-modules '()) (guile-for-build (%guile-for-build)) (system (%current-system))) - "Unpack SOURCE (a derivation), apply all of PATCHES, and repack the tarball -using the tools listed in INPUTS." + "Unpack SOURCE (a derivation or store path), apply all of PATCHES, and +repack the tarball using the tools listed in INPUTS. When SNIPPET is true, +it must be an s-expression that will run from within the directory where +SOURCE was unpacked, after all of PATCHES have been applied. MODULES and +IMPORTED-MODULES specify modules to use/import for use by SNIPPET." + (define source-file-name + ;; SOURCE is usually a derivation, but it could be a store file. + (if (derivation? source) + (derivation->output-path source) + source)) + (define decompression-type - (let ((out (derivation->output-path source))) - (cond ((string-suffix? "gz" out) "gzip") - ((string-suffix? "bz2" out) "bzip2") - ((string-suffix? "lz" out) "lzip") - (else "xz")))) + (cond ((string-suffix? "gz" source-file-name) "gzip") + ((string-suffix? "bz2" source-file-name) "bzip2") + ((string-suffix? "lz" source-file-name) "lzip") + (else "xz"))) (define original-file-name - (let ((out (derivation->output-path source))) - ;; Remove the store prefix plus the slash, hash, and hyphen. - (let* ((sans (string-drop out (+ (string-length (%store-prefix)) 1))) - (dash (string-index sans #\-))) - (string-drop sans (+ 1 dash))))) + ;; Remove the store prefix plus the slash, hash, and hyphen. + (let* ((sans (string-drop source-file-name + (+ (string-length (%store-prefix)) 1))) + (dash (string-index sans #\-))) + (string-drop sans (+ 1 dash)))) (define patch-inputs (map (lambda (number patch) @@ -329,7 +349,24 @@ using the tools listed in INPUTS." (format (current-error-port) "source is under '~a'~%" directory) (chdir directory) + (and (every apply-patch ',(map car patch-inputs)) + + ,@(if snippet + `((let ((module (make-fresh-user-module))) + (module-use-interfaces! module + (map resolve-interface + ',modules)) + (module-define! module '%build-inputs + %build-inputs) + (module-define! module '%outputs %outputs) + ((@ (system base compile) compile) + ',snippet + #:to 'value + #:opts %auto-compilation-options + #:env module))) + '()) + (begin (chdir "..") #t) (zero? (system* tar "cvfa" out directory)))))))) @@ -349,24 +386,30 @@ using the tools listed in INPUTS." `(("source" ,source) ,@inputs ,@patch-inputs) + #:modules imported-modules #:guile-for-build guile-for-build))) (define* (package-source-derivation store source #:optional (system (%current-system))) "Return the derivation path for SOURCE, a package source, for SYSTEM." (match source - (($ uri method sha256 name ()) - ;; No patches. + (($ uri method sha256 name () #f) + ;; No patches, no snippet: this is a fixed-output derivation. (method store uri 'sha256 sha256 name #:system system)) - (($ uri method sha256 name (patches ...) (flags ...) - inputs guile-for-build) - ;; One or more patches. + (($ uri method sha256 name (patches ...) snippet + (flags ...) inputs (modules ...) (imported-modules ...) + guile-for-build) + ;; Patches and/or a snippet. (let ((source (method store uri 'sha256 sha256 name #:system system))) - (patch-and-repack store source patches inputs + (patch-and-repack store source patches + #:inputs inputs + #:snippet snippet #:flags flags #:system system + #:modules modules + #:imported-modules modules #:guile-for-build (or guile-for-build (%guile-for-build) (default-guile store system))))) diff --git a/tests/packages.scm b/tests/packages.scm index e0cf4ee001..7c5dd9f4e1 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -20,6 +20,7 @@ (define-module (test-packages) #:use-module (guix store) #:use-module (guix utils) + #:use-module (guix hash) #:use-module (guix derivations) #:use-module (guix packages) #:use-module (guix build-system) @@ -121,6 +122,66 @@ (package-source package)))) (string=? file source))) +(test-equal "package-source-derivation, snippet" + "OK" + (let* ((file (search-bootstrap-binary "guile-2.0.7.tar.xz" + (%current-system))) + (sha256 (call-with-input-file file port-sha256)) + (fetch (lambda* (store url hash-algo hash + #:optional name #:key system) + (pk 'fetch url hash-algo hash name system) + (add-to-store store (basename url) #f "sha256" url))) + (source (bootstrap-origin + (origin + (method fetch) + (uri file) + (sha256 sha256) + (patch-inputs + `(("tar" ,%bootstrap-coreutils&co) + ("xz" ,%bootstrap-coreutils&co) + ("patch" ,%bootstrap-coreutils&co))) + (patch-guile (package-derivation %store + %bootstrap-guile)) + (modules '((guix build utils))) + (imported-modules modules) + (snippet '(begin + ;; We end up in 'bin', because it's the first + ;; directory, alphabetically. Not a very good + ;; example but hey. + (chmod "." #o777) + (symlink "guile" "guile-rocks") + (copy-recursively "../share/guile/2.0/scripts" + "scripts") + + ;; These variables must exist. + (pk %build-inputs %outputs)))))) + (package (package (inherit (dummy-package "with-snippet")) + (source source) + (build-system trivial-build-system) + (inputs + `(("tar" ,(search-bootstrap-binary "tar" + (%current-system))) + ("xz" ,(search-bootstrap-binary "xz" + (%current-system))))) + (arguments + `(#:guile ,%bootstrap-guile + #:builder + (let ((tar (assoc-ref %build-inputs "tar")) + (xz (assoc-ref %build-inputs "xz")) + (source (assoc-ref %build-inputs "source"))) + (and (zero? (system* tar "xvf" source + "--use-compress-program" xz)) + (string=? "guile" (readlink "bin/guile-rocks")) + (file-exists? "bin/scripts/compile.scm") + (let ((out (assoc-ref %outputs "out"))) + (call-with-output-file out + (lambda (p) + (display "OK" p)))))))))) + (drv (package-derivation %store package)) + (out (derivation->output-path drv))) + (and (build-derivations %store (list (pk 'snippet-drv drv))) + (call-with-input-file out get-string-all)))) + (test-assert "return value" (let ((drv (package-derivation %store (dummy-package "p")))) (and (derivation? drv) -- cgit v1.2.3