tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-27 19:41:50 +02:00
Code Activity

Merge branch 'master' into core-updates

Browse Source 
Conflicts:
	guix/packages.scm
This commit is contained in:
Ludovic Courtès
2013-11-08 21:58:09 +01:00
parent 7a78cc7af2 6a9957545c
commit 7db9608d52
17 changed files with 1023 additions and 363 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/derivations.scm
+14 -11
View File
@@ -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")))))
@@ -417,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)))
@@ -426,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)
tests/packages.scm
+60
View File
@@ -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,65 @@
(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 %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)
tests/profiles.scm
+97
View File
@@ -0,0 +1,97 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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)
((($ <manifest-entry> "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:
tests/ui.scm
+17
View File
@@ -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"))