ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2020-01-16 22:49:41 +01:00
parent cfd1ed8401
commit 9d6c6cb20e
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 69 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
guix/import/elpa.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; 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> ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -72,6 +72,7 @@ (define* (elpa-url #:optional (repo 'gnu))
"Retrieve the URL of REPO." "Retrieve the URL of REPO."
(let ((elpa-archives (let ((elpa-archives
'((gnu . "https://elpa.gnu.org/packages") '((gnu . "https://elpa.gnu.org/packages")
(gnu/http . "http://elpa.gnu.org/packages") ;for testing
(melpa-stable . "https://stable.melpa.org/packages") (melpa-stable . "https://stable.melpa.org/packages")
(melpa . "https://melpa.org/packages")))) (melpa . "https://melpa.org/packages"))))
(assq-ref elpa-archives repo))) (assq-ref elpa-archives repo)))
@ -251,7 +252,7 @@ (define* (elpa->guix-package name #:optional (repo 'gnu))
(package (package
;; ELPA is known to contain only GPLv3+ code. Other repos may contain ;; ELPA is known to contain only GPLv3+ code. Other repos may contain
;; code under other license but there's no license metadata. ;; 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))))) (elpa-package->sexp package license)))))

101
tests/elpa.scm
View file

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,10 +19,11 @@
(define-module (test-elpa) (define-module (test-elpa)
#:use-module (guix import elpa) #:use-module (guix import elpa)
#:use-module (guix tests) #:use-module (guix tests http)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (ice-9 match)) #:use-module (ice-9 match)
#:use-module (web client))
(define elpa-mock-archive (define elpa-mock-archive
'(1 '(1
@ -37,77 +39,42 @@ (define elpa-mock-archive
nil "Integrated environment for *TeX*" tar nil "Integrated environment for *TeX*" tar
((:url . "http://www.gnu.org/software/auctex/"))]))) ((: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") (test-begin "elpa")
(define (eval-test-with-elpa pkg) (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" (test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex")) (eval-test-with-elpa "auctex"))
(test-end "elpa") (test-end "elpa")
;; Local Variables:
;; eval: (put 'with-http-server 'scheme-indent-function 1)
;; End: