tests/cpan.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (test-cpan)
  20   #:use-module (guix import cpan)
  21   #:use-module (guix base32)
  22   #:use-module (guix hash)
  23   #:use-module (guix tests)
  24   #:use-module (srfi srfi-64)
  25   #:use-module (ice-9 match))
  26
  27 (define test-json
  28   "{
  29   \"metadata\" : {
  30     \"prereqs\" : {
  31       \"runtime\" : {
  32         \"requires\" : {
  33           \"Test::Script\" : \"1.05\",
  34         }
  35       }
  36     }
  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   \"abstract\" : \"Fizzle Fuzz\",
  46   \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
  47   \"author\" : \"GUIX\",
  48   \"version\" : \"0.1\"
  49 }")
  50
  51 (define test-source
  52   "foobar")
  53
  54 (test-begin "cpan")
  55
  56 (test-assert "cpan->guix-package"
  57   ;; Replace network resources with sample data.
  58   (mock ((guix build download) url-fetch
  59          (lambda* (url file-name #:key (mirrors '()))
  60            (with-output-to-file file-name
  61              (lambda ()
  62                (display
  63                 (match url
  64                   ("http://api.metacpan.org/release/Foo-Bar"
  65                    test-json)
  66                   ("http://api.metacpan.org/module/Test::Script"
  67                    "{ \"distribution\" : \"Test-Script\" }")
  68                   ("http://example.com/Foo-Bar-0.1.tar.gz"
  69                    test-source)
  70                   (_ (error "Unexpected URL: " url))))))))
  71     (match (cpan->guix-package "Foo::Bar")
  72       (('package
  73          ('name "perl-foo-bar")
  74          ('version "0.1")
  75          ('source ('origin
  76                     ('method 'url-fetch)
  77                     ('uri ('string-append "http://example.com/Foo-Bar-"
  78                                           'version ".tar.gz"))
  79                     ('sha256
  80                      ('base32
  81                       (? string? hash)))))
  82          ('build-system 'perl-build-system)
  83          ('inputs
  84           ('quasiquote
  85            (("perl-test-script" ('unquote 'perl-test-script)))))
  86          ('home-page "http://search.cpan.org/dist/Foo-Bar")
  87          ('synopsis "Fizzle Fuzz")
  88          ('description 'fill-in-yourself!)
  89          ('license (package-license perl)))
  90        (string=? (bytevector->nix-base32-string
  91                   (call-with-input-string test-source port-sha256))
  92                  hash))
  93       (x
  94        (pk 'fail x #f)))))
  95
  96 (test-end "cpan")
  97
  98 \f
  99 (exit (= (test-runner-fail-count (test-runner-current)) 0))