diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/egg.scm | 132 | ||||
| -rw-r--r-- | tests/gnu-maintenance.scm | 3 | ||||
| -rw-r--r-- | tests/hackage.scm | 7 | ||||
| -rw-r--r-- | tests/lint.scm | 55 | ||||
| -rw-r--r-- | tests/opam.scm | 4 |
5 files changed, 193 insertions, 8 deletions
diff --git a/tests/egg.scm b/tests/egg.scm new file mode 100644 index 0000000000..0884d8d429 --- /dev/null +++ b/tests/egg.scm @@ -0,0 +1,132 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; +;;; 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 <http://www.gnu.org/licenses/>. + +(define-module (test-eggs) + #:use-module (guix import egg) + #:use-module (guix gexp) + #:use-module (guix base32) + #:use-module (gcrypt hash) + #:use-module (guix tests) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) + #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) + #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (web uri) + #:use-module (ice-9 match)) + +(define test-egg-1 + '((synopsis "Example egg") + (license "GPL-3/MIT") + (version "1.0.0") + (test-dependencies test srfi-1) + (foreign-dependencies libgit2) + (build-dependencies begin-syntax) + (dependencies datatype) + (author "John Doe"))) + +(define test-egg-2 + '((synopsis "Example egg") + (license "GPL-3+") + (version "0.3") + (test-dependencies test) + (foreign-dependencies libgit2) + (build-dependencies begin-syntax) + (dependencies datatype) + (author "Alice Bobson"))) + +(define test-egg-1-file "/tmp/guix-egg-1") +(define test-egg-2-file "/tmp/guix-egg-2") + +(test-begin "egg") + +(test-equal "guix-package->egg-name" + "bar" + (guix-package->egg-name + (dummy-package "dummy" + (name "chicken-bar")))) + +;; Copied from tests/hackage.scm +(define-syntax-rule (define-package-matcher name pattern) + (define* (name obj) + (match obj + (pattern #t) + (x (pk 'fail x #f))))) + +(define (eval-test-with-egg-file egg-name egg-test egg-file matcher) + (call-with-output-file egg-file + (lambda (port) + (write egg-test port))) + (matcher (egg->guix-package egg-name + #:file egg-file + #:source (plain-file + (string-append egg-name "-egg") + "content")))) + +(define-package-matcher match-chicken-foo + ('package + ('name "chicken-foo") + ('version "1.0.0") + ('source (? file-like? source)) + ('build-system 'chicken-build-system) + ('arguments ('quasiquote ('#:egg-name "foo"))) + ('native-inputs + ('quasiquote + (("chicken-test" ('unquote chicken-test)) + ("chicken-srfi-1" ('unquote chicken-srfi-1)) + ("chicken-begin-syntax" ('unquote chicken-begin-syntax))))) + ('inputs + ('quasiquote + (("libgit2" ('unquote libgit2))))) + ('propagated-inputs + ('quasiquote + (("chicken-datatype" ('unquote chicken-datatype))))) + ('home-page "https://wiki.call-cc.org/egg/foo") + ('synopsis "Example egg") + ('description #f) + ('license '(list license:gpl3 license:expat)))) + +(define-package-matcher match-chicken-bar + ('package + ('name "chicken-bar") + ('version "0.3") + ('source (? file-like? source)) + ('build-system 'chicken-build-system) + ('arguments ('quasiquote ('#:egg-name "bar"))) + ('native-inputs + ('quasiquote + (("chicken-test" ('unquote chicken-test)) + ("chicken-begin-syntax" ('unquote chicken-begin-syntax))))) + ('inputs + ('quasiquote + (("libgit2" ('unquote libgit2))))) + ('propagated-inputs + ('quasiquote + (("chicken-datatype" ('unquote chicken-datatype))))) + ('home-page "https://wiki.call-cc.org/egg/bar") + ('synopsis "Example egg") + ('description #f) + ('license 'license:gpl3+))) + +(test-assert "egg->guix-package local file, multiple licenses" + (eval-test-with-egg-file "foo" test-egg-1 test-egg-1-file match-chicken-foo)) + +(test-assert "egg->guix-package local file, single license" + (eval-test-with-egg-file "bar" test-egg-2 test-egg-2-file match-chicken-bar)) + +(test-end "egg") diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm index 837b80063a..c04d8ba733 100644 --- a/tests/gnu-maintenance.scm +++ b/tests/gnu-maintenance.scm @@ -34,7 +34,8 @@ ("mediainfo" "mediainfo_20.09.tar.xz") ("exiv2" "exiv2-0.27.3-Source.tar.gz") ("mpg321" "mpg321_0.3.2.orig.tar.gz") - ("bvi" "bvi-1.4.1.src.tar.gz"))) + ("bvi" "bvi-1.4.1.src.tar.gz") + ("hostscope" "hostscope-V2.1.tgz"))) (every (lambda (project+file) (not (apply release-file? project+file))) '(("guile" "guile-www-1.1.1.tar.gz") diff --git a/tests/hackage.scm b/tests/hackage.scm index 77e333cbfc..66a13d9881 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -183,7 +184,7 @@ library ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) (define port (open-input-string test-cabal)) @@ -232,7 +233,7 @@ library ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (test-assert "hackage->guix-package test 6" (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) @@ -362,7 +363,7 @@ executable cabal ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (test-assert "hackage->guix-package test cabal revision" (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision)) diff --git a/tests/lint.scm b/tests/lint.scm index 02ffb19d78..b6ea1dda4f 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -277,6 +277,29 @@ (let ((pkg (dummy-package "under_score"))) (check-name pkg)))) +(test-equal "tests-true: #:tests? must not be set to #t" + "#:tests? must not be explicitly set to #t" + (single-lint-warning-message + (let ((pkg (dummy-package "x" (arguments '(#:tests? #t))))) + (check-tests-true pkg)))) + +(test-equal "tests-true: absent #:tests? is acceptable" + '() + (let ((pkg (dummy-package "x"))) + (check-tests-true pkg))) + +(test-equal "tests-true: #:tests? #f is acceptable" + '() + (let ((pkg (dummy-package "x" (arguments '(#:tests? #f))))) + (check-tests-true pkg))) + +(test-equal "tests-true: #:tests? #t acceptable when compiling natively" + '() + (let ((pkg (dummy-package "x" + (arguments + `(#:tests? ,(not (%current-target-system))))))) + (check-tests-true pkg))) + (test-equal "inputs: pkg-config is probably a native input" "'pkg-config' should probably be a native input" (single-lint-warning-message @@ -1008,10 +1031,13 @@ (method url-fetch) (uri "http://example.org/foo.tgz") (sha256 (make-bytevector 32)))) - (warnings (with-http-server '((404 "Not archived.")) + (warnings (with-http-server '((404 "Not archived.") + (404 "Not in Disarchive database.")) (parameterize ((%swh-base-url (%local-url))) - (check-archival (dummy-package "x" - (source origin))))))) + (mock ((guix download) %disarchive-mirrors + (list (%local-url))) + (check-archival (dummy-package "x" + (source origin)))))))) (warning-contains? "not archived" warnings))) (test-equal "archival: content available" @@ -1027,6 +1053,29 @@ (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) +(test-equal "archival: content unavailable but disarchive available" + '() + (let* ((origin (origin + (method url-fetch) + (uri "http://example.org/foo.tgz") + (sha256 (make-bytevector 32)))) + (disarchive (object->string + '(disarchive (version 0) + ... + "swh:1:dir:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))) + ;; https://archive.softwareheritage.org/api/1/directory/ + (directory "[ { \"checksums\": {}, + \"dir_id\": \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\", + \"type\": \"file\", + \"name\": \"README\" + \"length\": 42 } ]")) + (with-http-server `((404 "") ;lookup-content + (200 ,disarchive) ;Disarchive database lookup + (200 ,directory)) ;lookup-directory + (mock ((guix download) %disarchive-mirrors (list (%local-url))) + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin)))))))) + (test-assert "archival: missing revision" (let* ((origin (origin (method git-fetch) diff --git a/tests/opam.scm b/tests/opam.scm index 11984b56a6..f1e3b70cb0 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -55,6 +56,7 @@ depends: [ synopsis: \"Some example package\" description: \"\"\" This package is just an example.\"\"\" +license: \"BSD-3-Clause\" url { src: \"https://example.org/foo-1.0.0.tar.gz\" checksum: \"md5=74c6e897658e820006106f45f736381f\" @@ -109,7 +111,7 @@ url { ('home-page "https://example.org/") ('synopsis "Some example package") ('description "This package is just an example.") - ('license #f)) + ('license 'license:bsd-3)) (string=? (bytevector->nix-base32-string test-source-hash) hash)) |