tests/elpa.scm

   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
  56 (define ensure-list
  57   (@@ (guix import elpa) ensure-list))
  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
  79                                 (ensure-list reqs) synopsis kind
  80                                 (package-home-page (first rest))
  81                                 auctex-readme-mock
  82                                 url)))
  83           (_ #f)))))
  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))))))
 109
 110 (test-assert "elpa->guix-package test 1"
 111   (eval-test-with-elpa "auctex"))
 112
 113 (test-end "elpa")