123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133 |
- ;;; GNU Guix --- Functional package management for GNU
- ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
- ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
- ;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
- ;;;
- ;;; 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-cpan)
- #:use-module (guix import cpan)
- #:use-module (guix base32)
- #:use-module (guix upstream)
- #:use-module ((guix download) #:select (url-fetch))
- #:use-module (gcrypt hash)
- #:use-module (guix tests)
- #:use-module (guix tests http)
- #:use-module ((guix store) #:select (%graft?))
- #:use-module (srfi srfi-64)
- #:use-module (web client)
- #:use-module (ice-9 match))
- ;; Globally disable grafts because they can trigger early builds.
- (%graft? #f)
- (define test-json
- "{
- \"metadata\" : {
- \"name\" : \"Foo-Bar\",
- \"version\" : \"0.1\"
- }
- \"name\" : \"Foo-Bar-0.1\",
- \"distribution\" : \"Foo-Bar\",
- \"license\" : [
- \"perl_5\"
- ],
- \"dependency\": [
- { \"relationship\": \"requires\",
- \"phase\": \"runtime\",
- \"version\": \"1.05\",
- \"module\": \"Test::Script\"
- }
- ],
- \"abstract\" : \"Fizzle Fuzz\",
- \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
- \"author\" : \"Guix\",
- \"version\" : \"0.1\"
- }")
- (define test-source
- "foobar")
- ;; Avoid collisions with other tests.
- (%http-server-port 10400)
- (test-begin "cpan")
- (test-assert "cpan->guix-package"
- (with-http-server `((200 ,test-json)
- (200 ,test-source)
- (200 "{ \"distribution\" : \"Test-Script\" }"))
- (parameterize ((%metacpan-base-url (%local-url))
- (current-http-proxy (%local-url)))
- (match (cpan->guix-package "Foo::Bar")
- (`(package
- (name "perl-foo-bar")
- (version "0.1")
- (source (origin
- (method url-fetch)
- (uri (string-append "http://example.com/Foo-Bar-"
- version ".tar.gz"))
- (sha256
- (base32 ,(? string? hash)))))
- (build-system perl-build-system)
- (propagated-inputs (list perl-test-script))
- (home-page "https://metacpan.org/release/Foo-Bar")
- (synopsis "Fizzle Fuzz")
- (description fill-in-yourself!)
- (license perl-license))
- (string=? (bytevector->nix-base32-string
- (call-with-input-string test-source port-sha256))
- hash))
- (x
- (pk 'fail x #f))))))
- (test-equal "package-latest-release"
- (list '("http://example.com/Foo-Bar-0.1.tar.gz")
- #f
- (list (upstream-input
- (name "Test-Script")
- (downstream-name "perl-test-script")
- (type 'propagated))))
- (with-http-server `((200 ,test-json)
- (200 "{ \"distribution\" : \"Test-Script\" }")
- (200 ,test-source))
- (parameterize ((%metacpan-base-url (%local-url))
- (current-http-proxy (%local-url)))
- (define source
- (package-latest-release
- (dummy-package "perl-test-script"
- (version "0.0.0")
- (source (dummy-origin
- (method url-fetch)
- (uri "mirror://cpan/Foo-Bar-0.0.0.tgz"))))
- (list %cpan-updater)))
- (list (upstream-source-urls source)
- (upstream-source-signature-urls source)
- (upstream-source-inputs source)))))
- (test-equal "metacpan-url->mirror-url, http"
- "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
- (metacpan-url->mirror-url
- "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
- (test-equal "metacpan-url->mirror-url, https"
- "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
- (metacpan-url->mirror-url
- "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
- (test-end "cpan")
|