~ruther/guix-local

5e2495d09e5ad78f8ebb6bfa6fb4ff09fb305ec4 — Ludovic Courtès 8 years ago 469069b
import: utils: 'alist->package' allows false license.

Reported by <pkill9@runbox.com>.
Fixes <https://bugs.gnu.org/30470>.

* guix/import/utils.scm (alist->package): Check whether 'license' is
false and set the 'license' field to #f in this case.
* tests/import-utils.scm ("alist->package with false license"): New
test.
2 files changed, 26 insertions(+), 5 deletions(-)

M guix/import/utils.scm
M tests/import-utils.scm
M guix/import/utils.scm => guix/import/utils.scm +7 -5
@@ 1,5 1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>


@@ 330,10 330,12 @@ the expected fields of an <origin> object."
    (description
     (assoc-ref meta "description"))
    (license
     (let ((l (assoc-ref meta "license")))
       (or (module-ref (resolve-interface '(guix licenses) #:prefix 'license:)
                       (spdx-string->license l))
           (license:fsdg-compatible l))))))
     (match (assoc-ref meta "license")
       (#f #f)
       (l
        (or (module-ref (resolve-interface '(guix licenses) #:prefix 'license:)
                        (spdx-string->license l))
            (license:fsdg-compatible l)))))))

(define* (read-lines #:optional (port (current-input-port)))
  "Read lines from PORT and return them as a list."

M tests/import-utils.scm => tests/import-utils.scm +19 -0
@@ 79,4 79,23 @@
         (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-end "import-utils")