diff options
| -rw-r--r-- | guix/import/elpa.scm | 5 | ||||
| -rw-r--r-- | tests/elpa.scm | 101 |
2 files changed, 37 insertions, 69 deletions
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 83354d3f04..2d4487dba0 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 <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))))) 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: |