From e1248602f92c45a731e47e74d3612bee03eaa0da Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 24 Jul 2015 16:49:57 +0200 Subject: import: Add 'cran' importer. * guix/import/cran.scm: New file. * guix/scripts/import.scm: Add "cran" to 'importers'. * guix/scripts/import/cran.scm: New file. * tests/cran.scm: New file. * Makefile.am (MODULES): Add 'guix/import/cran.scm' and 'guix/scripts/import/cran.scm'. (SCM_TESTS): Add 'tests/cran.scm'. * doc/guix.texi (Invoking guix import): Document it. * po/guix/POTFILES.in: Add 'guix/scripts/import/cran.scm'. --- tests/cran.scm | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 178 insertions(+) create mode 100644 tests/cran.scm (limited to 'tests') diff --git a/tests/cran.scm b/tests/cran.scm new file mode 100644 index 0000000000..c9cb5f69d0 --- /dev/null +++ b/tests/cran.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-cran) + #:use-module (guix import cran) + #:use-module (guix tests) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define sxml + '(*TOP* (xhtml:html + (xhtml:head + (xhtml:title "CRAN - Package my-example-sxml")) + (xhtml:body + (xhtml:h2 "my-example-sxml: Short description") + (xhtml:p "Long description") + (xhtml:table + (@ (summary "Package my-example-sxml summary")) + (xhtml:tr + (xhtml:td "Version:") + (xhtml:td "1.2.3")) + (xhtml:tr + (xhtml:td "Depends:") + (xhtml:td "R (>= 3.1.0)")) + (xhtml:tr + (xhtml:td "SystemRequirements:") + (xhtml:td "cairo (>= 1.2 http://www.cairographics.org/)")) + (xhtml:tr + (xhtml:td "Imports:") + (xhtml:td + (xhtml:a (@ (href "../scales/index.html")) + "scales") + " (>= 0.2.3), " + (xhtml:a (@ (href "../proto/index.html")) + "proto") + ", " + (xhtml:a (@ (href "../Rcpp/index.html")) "Rcpp") + " (>= 0.11.0)")) + (xhtml:tr + (xhtml:td "Suggests:") + (xhtml:td + (xhtml:a (@ (href "../some/index.html")) + "some") + ", " + (xhtml:a (@ (href "../suggestions/index.html")) + "suggestions"))) + (xhtml:tr + (xhtml:td "License:") + (xhtml:td + (xhtml:a (@ (href "../../licenses/MIT")) "MIT"))) + (xhtml:tr + (xhtml:td "URL:") + (xhtml:td + (xhtml:a (@ (href "http://gnu.org/s/my-example-sxml")) + "http://gnu.org/s/my-example-sxml") + ", " + (xhtml:a (@ (href "http://alternative/home/page")) + "http://alternative/home/page")))) + (xhtml:h4 "Downloads:") + (xhtml:table + (@ (summary "Package my-example-sxml downloads")) + (xhtml:tr + (xhtml:td " Reference manual: ") + (xhtml:td + (xhtml:a (@ (href "my-example-sxml.pdf")) + " my-example-sxml.pdf "))) + (xhtml:tr + (xhtml:td " Package source: ") + (xhtml:td + (xhtml:a + (@ (href "../../../src/contrib/my-example-sxml_1.2.3.tar.gz")) + " my-example-sxml_1.2.3.tar.gz ")))) + (xhtml:h4 "Reverse dependencies:") + (xhtml:table + (@ (summary "Package my-example-sxml reverse dependencies")) + (xhtml:tr + (xhtml:td "Reverse depends:") + (xhtml:td "Too many.")) + (xhtml:tr + (xhtml:td "Reverse imports:") + (xhtml:td "Likewise.")) + (xhtml:tr + (xhtml:td "Reverse suggests:") + (xhtml:td "Uncountable."))))))) + +(define simple-table + '(xhtml:table + (xhtml:tr + (xhtml:td "Numbers") + (xhtml:td "123")) + (xhtml:tr + (@ (class "whatever")) + (xhtml:td (@ (class "unimportant")) "Letters") + (xhtml:td "abc")) + (xhtml:tr + (xhtml:td "Letters") + (xhtml:td "xyz")) + (xhtml:tr + (xhtml:td "Single")) + (xhtml:tr + (xhtml:td "not a value") + (xhtml:td "not a label") + (xhtml:td "also not a label")))) + +(test-begin "cran") + +(test-equal "table-datum: return list of first table cell matching label" + '((xhtml:td "abc")) + ((@@ (guix import cran) table-datum) simple-table "Letters")) + +(test-equal "table-datum: return empty list if no match" + '() + ((@@ (guix import cran) table-datum) simple-table "Astronauts")) + +(test-equal "table-datum: only consider the first cell as a label cell" + '() + ((@@ (guix import cran) table-datum) simple-table "not a label")) + + +(test-assert "cran-sxml->sexp" + ;; Replace network resources with sample data. + (mock ((guix build download) url-fetch + (lambda* (url file-name #:key (mirrors '())) + (with-output-to-file file-name + (lambda () + (display + (match url + ("mirror://cran/src/contrib/my-example-sxml_1.2.3.tar.gz" + "source") + (_ (error "Unexpected URL: " url)))))))) + (match ((@@ (guix import cran) cran-sxml->sexp) sxml) + (('package + ('name "r-my-example-sxml") + ('version "1.2.3") + ('source ('origin + ('method 'url-fetch) + ('uri ('string-append "mirror://cran/src/contrib/my-example-sxml_" + 'version ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'r-build-system) + ('inputs + ('quasiquote + (("cairo" ('unquote 'cairo))))) + ('propagated-inputs + ('quasiquote + (("r-proto" ('unquote 'r-proto)) + ("r-rcpp" ('unquote 'r-rcpp)) + ("r-scales" ('unquote 'r-scales))))) + ('home-page "http://gnu.org/s/my-example-sxml") + ('synopsis "Short description") + ('description "Long description") + ('license 'x11))) + (x + (begin + (format #t "~s\n" x) + (pk 'fail x #f)))))) + +(test-end "cran") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3 From a96524cc7d302ad6a8f2cd2e970a148b360f629a Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 1 Sep 2015 19:57:44 -0400 Subject: import: gem: Fix minor bug and add unit test. * guix/import/gem.scm (make-gem-sexp): Properly handle an empty list of licenses. When rendering a list of licenses, cons 'list onto the front of the expression. * tests/gem.scm: New file. * Makefile.am (SCM_TESTS): Add it. --- Makefile.am | 3 +- guix/import/gem.scm | 3 +- tests/gem.scm | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 86 insertions(+), 2 deletions(-) create mode 100644 tests/gem.scm (limited to 'tests') diff --git a/Makefile.am b/Makefile.am index 711181b7cf..9a810e4ebd 100644 --- a/Makefile.am +++ b/Makefile.am @@ -231,7 +231,8 @@ MODULES += \ SCM_TESTS += \ tests/pypi.scm \ - tests/cpan.scm + tests/cpan.scm \ + tests/gem.scm endif diff --git a/guix/import/gem.scm b/guix/import/gem.scm index 3c28d1d9fd..c64c4e9374 100644 --- a/guix/import/gem.scm +++ b/guix/import/gem.scm @@ -105,8 +105,9 @@ VERSION, HASH, HOME-PAGE, DESCRIPTION, DEPENDENCIES, and LICENSES." (description ,description) (home-page ,home-page) (license ,(match licenses + (() #f) ((license) (license->symbol license)) - (_ (map license->symbol licenses)))))) + (_ `(list ,@(map license->symbol licenses))))))) (define* (gem->guix-package package-name #:optional version) "Fetch the metadata for PACKAGE-NAME from rubygems.org, and return the diff --git a/tests/gem.scm b/tests/gem.scm new file mode 100644 index 0000000000..9efbda31fe --- /dev/null +++ b/tests/gem.scm @@ -0,0 +1,82 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 David Thompson +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-gem) + #:use-module (guix import gem) + #:use-module (guix base32) + #:use-module (guix hash) + #:use-module (guix tests) + #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define test-json + "{ + \"name\": \"foo\", + \"version\": \"1.0.0\", + \"sha\": \"f3676eafca9987cb5fe263df1edf2538bf6dafc712b30e17be3543a9680547a8\", + \"info\": \"A cool gem\", + \"homepage_uri\": \"https://example.com\", + \"dependencies\": { + \"runtime\": [ + { \"name\": \"bundler\" }, + { \"name\": \"bar\" } + ] + }, + \"licenses\": [\"MIT\", \"Apache 2.0\"] +}") + +(test-begin "gem") + +(test-assert "gem->guix-package" + ;; Replace network resources with sample data. + (mock ((guix import utils) url-fetch + (lambda (url file-name) + (match url + ("https://rubygems.org/api/v1/gems/foo.json" + (with-output-to-file file-name + (lambda () + (display test-json)))) + (_ (error "Unexpected URL: " url))))) + (match (gem->guix-package "foo") + (('package + ('name "ruby-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri ('rubygems-uri "foo" 'version)) + ('sha256 + ('base32 + "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) + ('build-system 'ruby-build-system) + ('propagated-inputs + ('quasiquote + (("bundler" ('unquote 'bundler)) + ("ruby-bar" ('unquote 'ruby-bar))))) + ('synopsis "A cool gem") + ('description "A cool gem") + ('home-page "https://example.com") + ('license ('list 'expat 'asl2.0))) + #t) + (x + (pk 'fail x #f))))) + +(test-end "gem") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3 From 4c8f997a7d6f4c9d7eae73804e9784b4562eb213 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 2 Sep 2015 15:23:52 +0200 Subject: graph: Add '--expression'. * guix/scripts/graph.scm (%options, show-help): Add '--expression'. (guix-graph): Call 'read/eval-package-expression' for 'expression' pairs in OPTS. * tests/guix-graph.sh: Add tests. * doc/guix.texi (Invoking guix graph): Document it. --- doc/guix.texi | 10 ++++++++++ guix/scripts/graph.scm | 17 ++++++++++++----- tests/guix-graph.sh | 5 +++++ 3 files changed, 27 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/doc/guix.texi b/doc/guix.texi index 6defb0bda7..f943540ac8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4417,6 +4417,16 @@ the values listed above. @item --list-types List the supported graph types. + +@item --expression=@var{expr} +@itemx -e @var{expr} +Consider the package @var{expr} evaluates to. + +This is useful to precisely refer to a package, as in this example: + +@example +guix graph -e '(@@@@ (gnu packages commencement) gnu-make-final)' +@end example @end table diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 1719ffce68..2b671be131 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -380,6 +380,9 @@ given BACKEND. Use NODE-TYPE to traverse the DAG." (lambda (opt name arg result) (list-node-types) (exit 0))) + (option '(#\e "expression") #t #f + (lambda (opt name arg result) + (alist-cons 'expression arg result))) (option '(#\h "help") #f #f (lambda args (show-help) @@ -397,6 +400,8 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n")) -t, --type=TYPE represent nodes of the given TYPE")) (display (_ " --list-types list the available graph types")) + (display (_ " + -e, --expression=EXPR consider the package EXPR evaluates to")) (newline) (display (_ " -h, --help display this help and exit")) @@ -417,12 +422,14 @@ Emit a Graphviz (dot) representation of the dependencies of PACKAGE...\n")) (with-error-handling (let* ((opts (parse-command-line args %options (list %default-options))) - (specs (filter-map (match-lambda - (('argument . spec) spec) - (_ #f)) - opts)) (type (assoc-ref opts 'node-type)) - (packages (map specification->package specs))) + (packages (filter-map (match-lambda + (('argument . spec) + (specification->package spec)) + (('expression . exp) + (read/eval-package-expression exp)) + (_ #f)) + opts))) (with-store store (run-with-store store (mlet %store-monad ((nodes (mapm %store-monad diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh index 199258a9b8..e0cbebb753 100644 --- a/tests/guix-graph.sh +++ b/tests/guix-graph.sh @@ -32,3 +32,8 @@ done guix build guile-bootstrap guix graph -t references guile-bootstrap | grep guile-bootstrap + +guix graph -e '(@ (gnu packages bootstrap) %bootstrap-guile)' \ + | grep guile-bootstrap + +if guix graph -e +; then false; else true; fi -- cgit v1.2.3 From dbbc248aeef1bc3b5d76268782acff43e9d71d57 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 4 Sep 2015 18:31:06 +0200 Subject: monads: Fix 'liftN' fallback case. Reported by Andy Wingo . * guix/monads.scm (define-lift) : Add missing #'. Remove extra formal parameter. * tests/monads.scm ("lift"): Add test with 'lift1' as a procedure. --- guix/monads.scm | 8 ++++---- tests/monads.scm | 4 +++- 2 files changed, 7 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/guix/monads.scm b/guix/monads.scm index 61cd533bf4..0b0ad239de 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -239,10 +239,10 @@ CONDITION is true, return *unspecified* in the current monad." (identifier? #'id) ;; Slow path: Return a closure-returning procedure (we don't ;; guarantee (eq? LIFTN LIFTN), but that's fine.) - (lambda (liftn proc monad) - (lambda (args ...) - (with-monad monad - (return (proc args ...)))))))))))) + #'(lambda (proc monad) + (lambda (args ...) + (with-monad monad + (return (proc args ...)))))))))))) (define-lift lift0 ()) (define-lift lift1 (a)) diff --git a/tests/monads.scm b/tests/monads.scm index d3ef065f24..62a07a2bc6 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -95,10 +95,12 @@ (test-assert "lift" (every (lambda (monad run) - (let ((f (lift1 1+ monad))) + (let ((f (lift1 1+ monad)) + (g (apply lift1 1+ (list monad)))) (with-monad monad (let ((number (random 777))) (= (run (>>= (return number) f)) + (run (>>= (return number) g)) (1+ number)))))) %monads %monad-run)) -- cgit v1.2.3 From cfc5d39888451b7576b48488f9b92aa70ecc5cec Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 5 Sep 2015 22:08:47 +0200 Subject: tests: Fix typos. * tests/derivations.scm ("substitutable-derivation?", "derivation-prerequisites-to-build and substitutes, local build"): Fix harmless typos. --- tests/derivations.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index d2a090c8bc..21a832fabe 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -199,7 +199,7 @@ (and (substitutable-derivation? (derivation %store "foo" %bash '())) (substitutable-derivation? ;see (derivation %store "foo" %bash '() - #:local-build? #f)) + #:local-build? #t)) (not (substitutable-derivation? (derivation %store "foo" %bash '() #:substitutable? #f))))) @@ -663,7 +663,7 @@ (with-derivation-narinfo drv (let-values (((build download) (derivation-prerequisites-to-build store drv))) - ;; #:local-build? is not be synonymous with #:substitutable?, so we + ;; #:local-build? is *not* synonymous with #:substitutable?, so we ;; must be able to substitute DRV's output. ;; See . (and (null? build) -- cgit v1.2.3 From 52b9efe337d00f2ce65c4d4ca74ccc3679e6aad8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 6 Sep 2015 10:54:51 +0200 Subject: lint: Add 'license' checker. * guix/scripts/lint.scm (check-license): New procedure. (%checkers): Add 'license' checker. * tests/lint.scm ("license: invalid license"): New test. --- guix/scripts/lint.scm | 19 +++++++++++++++++++ tests/lint.scm | 6 ++++++ 2 files changed, 25 insertions(+) (limited to 'tests') diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 41249b2d15..2a618c9451 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -24,6 +24,7 @@ #:use-module (guix download) #:use-module (guix ftp-client) #:use-module (guix packages) + #:use-module (guix licenses) #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) @@ -56,6 +57,7 @@ check-derivation check-home-page check-source + check-license check-formatting %checkers @@ -518,6 +520,16 @@ descriptions maintained upstream." (format #f (_ "failed to create derivation: ~s~%") args))))) +(define (check-license package) + "Warn about type errors of the 'license' field of PACKAGE." + (match (package-license package) + ((or (? license?) + ((? license?) ...)) + #t) + (x + (emit-warning package (_ "invalid license field") + 'license)))) + ;;; ;;; Source code formatting. @@ -619,6 +631,13 @@ them for PACKAGE." (name 'home-page) (description "Validate home-page URLs") (check check-home-page)) + (lint-checker + (name 'license) + ;; TRANSLATORS: is the name of a data type and must not be + ;; translated. + (description "Make sure the 'license' field is a \ +or a list thereof") + (check check-license)) (lint-checker (name 'source) (description "Validate source URLs") diff --git a/tests/lint.scm b/tests/lint.scm index 5d56420966..ac47dbb768 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -329,6 +329,12 @@ requests." (check-derivation pkg))) "failed to create derivation"))) +(test-assert "license: invalid license" + (string-contains + (with-warnings + (check-license (dummy-package "x" (license #f)))) + "invalid license")) + (test-assert "home-page: wrong home-page" (->bool (string-contains -- cgit v1.2.3 From a6d0b306c20f236324e4bd661d0f82750ee00e90 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Tue, 21 Jul 2015 20:45:54 -0500 Subject: guix: packages: Add transitive-input-references. * guix/packages.scm (transitive-input-references): New procedure. * gnu/packages/version-control.scm (package-transitive-propagated-labels*) (package-propagated-input-refs): Delete. (git)[arguments]: Adjust to transitive-input-references. --- gnu/packages/version-control.scm | 28 ++++++---------------------- guix/packages.scm | 15 +++++++++++++++ tests/packages.scm | 17 +++++++++++++++++ 3 files changed, 38 insertions(+), 22 deletions(-) (limited to 'tests') diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 8d8003fe4c..3c0571bac6 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -98,24 +98,6 @@ changes to project files over time. It supports both a distributed workflow as well as the classic centralized workflow.") (license gpl2+))) -(define (package-transitive-propagated-labels* package) - "Return a list of the input labels of PACKAGE and its transitive inputs." - (let ((name (package-name package))) - `(,name - ,@(map (match-lambda - ((label (? package? _) . _) - label)) - (package-transitive-propagated-inputs package))))) - -(define (package-propagated-input-refs inputs packages) - "Return a list of (assoc-ref INPUTS ) for each package in -PACKAGES and their propagated inputs." - (map (lambda (l) - `(assoc-ref ,inputs ,l)) - (delete-duplicates ;XXX: efficiency - (append-map package-transitive-propagated-labels* - packages)))) - (define-public git ;; Keep in sync with 'git-manpages'! (package @@ -238,11 +220,13 @@ PACKAGES and their propagated inputs." `("PERL5LIB" ":" prefix ,(map (lambda (o) (string-append o "/lib/perl5/site_perl")) (list - ,@(package-propagated-input-refs + ,@(transitive-input-references 'inputs - (list perl-authen-sasl - perl-net-smtp-ssl - perl-io-socket-ssl)))))) + (map (lambda (l) + (assoc l (inputs))) + '("perl-authen-sasl" + "perl-net-smtp-ssl" + "perl-io-socket-ssl"))))))) ;; Tell 'git-submodule' where Perl is. (wrap-program git-sm diff --git a/guix/packages.scm b/guix/packages.scm index 3983d1409a..e466ffeda0 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2014, 2015 Mark H Weaver +;;; Copyright © 2015 Eric Bavier ;;; ;;; This file is part of GNU Guix. ;;; @@ -93,6 +94,8 @@ package-output package-grafts + transitive-input-references + %supported-systems %hydra-supported-systems supported-package? @@ -579,6 +582,18 @@ for the host system (\"native inputs\"), and not target inputs." recursively." (transitive-inputs (package-propagated-inputs package))) +(define (transitive-input-references alist inputs) + "Return a list of (assoc-ref ALIST