;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;;
;;; This file is part of GNU Guix.
(define-module (test-import-utils)
#:use-module (guix tests)
#:use-module (guix import utils)
- #:use-module (srfi srfi-64))
+ #:use-module ((guix licenses) #:prefix license:)
+ #:use-module (guix packages)
+ #:use-module (guix build-system)
+ #:use-module (gnu packages)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
(test-begin "import-utils")
"This package provides a function to establish world peace"
(beautify-description "A function to establish world peace"))
+(test-equal "license->symbol"
+ 'license:lgpl2.0
+ (license->symbol license:lgpl2.0))
+
+(test-equal "recursive-import"
+ '((package ;package expressions in topological order
+ (name "bar"))
+ (package
+ (name "foo")
+ (inputs `(("bar" ,bar)))))
+ (recursive-import "foo" 'repo
+ #:repo->guix-package
+ (match-lambda*
+ (("foo" 'repo)
+ (values '(package
+ (name "foo")
+ (inputs `(("bar" ,bar))))
+ '("bar")))
+ (("bar" 'repo)
+ (values '(package
+ (name "bar"))
+ '())))
+ #:guix-name identity))
+
+(test-assert "alist->package with simple source"
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" .
+ ;; Use a 'file://' URI so that we don't cause a download.
+ ,(string-append "file://"
+ (search-path %load-path "guix.scm")))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ("license" . "GPL-3.0+")))
+ (pkg (alist->package meta)))
+ (and (package? pkg)
+ (license:license? (package-license pkg))
+ (build-system? (package-build-system pkg))
+ (origin? (package-source pkg)))))
+
+(test-assert "alist->package with explicit source"
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ("license" . "GPL-3.0+")))
+ (pkg (alist->package meta)))
+ (and (package? pkg)
+ (license:license? (package-license pkg))
+ (build-system? (package-build-system pkg))
+ (origin? (package-source pkg))
+ (equal? (origin-sha256 (package-source pkg))
+ (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+
+(test-equal "alist->package with false license" ;<https://bugs.gnu.org/30470>
+ 'license-is-false
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ("license" . #f))))
+ ;; Note: Use 'or' because comparing with #f otherwise succeeds when
+ ;; there's an exception instead of an actual #f.
+ (or (package-license (alist->package meta))
+ 'license-is-false)))
+
+(test-equal "alist->package with dependencies"
+ `(("gettext" ,(specification->package "gettext")))
+ (let* ((meta '(("name" . "hello")
+ ("version" . "2.10")
+ ("source" . (("method" . "url-fetch")
+ ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
+ ("sha256" .
+ (("base32" .
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
+ ("build-system" . "gnu")
+ ("home-page" . "https://gnu.org")
+ ("synopsis" . "Say hi")
+ ("description" . "This package says hi.")
+ ;
+ ;; Note: As with Guile-JSON 3.x, JSON arrays are represented
+ ;; by vectors.
+ ("native-inputs" . #("gettext"))
+
+ ("license" . #f))))
+ (package-native-inputs (alist->package meta))))
+
(test-end "import-utils")