summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-16 22:49:41 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-16 23:14:05 +0100
commit9d6c6cb20ef240221fc9a8e155f4bfa53e71bce4 (patch)
tree753d1313bf0776e738a69f798a199b45724b71bd /tests
parentcfd1ed84013df85f0e473884ef4038b4bd7120d4 (diff)
downloadguix-9d6c6cb20ef240221fc9a8e155f4bfa53e71bce4.tar.gz
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.
Diffstat (limited to 'tests')
-rw-r--r--tests/elpa.scm101
1 files changed, 34 insertions, 67 deletions
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 44e3914f2e..b70539bda6 100644
--- a/tests/elpa.scm
+++ b/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.")
-
-(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: