import: elpa: Rewrite test to use an HTTP server instead of mocking.

* guix/import/elpa.scm (elpa-url): Add 'gnu/http'.
(elpa->guix-package): Handle it.
* tests/elpa.scm (elpa-package-info-mock, auctex-readme-mock)
(elpa-version->string, package-source-url, ensure-list)
(package-home-page, make-elpa-package): Remove.
<top level>: Call '%http-server-port'.
(eval-test-with-elpa): Remove uses of 'mock'.  Use 'with-http-server'
and parameterize 'current-http-proxy' instead.

guix/import/elpa.scm

@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -72,6 +72,7 @@ NAMES (strings)."
   "Retrieve the URL of REPO."
   (let ((elpa-archives
          '((gnu . "https://elpa.gnu.org/packages")
+           (gnu/http . "http://elpa.gnu.org/packages") ;for testing
            (melpa-stable . "https://stable.melpa.org/packages")
            (melpa . "https://melpa.org/packages"))))
     (assq-ref elpa-archives repo)))
@@ -251,7 +252,7 @@ type '<elpa-package>'."
     (package
       ;; ELPA is known to contain only GPLv3+ code.  Other repos may contain
       ;; code under other license but there's no license metadata.
-      (let ((license (and (eq? 'gnu repo) 'license:gpl3+)))
+      (let ((license (and (memq repo '(gnu gnu/http)) 'license:gpl3+)))
         (elpa-package->sexp package license)))))
 
 

tests/elpa.scm

@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,10 +19,11 @@
 
 (define-module (test-elpa)
   #:use-module (guix import elpa)
-  #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (web client))
 
 (define elpa-mock-archive
   '(1
@@ -37,77 +39,42 @@
              nil "Integrated environment for *TeX*" tar
              ((:url . "http://www.gnu.org/software/auctex/"))])))
 
-(define auctex-readme-mock "This is the AUCTeX description.")
+;; Avoid collisions with other tests.
-
+(%http-server-port 10300)
-(define* (elpa-package-info-mock name #:optional (repo "gnu"))
-  "Simulate retrieval of 'archive-contents' file from REPO and extraction of
-information about package NAME. (Function 'elpa-package-info'.)"
-  (let* ((archive elpa-mock-archive)
-         (info (filter (lambda (p) (eq? (first p) (string->symbol name)))
-                       (cdr archive))))
-    (if (pair? info) (first info) #f)))
-
-(define elpa-version->string
-  (@@ (guix import elpa) elpa-version->string))
-
-(define package-source-url
-  (@@ (guix import elpa) package-source-url))
-
-(define ensure-list
-  (@@ (guix import elpa) ensure-list))
-
-(define package-home-page
-  (@@ (guix import elpa) package-home-page))
-
-(define make-elpa-package
-  (@@ (guix import elpa) make-elpa-package))
 
 (test-begin "elpa")
 
 (define (eval-test-with-elpa pkg)
-  (mock
+  ;; Set up an HTTP server and use it as a pseudo-proxy so that
-   ;; replace the two fetching functions
+  ;; 'elpa->guix-package' talks to it.
-   ((guix import elpa) fetch-elpa-package
+  (with-http-server `((200 ,(object->string elpa-mock-archive))
-    (lambda* (name #:optional (repo "gnu"))
+                      (200 "This is the description.")
-      (let ((pkg (elpa-package-info-mock name repo)))
+                      (200 "fake tarball contents"))
-        (match pkg
+    (parameterize ((current-http-proxy (%local-url)))
-          ((name version reqs synopsis kind . rest)
+      (match (elpa->guix-package pkg 'gnu/http)
-           (let* ((name (symbol->string name))
+        (('package
-                  (ver (elpa-version->string version))
+           ('name "emacs-auctex")
-                  (url (package-source-url kind name ver repo)))
+           ('version "11.88.6")
-             (make-elpa-package name ver
+           ('source
-                                (ensure-list reqs) synopsis kind
+            ('origin
-                                (package-home-page (first rest))
+              ('method 'url-fetch)
-                                auctex-readme-mock
+              ('uri ('string-append
-                                url)))
+                     "http://elpa.gnu.org/packages/auctex-" 'version ".tar"))
-          (_ #f)))))
+              ('sha256 ('base32 (? string? hash)))))
-   (mock
+           ('build-system 'emacs-build-system)
-    ((guix build download) url-fetch
+           ('home-page "http://www.gnu.org/software/auctex/")
-     (lambda (url file . _)
+           ('synopsis "Integrated environment for *TeX*")
-       (call-with-output-file file
+           ('description "This is the description.")
-         (lambda (port)
+           ('license 'license:gpl3+))
-           (display "fake tarball" port)))))
+         #t)
-
+        (x
-    (match (elpa->guix-package pkg)
+         (pk 'fail x #f))))))
-      (('package
-         ('name "emacs-auctex")
-         ('version "11.88.6")
-         ('source
-          ('origin
-            ('method 'url-fetch)
-            ('uri ('string-append
-                   "https://elpa.gnu.org/packages/auctex-" 'version ".tar"))
-            ('sha256 ('base32 (? string? hash)))))
-         ('build-system 'emacs-build-system)
-         ('home-page "http://www.gnu.org/software/auctex/")
-         ('synopsis "Integrated environment for *TeX*")
-         ('description (? string?))
-         ('license 'license:gpl3+))
-       #t)
-      (x
-       (pk 'fail x #f))))))
 
 (test-assert "elpa->guix-package test 1"
   (eval-test-with-elpa "auctex"))
 
 (test-end "elpa")
+
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 1)
+;; End: