Commit | Line | Data |
---|---|---|
7f74a931 FB |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (test-elpa) | |
20 | #:use-module (guix import elpa) | |
21 | #:use-module (guix tests) | |
22 | #:use-module (srfi srfi-1) | |
23 | #:use-module (srfi srfi-64) | |
24 | #:use-module (ice-9 match)) | |
25 | ||
26 | (define elpa-mock-archive | |
27 | '(1 | |
28 | (ace-window . | |
29 | [(0 9 0) | |
30 | ((avy | |
31 | (0 2 0))) | |
32 | "Quickly switch windows." single | |
33 | ((:url . "https://github.com/abo-abo/ace-window") | |
34 | (:keywords "window" "location"))]) | |
35 | (auctex . | |
36 | [(11 88 6) | |
37 | nil "Integrated environment for *TeX*" tar | |
38 | ((:url . "http://www.gnu.org/software/auctex/"))]))) | |
39 | ||
40 | (define auctex-readme-mock "This is the AUCTeX description.") | |
41 | ||
42 | (define* (elpa-package-info-mock name #:optional (repo "gnu")) | |
43 | "Simulate retrieval of 'archive-contents' file from REPO and extraction of | |
44 | information about package NAME. (Function 'elpa-package-info'.)" | |
45 | (let* ((archive elpa-mock-archive) | |
46 | (info (filter (lambda (p) (eq? (first p) (string->symbol name))) | |
47 | (cdr archive)))) | |
48 | (if (pair? info) (first info) #f))) | |
49 | ||
50 | (define elpa-version->string | |
51 | (@@ (guix import elpa) elpa-version->string)) | |
52 | ||
53 | (define package-source-url | |
54 | (@@ (guix import elpa) package-source-url)) | |
55 | ||
80ea7526 LC |
56 | (define ensure-list |
57 | (@@ (guix import elpa) ensure-list)) | |
7f74a931 FB |
58 | |
59 | (define package-home-page | |
60 | (@@ (guix import elpa) package-home-page)) | |
61 | ||
62 | (define make-elpa-package | |
63 | (@@ (guix import elpa) make-elpa-package)) | |
64 | ||
65 | (test-begin "elpa") | |
66 | ||
67 | (define (eval-test-with-elpa pkg) | |
68 | (mock | |
69 | ;; replace the two fetching functions | |
70 | ((guix import elpa) fetch-elpa-package | |
71 | (lambda* (name #:optional (repo "gnu")) | |
72 | (let ((pkg (elpa-package-info-mock name repo))) | |
73 | (match pkg | |
74 | ((name version reqs synopsis kind . rest) | |
75 | (let* ((name (symbol->string name)) | |
76 | (ver (elpa-version->string version)) | |
77 | (url (package-source-url kind name ver repo))) | |
78 | (make-elpa-package name ver | |
80ea7526 | 79 | (ensure-list reqs) synopsis kind |
7f74a931 FB |
80 | (package-home-page (first rest)) |
81 | auctex-readme-mock | |
82 | url))) | |
83 | (_ #f))))) | |
17cdd3d0 LC |
84 | (mock |
85 | ((guix build download) url-fetch | |
86 | (lambda (url file . _) | |
87 | (call-with-output-file file | |
88 | (lambda (port) | |
89 | (display "fake tarball" port))))) | |
90 | ||
91 | (match (elpa->guix-package pkg) | |
92 | (('package | |
93 | ('name "emacs-auctex") | |
94 | ('version "11.88.6") | |
95 | ('source | |
96 | ('origin | |
97 | ('method 'url-fetch) | |
98 | ('uri ('string-append | |
99 | "https://elpa.gnu.org/packages/auctex-" 'version ".tar")) | |
100 | ('sha256 ('base32 (? string? hash))))) | |
101 | ('build-system 'emacs-build-system) | |
102 | ('home-page "http://www.gnu.org/software/auctex/") | |
103 | ('synopsis "Integrated environment for *TeX*") | |
104 | ('description (? string?)) | |
105 | ('license 'license:gpl3+)) | |
106 | #t) | |
107 | (x | |
108 | (pk 'fail x #f)))))) | |
7f74a931 FB |
109 | |
110 | (test-assert "elpa->guix-package test 1" | |
111 | (eval-test-with-elpa "auctex")) | |
112 | ||
113 | (test-end "elpa") |