tests/import-utils.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
   3 ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
   4 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
   5 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (test-import-utils)
  23   #:use-module (guix tests)
  24   #:use-module (guix import utils)
  25   #:use-module ((guix licenses) #:prefix license:)
  26   #:use-module (guix packages)
  27   #:use-module (guix build-system)
  28   #:use-module (gnu packages)
  29   #:use-module (srfi srfi-64)
  30   #:use-module (ice-9 match))
  31
  32 (test-begin "import-utils")
  33
  34 (test-equal "beautify-description: use double spacing"
  35   "This is a package.  It is great.  Trust me Mr.  Hendrix."
  36   (beautify-description
  37    "This is a package. It is great. Trust me Mr. Hendrix."))
  38
  39 (test-equal "beautify-description: transform fragment into sentence"
  40   "This package provides a function to establish world peace"
  41   (beautify-description "A function to establish world peace"))
  42
  43 (test-equal "license->symbol"
  44   'license:lgpl2.0
  45   (license->symbol license:lgpl2.0))
  46
  47 (test-equal "recursive-import"
  48   '((package                         ;package expressions in topological order
  49       (name "bar"))
  50     (package
  51       (name "foo")
  52       (inputs `(("bar" ,bar)))))
  53   (recursive-import "foo"
  54                     #:repo 'repo
  55                     #:repo->guix-package
  56                     (match-lambda*
  57                       (("foo" #:version #f #:repo 'repo)
  58                        (values '(package
  59                                   (name "foo")
  60                                   (inputs `(("bar" ,bar))))
  61                                '("bar")))
  62                       (("bar" #:version #f #:repo 'repo)
  63                        (values '(package
  64                                   (name "bar"))
  65                                '())))
  66                     #:guix-name identity))
  67
  68 (test-equal "recursive-import: skip false packages (toplevel)"
  69   '()
  70   (recursive-import "foo"
  71                     #:repo 'repo
  72                     #:repo->guix-package
  73                     (match-lambda*
  74                       (("foo" #:version #f #:repo 'repo)
  75                        (values #f '())))
  76                     #:guix-name identity))
  77
  78 (test-equal "recursive-import: skip false packages (dependency)"
  79   '((package
  80       (name "foo")
  81       (inputs `(("bar" ,bar)))))
  82   (recursive-import "foo"
  83                     #:repo 'repo
  84                     #:repo->guix-package
  85                     (match-lambda*
  86                       (("foo" #:version #f #:repo 'repo)
  87                        (values '(package
  88                                   (name "foo")
  89                                   (inputs `(("bar" ,bar))))
  90                                '("bar")))
  91                       (("bar" #:version #f #:repo 'repo)
  92                        (values #f '())))
  93                     #:guix-name identity))
  94
  95 (test-assert "alist->package with simple source"
  96   (let* ((meta '(("name" . "hello")
  97                  ("version" . "2.10")
  98                  ("source" .
  99                   ;; Use a 'file://' URI so that we don't cause a download.
 100                   ,(string-append "file://"
 101                                   (search-path %load-path "guix.scm")))
 102                  ("build-system" . "gnu")
 103                  ("home-page" . "https://gnu.org")
 104                  ("synopsis" . "Say hi")
 105                  ("description" . "This package says hi.")
 106                  ("license" . "GPL-3.0+")))
 107          (pkg (alist->package meta)))
 108     (and (package? pkg)
 109          (license:license? (package-license pkg))
 110          (build-system? (package-build-system pkg))
 111          (origin? (package-source pkg)))))
 112
 113 (test-assert "alist->package with explicit source"
 114   (let* ((meta '(("name" . "hello")
 115                  ("version" . "2.10")
 116                  ("source" . (("method" . "url-fetch")
 117                               ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
 118                               ("sha256" .
 119                                (("base32" .
 120                                  "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 121                  ("build-system" . "gnu")
 122                  ("home-page" . "https://gnu.org")
 123                  ("synopsis" . "Say hi")
 124                  ("description" . "This package says hi.")
 125                  ("license" . "GPL-3.0+")))
 126          (pkg (alist->package meta)))
 127     (and (package? pkg)
 128          (license:license? (package-license pkg))
 129          (build-system? (package-build-system pkg))
 130          (origin? (package-source pkg))
 131          (equal? (origin-sha256 (package-source pkg))
 132                  (base32 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 133
 134 (test-equal "alist->package with false license"  ;<https://bugs.gnu.org/30470>
 135   'license-is-false
 136   (let* ((meta '(("name" . "hello")
 137                  ("version" . "2.10")
 138                  ("source" . (("method" . "url-fetch")
 139                               ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
 140                               ("sha256" .
 141                                (("base32" .
 142                                  "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 143                  ("build-system" . "gnu")
 144                  ("home-page" . "https://gnu.org")
 145                  ("synopsis" . "Say hi")
 146                  ("description" . "This package says hi.")
 147                  ("license" . #f))))
 148     ;; Note: Use 'or' because comparing with #f otherwise succeeds when
 149     ;; there's an exception instead of an actual #f.
 150     (or (package-license (alist->package meta))
 151         'license-is-false)))
 152
 153 (test-equal "alist->package with SPDX license name 1/2"  ;<https://bugs.gnu.org/45453>
 154   license:expat
 155   (let* ((meta '(("name" . "hello")
 156                  ("version" . "2.10")
 157                  ("source" . (("method" . "url-fetch")
 158                               ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
 159                               ("sha256" .
 160                                (("base32" .
 161                                  "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 162                  ("build-system" . "gnu")
 163                  ("home-page" . "https://gnu.org")
 164                  ("synopsis" . "Say hi")
 165                  ("description" . "This package says hi.")
 166                  ("license" . "expat"))))
 167     (package-license (alist->package meta))))
 168
 169 (test-equal "alist->package with SPDX license name 2/2"  ;<https://bugs.gnu.org/45453>
 170   license:expat
 171   (let* ((meta '(("name" . "hello")
 172                  ("version" . "2.10")
 173                  ("source" . (("method" . "url-fetch")
 174                               ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
 175                               ("sha256" .
 176                                (("base32" .
 177                                  "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 178                  ("build-system" . "gnu")
 179                  ("home-page" . "https://gnu.org")
 180                  ("synopsis" . "Say hi")
 181                  ("description" . "This package says hi.")
 182                  ("license" . "MIT"))))
 183     (package-license (alist->package meta))))
 184
 185 (test-equal "alist->package with dependencies"
 186   `(("gettext" ,(specification->package "gettext")))
 187   (let* ((meta '(("name" . "hello")
 188                  ("version" . "2.10")
 189                  ("source" . (("method" . "url-fetch")
 190                               ("uri"    . "mirror://gnu/hello/hello-2.10.tar.gz")
 191                               ("sha256" .
 192                                (("base32" .
 193                                  "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
 194                  ("build-system" . "gnu")
 195                  ("home-page" . "https://gnu.org")
 196                  ("synopsis" . "Say hi")
 197                  ("description" . "This package says hi.")
 198                                                   ;
 199                  ;; Note: As with Guile-JSON 3.x, JSON arrays are represented
 200                  ;; by vectors.
 201                  ("native-inputs" . #("gettext"))
 202
 203                  ("license" . #f))))
 204     (package-native-inputs (alist->package meta))))
 205
 206 (test-end "import-utils")