epiphany w/ gtk4 and webkitgtk 2.38

[jackhill/guix/guix.git] / tests / cpan.scm

diff --git a/tests/cpan.scm b/tests/cpan.scm
index 5836841..bbcd108 100644 (file)
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,10 +21,11 @@
 (define-module (test-cpan)
   #:use-module (guix import cpan)
   #:use-module (guix base32)
-  #:use-module (guix hash)
-  #:use-module (guix tests)
-  #:use-module (guix grafts)
+  #:use-module (gcrypt hash)
+  #: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.
@@ -31,13 +34,6 @@
 (define test-json
   "{
   \"metadata\" : {
-    \"prereqs\" : {
-      \"runtime\" : {
-        \"requires\" : {
-          \"Test::Script\" : \"1.05\",
-        }
-      }
-    }
     \"name\" : \"Foo-Bar\",
     \"version\" : \"0.1\"
   }
@@ -46,6 +42,13 @@
   \"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\",
@@ -55,49 +58,51 @@
 (define test-source
   "foobar")
 
+;; Avoid collisions with other tests.
+(%http-server-port 10400)
+
 (test-begin "cpan")
 
 (test-assert "cpan->guix-package"
   ;; Replace network resources with sample data.
-  (mock ((guix build download) url-fetch
-         (lambda* (url file-name #:key (mirrors '()))
-           (with-output-to-file file-name
-             (lambda ()
-               (display
-                (match url
-                  ("http://api.metacpan.org/release/Foo-Bar"
-                   test-json)
-                  ("http://api.metacpan.org/module/Test::Script"
-                   "{ \"distribution\" : \"Test-Script\" }")
-                  ("http://example.com/Foo-Bar-0.1.tar.gz"
-                   test-source)
-                  (_ (error "Unexpected URL: " 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)
-         ('inputs
-          ('quasiquote
-           (("perl-test-script" ('unquote 'perl-test-script)))))
-         ('home-page "http://search.cpan.org/dist/Foo-Bar")
-         ('synopsis "Fizzle Fuzz")
-         ('description 'fill-in-yourself!)
-         ('license (package-license perl)))
-       (string=? (bytevector->nix-base32-string
-                  (call-with-input-string test-source port-sha256))
-                 hash))
-      (x
-       (pk 'fail x #f)))))
+  (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
+            ('quasiquote
+             (("perl-test-script" ('unquote '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-end "cpan")
+(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"))
 
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+(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")