tests/scripts-build.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
   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-scripts-build)
  20   #:use-module (guix tests)
  21   #:use-module (guix store)
  22   #:use-module (guix packages)
  23   #:use-module (guix scripts build)
  24   #:use-module (guix ui)
  25   #:use-module (guix utils)
  26   #:use-module (guix git)
  27   #:use-module (gnu packages)
  28   #:use-module (gnu packages base)
  29   #:use-module (gnu packages busybox)
  30   #:use-module (ice-9 match)
  31   #:use-module (srfi srfi-64))
  32
  33 \f
  34 (test-begin "scripts-build")
  35
  36 (test-assert "options->transformation, no transformations"
  37   (let ((p (dummy-package "foo"))
  38         (t (options->transformation '())))
  39     (with-store store
  40       (eq? (t store p) p))))
  41
  42 (test-assert "options->transformation, with-source"
  43   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
  44   ;; be applicable.
  45   (let* ((p (dummy-package "guix.scm"))
  46          (s (search-path %load-path "guix.scm"))
  47          (t (options->transformation `((with-source . ,s)))))
  48     (with-store store
  49       (let ((new (t store p)))
  50         (and (not (eq? new p))
  51              (string=? (package-source new)
  52                        (add-to-store store "guix.scm" #t
  53                                      "sha256" s)))))))
  54
  55 (test-assert "options->transformation, with-source, replacement"
  56   ;; Same, but this time the original package has a 'replacement' field.  We
  57   ;; expect that replacement to be set to #f in the new package.
  58   (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
  59          (s (search-path %load-path "guix.scm"))
  60          (t (options->transformation `((with-source . ,s)))))
  61     (with-store store
  62       (let ((new (t store p)))
  63         (and (not (eq? new p))
  64              (string=? (package-source new)
  65                        (add-to-store store "guix.scm" #t "sha256" s))
  66              (not (package-replacement new)))))))
  67
  68 (test-assert "options->transformation, with-source, with version"
  69   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
  70   ;; should be applicable, and its version should be extracted.
  71   (let ((p (dummy-package "foo"))
  72         (s (search-path %load-path "guix.scm")))
  73     (call-with-temporary-directory
  74      (lambda (directory)
  75        (let* ((f (string-append directory "/foo-42.0.tar.gz"))
  76               (t (options->transformation `((with-source . ,f)))))
  77          (copy-file s f)
  78          (with-store store
  79            (let ((new (t store p)))
  80              (and (not (eq? new p))
  81                   (string=? (package-name new) (package-name p))
  82                   (string=? (package-version new) "42.0")
  83                   (string=? (package-source new)
  84                             (add-to-store store (basename f) #t
  85                                           "sha256" f))))))))))
  86
  87 (test-assert "options->transformation, with-source, no matches"
  88   ;; When a transformation in not applicable, a warning must be raised.
  89   (let* ((p (dummy-package "foobar"))
  90          (s (search-path %load-path "guix.scm"))
  91          (t (options->transformation `((with-source . ,s)))))
  92     (with-store store
  93       (let* ((port (open-output-string))
  94              (new  (parameterize ((guix-warning-port port))
  95                      (t store p))))
  96         (and (eq? new p)
  97              (string-contains (get-output-string port)
  98                               "had no effect"))))))
  99
 100 (test-assert "options->transformation, with-source, PKG=URI"
 101   (let* ((p (dummy-package "foo"))
 102          (s (search-path %load-path "guix.scm"))
 103          (f (string-append "foo=" s))
 104          (t (options->transformation `((with-source . ,f)))))
 105     (with-store store
 106       (let ((new (t store p)))
 107         (and (not (eq? new p))
 108              (string=? (package-name new) (package-name p))
 109              (string=? (package-version new)
 110                        (package-version p))
 111              (string=? (package-source new)
 112                        (add-to-store store (basename s) #t
 113                                      "sha256" s)))))))
 114
 115 (test-assert "options->transformation, with-source, PKG@VER=URI"
 116   (let* ((p (dummy-package "foo"))
 117          (s (search-path %load-path "guix.scm"))
 118          (f (string-append "foo@42.0=" s))
 119          (t (options->transformation `((with-source . ,f)))))
 120     (with-store store
 121       (let ((new (t store p)))
 122         (and (not (eq? new p))
 123              (string=? (package-name new) (package-name p))
 124              (string=? (package-version new) "42.0")
 125              (string=? (package-source new)
 126                        (add-to-store store (basename s) #t
 127                                      "sha256" s)))))))
 128
 129 (test-assert "options->transformation, with-input"
 130   (let* ((p (dummy-package "guix.scm"
 131               (inputs `(("foo" ,(specification->package "coreutils"))
 132                         ("bar" ,(specification->package "grep"))
 133                         ("baz" ,(dummy-package "chbouib"
 134                                   (native-inputs `(("x" ,grep)))))))))
 135          (t (options->transformation '((with-input . "coreutils=busybox")
 136                                        (with-input . "grep=findutils")))))
 137     (with-store store
 138       (let ((new (t store p)))
 139         (and (not (eq? new p))
 140              (match (package-inputs new)
 141                ((("foo" dep1) ("bar" dep2) ("baz" dep3))
 142                 (and (eq? dep1 busybox)
 143                      (eq? dep2 findutils)
 144                      (string=? (package-name dep3) "chbouib")
 145                      (match (package-native-inputs dep3)
 146                        ((("x" dep))
 147                         (eq? dep findutils)))))))))))
 148
 149 (test-assert "options->transformation, with-graft"
 150   (let* ((p (dummy-package "guix.scm"
 151               (inputs `(("foo" ,grep)
 152                         ("bar" ,(dummy-package "chbouib"
 153                                   (native-inputs `(("x" ,grep)))))))))
 154          (t (options->transformation '((with-graft . "grep=findutils")))))
 155     (with-store store
 156       (let ((new (t store p)))
 157         (and (not (eq? new p))
 158              (match (package-inputs new)
 159                ((("foo" dep1) ("bar" dep2))
 160                 (and (string=? (package-full-name dep1)
 161                                (package-full-name grep))
 162                      (eq? (package-replacement dep1) findutils)
 163                      (string=? (package-name dep2) "chbouib")
 164                      (match (package-native-inputs dep2)
 165                        ((("x" dep))
 166                         (eq? (package-replacement dep) findutils)))))))))))
 167
 168 (test-equal "options->transformation, with-git-url"
 169   (let ((source (git-checkout (url "https://example.org")
 170                               (recursive? #t))))
 171     (list source source))
 172   (let* ((p (dummy-package "guix.scm"
 173               (inputs `(("foo" ,grep)
 174                         ("bar" ,(dummy-package "chbouib"
 175                                   (native-inputs `(("x" ,grep)))))))))
 176          (t (options->transformation '((with-git-url . "grep=https://example.org")))))
 177     (with-store store
 178       (let ((new (t store p)))
 179         (and (not (eq? new p))
 180              (match (package-inputs new)
 181                ((("foo" dep1) ("bar" dep2))
 182                 (and (string=? (package-full-name dep1)
 183                                (package-full-name grep))
 184                      (string=? (package-name dep2) "chbouib")
 185                      (match (package-native-inputs dep2)
 186                        ((("x" dep3))
 187                         (map package-source (list dep1 dep3))))))))))))
 188
 189 (test-end)