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 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (test-cpan)
  21   #:use-module (guix import cpan)
  22   #:use-module (guix base32)
  23   #:use-module (gcrypt hash)
  24   #:use-module (guix tests)
  25   #:use-module (guix grafts)
  26   #:use-module (srfi srfi-64)
  27   #:use-module (ice-9 match)
  28   #:use-module (ice-9 hash-table))
  29
  30 ;; Globally disable grafts because they can trigger early builds.
  31 (%graft? #f)
  32
  33 (define test-json
  34   "{
  35   \"metadata\" : {
  36     \"prereqs\" : {
  37       \"runtime\" : {
  38         \"requires\" : {
  39           \"Test::Script\" : \"1.05\",
  40         }
  41       }
  42     }
  43     \"name\" : \"Foo-Bar\",
  44     \"version\" : \"0.1\"
  45   }
  46   \"name\" : \"Foo-Bar-0.1\",
  47   \"distribution\" : \"Foo-Bar\",
  48   \"license\" : [
  49     \"perl_5\"
  50   ],
  51   \"abstract\" : \"Fizzle Fuzz\",
  52   \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
  53   \"author\" : \"Guix\",
  54   \"version\" : \"0.1\"
  55 }")
  56
  57 (define test-source
  58   "foobar")
  59
  60 (test-begin "cpan")
  61
  62 (test-assert "cpan->guix-package"
  63   ;; Replace network resources with sample data.
  64   (mock ((guix build download) url-fetch
  65          (lambda* (url file-name
  66                        #:key
  67                        (mirrors '()) verify-certificate?)
  68            (with-output-to-file file-name
  69              (lambda ()
  70                (display
  71                 (match url
  72                   ("http://example.com/Foo-Bar-0.1.tar.gz"
  73                    test-source)
  74                   (_ (error "Unexpected URL: " url))))))))
  75         (mock ((guix http-client) http-fetch
  76                (lambda (url . rest)
  77                  (match url
  78                    ("https://fastapi.metacpan.org/v1/release/Foo-Bar"
  79                     (values (open-input-string test-json)
  80                             (string-length test-json)))
  81                    ("https://fastapi.metacpan.org/v1/module/Test::Script?fields=distribution"
  82                     (let ((result "{ \"distribution\" : \"Test-Script\" }"))
  83                       (values (open-input-string result)
  84                               (string-length result))))
  85                    (_ (error "Unexpected URL: " url)))))
  86               (match (cpan->guix-package "Foo::Bar")
  87                 (('package
  88                    ('name "perl-foo-bar")
  89                    ('version "0.1")
  90                    ('source ('origin
  91                               ('method 'url-fetch)
  92                               ('uri ('string-append "http://example.com/Foo-Bar-"
  93                                                     'version ".tar.gz"))
  94                               ('sha256
  95                                ('base32
  96                                 (? string? hash)))))
  97                    ('build-system 'perl-build-system)
  98                    ('propagated-inputs
  99                     ('quasiquote
 100                      (("perl-test-script" ('unquote 'perl-test-script)))))
 101                    ('home-page "https://metacpan.org/release/Foo-Bar")
 102                    ('synopsis "Fizzle Fuzz")
 103                    ('description 'fill-in-yourself!)
 104                    ('license 'perl-license))
 105                  (string=? (bytevector->nix-base32-string
 106                             (call-with-input-string test-source port-sha256))
 107                            hash))
 108                 (x
 109                  (pk 'fail x #f))))))
 110
 111 (test-equal "source-url-http"
 112   ((@@ (guix import cpan) cpan-source-url)
 113    (alist->hash-table
 114     `(("download_url" .
 115        "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))))
 116   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
 117
 118 (test-equal "source-url-https"
 119   ((@@ (guix import cpan) cpan-source-url)
 120    (alist->hash-table
 121     `(("download_url" .
 122        "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"))))
 123   "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
 124
 125 (test-end "cpan")