;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix inferior)
#:use-module (guix packages)
#:use-module (guix store)
+ #:use-module (guix profiles)
#:use-module (guix derivations)
#:use-module (gnu packages)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(define %store
(open-connection-for-tests))
+(define (manifest-entry->list entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-output entry)
+ (manifest-entry-search-paths entry)
+ (map manifest-entry->list (manifest-entry-dependencies entry))))
+
\f
(test-begin "inferior")
(close-inferior inferior)
result))))
+(test-equal "inferior-available-packages"
+ (take (sort (fold-available-packages
+ (lambda* (name version result
+ #:key supported? deprecated?
+ #:allow-other-keys)
+ (if (and supported? (not deprecated?))
+ (alist-cons name version result)
+ result))
+ '())
+ (lambda (x y)
+ (string<? (car x) (car y))))
+ 10)
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (packages (inferior-available-packages inferior)))
+ (close-inferior inferior)
+ (take (sort packages (lambda (x y)
+ (string<? (car x) (car y))))
+ 10)))
+
(test-equal "lookup-inferior-packages"
(let ((->list (lambda (package)
(list (package-name package)
(close-inferior inferior)
result))
+(test-equal "inferior-package-search-paths"
+ (package-native-search-paths guile-2.2)
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (guile (first (lookup-inferior-packages inferior "guile")))
+ (result (inferior-package-native-search-paths guile)))
+ (close-inferior inferior)
+ result))
+
+(test-equal "inferior-eval-with-store"
+ (add-text-to-store %store "foo" "Hello, world!")
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix")))
+ (inferior-eval-with-store inferior %store
+ '(lambda (store)
+ (add-text-to-store store "foo"
+ "Hello, world!")))))
+
+(test-assert "inferior-eval-with-store, &store-protocol-error"
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix")))
+ (guard (c ((store-protocol-error? c)
+ (string-contains (store-protocol-error-message c)
+ "invalid character")))
+ (inferior-eval-with-store inferior %store
+ '(lambda (store)
+ (add-text-to-store store "we|rd/?!@"
+ "uh uh")))
+ #f)))
+
(test-equal "inferior-package-derivation"
(map derivation-file-name
(list (package-derivation %store %bootstrap-guile "x86_64-linux")
(list (inferior-package-derivation %store guile "x86_64-linux")
(inferior-package-derivation %store guile "armhf-linux")))))
+(test-equal "inferior-package->manifest-entry"
+ (manifest-entry->list (package->manifest-entry
+ (first (find-best-packages-by-name "guile" #f))))
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (guile (first (lookup-inferior-packages inferior "guile")))
+ (entry (inferior-package->manifest-entry guile)))
+ (close-inferior inferior)
+ (manifest-entry->list entry)))
+
+(test-equal "packages->manifest"
+ (map manifest-entry->list
+ (manifest-entries (packages->manifest
+ (find-best-packages-by-name "guile" #f))))
+ (let* ((inferior (open-inferior %top-builddir
+ #:command "scripts/guix"))
+ (guile (first (lookup-inferior-packages inferior "guile")))
+ (manifest (packages->manifest (list guile))))
+ (close-inferior inferior)
+ (map manifest-entry->list (manifest-entries manifest))))
+
(test-end "inferior")