tests/cpan.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
   3 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
   4 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (test-cpan)
  22   #:use-module (guix import cpan)
  23   #:use-module (guix base32)
  24   #:use-module (gcrypt hash)
  25   #:use-module (guix tests http)
  26   #:use-module ((guix store) #:select (%graft?))
  27   #:use-module (srfi srfi-64)
  28   #:use-module (web client)
  29   #:use-module (ice-9 match))
  30
  31 ;; Globally disable grafts because they can trigger early builds.
  32 (%graft? #f)
  33
  34 (define test-json
  35   "{
  36   \"metadata\" : {
  37     \"name\" : \"Foo-Bar\",
  38     \"version\" : \"0.1\"
  39   }
  40   \"name\" : \"Foo-Bar-0.1\",
  41   \"distribution\" : \"Foo-Bar\",
  42   \"license\" : [
  43     \"perl_5\"
  44   ],
  45   \"dependency\": [
  46      { \"relationship\": \"requires\",
  47        \"phase\": \"runtime\",
  48        \"version\": \"1.05\",
  49        \"module\": \"Test::Script\"
  50      }
  51   ],
  52   \"abstract\" : \"Fizzle Fuzz\",
  53   \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
  54   \"author\" : \"Guix\",
  55   \"version\" : \"0.1\"
  56 }")
  57
  58 (define test-source
  59   "foobar")
  60
  61 ;; Avoid collisions with other tests.
  62 (%http-server-port 10400)
  63
  64 (test-begin "cpan")
  65
  66 (test-assert "cpan->guix-package"
  67   ;; Replace network resources with sample data.
  68   (with-http-server `((200 ,test-json)
  69                       (200 ,test-source)
  70                       (200 "{ \"distribution\" : \"Test-Script\" }"))
  71     (parameterize ((%metacpan-base-url (%local-url))
  72                    (current-http-proxy (%local-url)))
  73       (match (cpan->guix-package "Foo::Bar")
  74         (('package
  75            ('name "perl-foo-bar")
  76            ('version "0.1")
  77            ('source ('origin
  78                       ('method 'url-fetch)
  79                       ('uri ('string-append "http://example.com/Foo-Bar-"
  80                                             'version ".tar.gz"))
  81                       ('sha256
  82                        ('base32
  83                         (? string? hash)))))
  84            ('build-system 'perl-build-system)
  85            ('propagated-inputs
  86             ('quasiquote
  87              (("perl-test-script" ('unquote 'perl-test-script)))))
  88            ('home-page "https://metacpan.org/release/Foo-Bar")
  89            ('synopsis "Fizzle Fuzz")
  90            ('description 'fill-in-yourself!)
  91            ('license 'perl-license))
  92          (string=? (bytevector->nix-base32-string
  93                     (call-with-input-string test-source port-sha256))
  94                    hash))
  95         (x
  96          (pk 'fail x #f))))))
  97
  98 (test-equal "metacpan-url->mirror-url, http"
  99   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
 100   (metacpan-url->mirror-url
 101    "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
 102
 103 (test-equal "metacpan-url->mirror-url, https"
 104   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
 105   (metacpan-url->mirror-url
 106    "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))
 107
 108 (test-end "cpan")