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

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 9d6c6cb20ef240221fc9a8e155f4bfa53e71bce4
Author: Ludovic Courtès <address@hidden>
AuthorDate: Thu Jan 16 22:49:41 2020 +0100

    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 |   5 ++-
 tests/elpa.scm       | 101 +++++++++++++++++----------------------------------
 2 files changed, 37 insertions(+), 69 deletions(-)

diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 83354d3..2d4487d 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <address@hidden>
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2018 Oleg Pykhalov <address@hidden>
 ;;;
 ;;; 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)))))
 
 
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 44e3914..b70539b 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <address@hidden>
+;;; Copyright © 2020 Ludovic Courtès <address@hidden>
 ;;;
 ;;; 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.")
-
-(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))
+;; Avoid collisions with other tests.
+(%http-server-port 10300)
 
 (test-begin "elpa")
 
 (define (eval-test-with-elpa pkg)
-  (mock
-   ;; replace the two fetching functions
-   ((guix import elpa) fetch-elpa-package
-    (lambda* (name #:optional (repo "gnu"))
-      (let ((pkg (elpa-package-info-mock name repo)))
-        (match pkg
-          ((name version reqs synopsis kind . rest)
-           (let* ((name (symbol->string name))
-                  (ver (elpa-version->string version))
-                  (url (package-source-url kind name ver repo)))
-             (make-elpa-package name ver
-                                (ensure-list reqs) synopsis kind
-                                (package-home-page (first rest))
-                                auctex-readme-mock
-                                url)))
-          (_ #f)))))
-   (mock
-    ((guix build download) url-fetch
-     (lambda (url file . _)
-       (call-with-output-file file
-         (lambda (port)
-           (display "fake tarball" port)))))
-
-    (match (elpa->guix-package pkg)
-      (('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))))))
+  ;; Set up an HTTP server and use it as a pseudo-proxy so that
+  ;; 'elpa->guix-package' talks to it.
+  (with-http-server `((200 ,(object->string elpa-mock-archive))
+                      (200 "This is the description.")
+                      (200 "fake tarball contents"))
+    (parameterize ((current-http-proxy (%local-url)))
+      (match (elpa->guix-package pkg 'gnu/http)
+        (('package
+           ('name "emacs-auctex")
+           ('version "11.88.6")
+           ('source
+            ('origin
+              ('method 'url-fetch)
+              ('uri ('string-append
+                     "http://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 "This is the description.")
+           ('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: