rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

import: opam: Avoid uses of '@@' in tests. 

* guix/import/opam.scm (string-pat, multiline-string, list-pat)
(dict, condition): Export.
(opam-fetch): Add optional 'repository' parameter.
(opam->guix-package): Add #:repository parameter and pass it to
'opam-fetch'.
* tests/opam.scm ("opam->guix-package"): Remove use of 'mock' and pass
TEST-REPO to 'opam->guix-package' instead.
("parse-strings", "parse-multiline-strings")
("parse-lists", "parse-dicts", "parse-conditions"): Remove uses of '@@',
which are no longer needed.
This commit is contained in:
Ludovic Courtès 2020-01-17 13:48:23 +01:00
parent 0688ca7471
commit 282f91790a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 48 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
guix/import/opam.scm
View File

@ -1,3 +1,4 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;;
;;; This file is part of GNU Guix.
@ -38,7 +39,14 @@
#:use-module ((guix licenses) #:prefix license:)
#:export (opam->guix-package
opam-recursive-import
%opam-updater))
%opam-updater
;; The following patterns are exported for testing purposes.
string-pat
multiline-string
list-pat
dict
condition))
;; Define a PEG parser for the opam format
(define-peg-pattern comment none (and "#" (* STRCHR) "\n"))
@ -233,8 +241,8 @@ path to the repository."
(list dependency (list 'unquote (string->symbol dependency))))
(ocaml-names->guix-names lst)))
(define (opam-fetch name)
(and-let* ((repository (get-opam-repository))
(define* (opam-fetch name #:optional (repository (get-opam-repository)))
(and-let* ((repository repository)
(version (find-latest-version name repository))
(file (string-append repository "/packages/" name "/" name "." version "/opam")))
`(("metadata" ,@(get-metadata file))
@ -242,8 +250,11 @@ path to the repository."
(substring version 1)
version)))))
(define (opam->guix-package name)
(and-let* ((opam-file (opam-fetch name))
(define* (opam->guix-package name #:key repository)
"Import OPAM package NAME from REPOSITORY (a directory name) or, if
REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp
or #f on failure."
(and-let* ((opam-file (opam-fetch name repository))
(version (assoc-ref opam-file "version"))
(opam-content (assoc-ref opam-file "metadata"))
(url-dict (metadata-ref opam-content "url"))

67
tests/opam.scm
View File

@ -85,36 +85,33 @@ url {
(with-output-to-file (string-append my-package "/opam")
(lambda _
(format #t "~a" test-opam-file))))
(mock ((guix import opam) get-opam-repository
(lambda _
test-repo))
(match (opam->guix-package "foo")
(('package
('name "ocaml-foo")
('version "1.0.0")
('source ('origin
('method 'url-fetch)
('uri "https://example.org/foo-1.0.0.tar.gz")
('sha256
('base32
(? string? hash)))))
('build-system 'ocaml-build-system)
('propagated-inputs
('quasiquote
(("ocaml-zarith" ('unquote 'ocaml-zarith)))))
('native-inputs
('quasiquote
(("ocaml-alcotest" ('unquote 'ocaml-alcotest))
("ocamlbuild" ('unquote 'ocamlbuild)))))
('home-page "https://example.org/")
('synopsis "Some example package")
('description "This package is just an example.")
('license #f))
(string=? (bytevector->nix-base32-string
test-source-hash)
hash))
(x
(pk 'fail x #f))))))
(match (opam->guix-package "foo" #:repository test-repo)
(('package
('name "ocaml-foo")
('version "1.0.0")
('source ('origin
('method 'url-fetch)
('uri "https://example.org/foo-1.0.0.tar.gz")
('sha256
('base32
(? string? hash)))))
('build-system 'ocaml-build-system)
('propagated-inputs
('quasiquote
(("ocaml-zarith" ('unquote 'ocaml-zarith)))))
('native-inputs
('quasiquote
(("ocaml-alcotest" ('unquote 'ocaml-alcotest))
("ocamlbuild" ('unquote 'ocamlbuild)))))
('home-page "https://example.org/")
('synopsis "Some example package")
('description "This package is just an example.")
('license #f))
(string=? (bytevector->nix-base32-string
test-source-hash)
hash))
(x
(pk 'fail x #f)))))
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
@ -123,7 +120,7 @@ url {
(fold (lambda (test acc)
(display test) (newline)
(and acc
(let ((result (peg:tree (match-pattern (@@ (guix import opam) string-pat) (car test)))))
(let ((result (peg:tree (match-pattern string-pat (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@ -138,7 +135,7 @@ url {
(fold (lambda (test acc)
(display test) (newline)
(and acc
(let ((result (peg:tree (match-pattern (@@ (guix import opam) multiline-string) (car test)))))
(let ((result (peg:tree (match-pattern multiline-string (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@ -150,7 +147,7 @@ url {
(test-assert "parse-lists"
(fold (lambda (test acc)
(and acc
(let ((result (peg:tree (match-pattern (@@ (guix import opam) list-pat) (car test)))))
(let ((result (peg:tree (match-pattern list-pat (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@ -164,7 +161,7 @@ url {
(test-assert "parse-dicts"
(fold (lambda (test acc)
(and acc
(let ((result (peg:tree (match-pattern (@@ (guix import opam) dict) (car test)))))
(let ((result (peg:tree (match-pattern dict (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))
@ -176,7 +173,7 @@ url {
(test-assert "parse-conditions"
(fold (lambda (test acc)
(and acc
(let ((result (peg:tree (match-pattern (@@ (guix import opam) condition) (car test)))))
(let ((result (peg:tree (match-pattern condition (car test)))))
(if (equal? result (cdr test))
#t
(pk 'fail (list (car test) result (cdr test)) #f)))))