tests/egg.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
   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-eggs)
  20   #:use-module (guix import egg)
  21   #:use-module (guix gexp)
  22   #:use-module (guix base32)
  23   #:use-module (gcrypt hash)
  24   #:use-module (guix tests)
  25   #:use-module ((guix build syscalls) #:select (mkdtemp!))
  26   #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which))
  27   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
  28   #:use-module (srfi srfi-1)
  29   #:use-module (srfi srfi-64)
  30   #:use-module (web uri)
  31   #:use-module (ice-9 match))
  32
  33 (define test-egg-1
  34   '((synopsis "Example egg")
  35     (license "GPL-3/MIT")
  36     (version "1.0.0")
  37     (test-dependencies test srfi-1)
  38     (foreign-dependencies libgit2)
  39     (build-dependencies begin-syntax)
  40     (dependencies datatype)
  41     (author "John Doe")))
  42
  43 (define test-egg-2
  44   '((synopsis "Example egg")
  45     (license "GPL-3+")
  46     (version "0.3")
  47     (test-dependencies test)
  48     (foreign-dependencies libgit2)
  49     (build-dependencies begin-syntax)
  50     (dependencies datatype)
  51     (author "Alice Bobson")))
  52
  53 (define test-egg-1-file "/tmp/guix-egg-1")
  54 (define test-egg-2-file "/tmp/guix-egg-2")
  55
  56 (test-begin "egg")
  57
  58 (test-equal "guix-package->egg-name"
  59   "bar"
  60   (guix-package->egg-name
  61    (dummy-package "dummy"
  62                   (name "chicken-bar"))))
  63
  64 ;; Copied from tests/hackage.scm
  65 (define-syntax-rule (define-package-matcher name pattern)
  66   (define* (name obj)
  67     (match obj
  68       (pattern #t)
  69       (x       (pk 'fail x #f)))))
  70
  71 (define (eval-test-with-egg-file egg-name egg-test egg-file matcher)
  72   (call-with-output-file egg-file
  73     (lambda (port)
  74       (write egg-test port)))
  75   (matcher (egg->guix-package egg-name
  76                               #:file egg-file
  77                               #:source (plain-file
  78                                         (string-append egg-name "-egg")
  79                                         "content"))))
  80
  81 (define-package-matcher match-chicken-foo
  82   ('package
  83     ('name "chicken-foo")
  84     ('version "1.0.0")
  85     ('source (? file-like? source))
  86     ('build-system 'chicken-build-system)
  87     ('arguments ('quasiquote ('#:egg-name "foo")))
  88     ('native-inputs
  89      ('quasiquote
  90       (("chicken-test" ('unquote chicken-test))
  91        ("chicken-srfi-1" ('unquote chicken-srfi-1))
  92        ("chicken-begin-syntax" ('unquote chicken-begin-syntax)))))
  93     ('inputs
  94      ('quasiquote
  95       (("libgit2" ('unquote libgit2)))))
  96     ('propagated-inputs
  97      ('quasiquote
  98       (("chicken-datatype" ('unquote chicken-datatype)))))
  99     ('home-page "https://wiki.call-cc.org/egg/foo")
 100     ('synopsis "Example egg")
 101     ('description #f)
 102     ('license '(list license:gpl3 license:expat))))
 103
 104 (define-package-matcher match-chicken-bar
 105   ('package
 106     ('name "chicken-bar")
 107     ('version "0.3")
 108     ('source (? file-like? source))
 109     ('build-system 'chicken-build-system)
 110     ('arguments ('quasiquote ('#:egg-name "bar")))
 111     ('native-inputs
 112      ('quasiquote
 113       (("chicken-test" ('unquote chicken-test))
 114        ("chicken-begin-syntax" ('unquote chicken-begin-syntax)))))
 115     ('inputs
 116      ('quasiquote
 117       (("libgit2" ('unquote libgit2)))))
 118     ('propagated-inputs
 119      ('quasiquote
 120       (("chicken-datatype" ('unquote chicken-datatype)))))
 121     ('home-page "https://wiki.call-cc.org/egg/bar")
 122     ('synopsis "Example egg")
 123     ('description #f)
 124     ('license 'license:gpl3+)))
 125
 126 (test-assert "egg->guix-package local file, multiple licenses"
 127   (eval-test-with-egg-file "foo" test-egg-1 test-egg-1-file match-chicken-foo))
 128
 129 (test-assert "egg->guix-package local file, single license"
 130   (eval-test-with-egg-file "bar" test-egg-2 test-egg-2-file match-chicken-bar))
 131
 132 (test-end "egg")