summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2020-12-27 12:05:24 +0100
committerRicardo Wurmus <rekado@elephly.net>2020-12-27 12:06:49 +0100
commit5aae614868b8a7e3097ae70f6024352aa5c8de21 (patch)
treed0ec0f75455e2c4615a0c47fe03b9af960bc7e41
parent649786f0cbd69083c7ae33ae1d441c19b68fc0ab (diff)
import/utils: alist->package: Handle SPDX license names only as fallback.
Fixes <https://bugs.gnu.org/45453>. * guix/import/utils.scm (alist->package): Find plain license names in (guix licenses) first, and only fall back to SPDX names on error. * tests/import-utils.scm ("alist->package with SPDX license name 1/2", "alist->package with SPDX license name 2/2"): New tests.
-rw-r--r--guix/import/utils.scm8
-rw-r--r--tests/import-utils.scm32
2 files changed, 38 insertions, 2 deletions
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index e227c2e42d4..cdbcf6bfa53 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -372,8 +372,12 @@ specifications to look up and replace them with plain symbols instead."
372 (match (assoc-ref meta "license") 372 (match (assoc-ref meta "license")
373 (#f #f) 373 (#f #f)
374 (l 374 (l
375 (or (module-ref (resolve-interface '(guix licenses) #:prefix 'license:) 375 (or (false-if-exception
376 (spdx-string->license l)) 376 (module-ref (resolve-interface '(guix licenses))
377 (string->symbol l)))
378 (false-if-exception
379 (module-ref (resolve-interface '(guix licenses) #:prefix 'license:)
380 (spdx-string->license l)))
377 (license:fsdg-compatible l))))))) 381 (license:fsdg-compatible l)))))))
378 382
379(define* (read-lines #:optional (port (current-input-port))) 383(define* (read-lines #:optional (port (current-input-port)))
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 2357ea5c408..874816442ef 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -122,6 +122,38 @@
122 (or (package-license (alist->package meta)) 122 (or (package-license (alist->package meta))
123 'license-is-false))) 123 'license-is-false)))
124 124
125(test-equal "alist->package with SPDX license name 1/2" ;<https://bugs.gnu.org/45453>
126 license:expat
127 (let* ((meta '(("name" . "hello")
128 ("version" . "2.10")
129 ("source" . (("method" . "url-fetch")
130 ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
131 ("sha256" .
132 (("base32" .
133 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
134 ("build-system" . "gnu")
135 ("home-page" . "https://gnu.org")
136 ("synopsis" . "Say hi")
137 ("description" . "This package says hi.")
138 ("license" . "expat"))))
139 (package-license (alist->package meta))))
140
141(test-equal "alist->package with SPDX license name 2/2" ;<https://bugs.gnu.org/45453>
142 license:expat
143 (let* ((meta '(("name" . "hello")
144 ("version" . "2.10")
145 ("source" . (("method" . "url-fetch")
146 ("uri" . "mirror://gnu/hello/hello-2.10.tar.gz")
147 ("sha256" .
148 (("base32" .
149 "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i")))))
150 ("build-system" . "gnu")
151 ("home-page" . "https://gnu.org")
152 ("synopsis" . "Say hi")
153 ("description" . "This package says hi.")
154 ("license" . "MIT"))))
155 (package-license (alist->package meta))))
156
125(test-equal "alist->package with dependencies" 157(test-equal "alist->package with dependencies"
126 `(("gettext" ,(specification->package "gettext"))) 158 `(("gettext" ,(specification->package "gettext")))
127 (let* ((meta '(("name" . "hello") 159 (let* ((meta '(("name" . "hello")