mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-02-07 11:29:59 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: crate: Better handle license expressions.

Browse source 
* guix/import/crate.scm (%dual-license-rx): Removed function.
(crate->guix-package): Handle most of the multi-licensing cases.
* tests/crate.scm (licenses): Add tests for some licenses.

Co-authored-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Brice Waegeneire 2019-11-26 21:17:21 +01:00 • committed by Ludovic Courtès
parent 4982de4c32
commit 263a267b75
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/import/crate.scm
View file

@ -178,21 +178,20 @@ and LICENSE."
(close-port port) (close-port port)
pkg)) pkg))
(define %dual-license-rx (define (string->license string)
;; Dual licensing is represented by a string such as "MIT OR Apache-2.0". (filter-map (lambda (license)
;; This regexp matches that. (and (not (string-null? license))
(make-regexp "^(.*) OR (.*)$")) (not (any (lambda (elem) (string=? elem license))
'("AND" "OR" "WITH")))
(or (spdx-string->license license)
'unknown-license!)))
(string-split string (string->char-set " /"))))
(define* (crate->guix-package crate-name #:optional version) (define* (crate->guix-package crate-name #:optional version)
"Fetch the metadata for CRATE-NAME from crates.io, and return the "Fetch the metadata for CRATE-NAME from crates.io, and return the
`package' s-expression corresponding to that package, or #f on failure. `package' s-expression corresponding to that package, or #f on failure.
When VERSION is specified, attempt to fetch that version; otherwise fetch the When VERSION is specified, attempt to fetch that version; otherwise fetch the
latest version of CRATE-NAME." latest version of CRATE-NAME."
(define (string->license string)
(match (regexp-exec %dual-license-rx string)
(#f (list (spdx-string->license string)))
(m (list (spdx-string->license (match:substring m 1))
(spdx-string->license (match:substring m 2))))))
(define (normal-dependency? dependency) (define (normal-dependency? dependency)
(eq? (crate-dependency-kind dependency) 'normal)) (eq? (crate-dependency-kind dependency) 'normal))

23
tests/crate.scm
View file

@ -233,6 +233,9 @@
(define test-source-hash (define test-source-hash
"") "")
(define string->license
(@@ (guix import crate) string->license))
(test-begin "crate") (test-begin "crate")
(test-equal "guix-package->crate-name" (test-equal "guix-package->crate-name"
@ -437,4 +440,24 @@
(x (x
(pk 'fail x #f))))) (pk 'fail x #f)))))
(test-equal "licenses: MIT OR Apache-2.0"
'(license:expat license:asl2.0)
(string->license "MIT OR Apache-2.0"))
(test-equal "licenses: Apache-2.0 / MIT"
'(license:asl2.0 license:expat)
(string->license "Apache-2.0 / MIT"))
(test-equal "licenses: Apache-2.0 WITH LLVM-exception"
'(license:asl2.0 unknown-license!)
(string->license "Apache-2.0 WITH LLVM-exception"))
(test-equal "licenses: MIT/Apache-2.0 AND BSD-2-Clause"
'(license:expat license:asl2.0 unknown-license!)
(string->license "MIT/Apache-2.0 AND BSD-2-Clause"))
(test-equal "licenses: MIT/Apache-2.0"
'(license:expat license:asl2.0)
(string->license "MIT/Apache-2.0"))
(test-end "crate") (test-end "crate")