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 git-download)
  24   #:use-module (guix scripts build)
  25   #:use-module (guix ui)
  26   #:use-module (guix utils)
  27   #:use-module (guix git)
  28   #:use-module (gnu packages)
  29   #:use-module (gnu packages base)
  30   #:use-module (gnu packages busybox)
  31   #:use-module (ice-9 match)
  32   #:use-module (srfi srfi-64))
  33
  34 \f
  35 (test-begin "scripts-build")
  36
  37 (test-assert "options->transformation, no transformations"
  38   (let ((p (dummy-package "foo"))
  39         (t (options->transformation '())))
  40     (with-store store
  41       (eq? (t store p) p))))
  42
  43 (test-assert "options->transformation, with-source"
  44   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
  45   ;; be applicable.
  46   (let* ((p (dummy-package "guix.scm"))
  47          (s (search-path %load-path "guix.scm"))
  48          (t (options->transformation `((with-source . ,s)))))
  49     (with-store store
  50       (let ((new (t store p)))
  51         (and (not (eq? new p))
  52              (string=? (package-source new)
  53                        (add-to-store store "guix.scm" #t
  54                                      "sha256" s)))))))
  55
  56 (test-assert "options->transformation, with-source, replacement"
  57   ;; Same, but this time the original package has a 'replacement' field.  We
  58   ;; expect that replacement to be set to #f in the new package.
  59   (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
  60          (s (search-path %load-path "guix.scm"))
  61          (t (options->transformation `((with-source . ,s)))))
  62     (with-store store
  63       (let ((new (t store p)))
  64         (and (not (eq? new p))
  65              (string=? (package-source new)
  66                        (add-to-store store "guix.scm" #t "sha256" s))
  67              (not (package-replacement new)))))))
  68
  69 (test-assert "options->transformation, with-source, with version"
  70   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
  71   ;; should be applicable, and its version should be extracted.
  72   (let ((p (dummy-package "foo"))
  73         (s (search-path %load-path "guix.scm")))
  74     (call-with-temporary-directory
  75      (lambda (directory)
  76        (let* ((f (string-append directory "/foo-42.0.tar.gz"))
  77               (t (options->transformation `((with-source . ,f)))))
  78          (copy-file s f)
  79          (with-store store
  80            (let ((new (t store p)))
  81              (and (not (eq? new p))
  82                   (string=? (package-name new) (package-name p))
  83                   (string=? (package-version new) "42.0")
  84                   (string=? (package-source new)
  85                             (add-to-store store (basename f) #t
  86                                           "sha256" f))))))))))
  87
  88 (test-assert "options->transformation, with-source, no matches"
  89   ;; When a transformation in not applicable, a warning must be raised.
  90   (let* ((p (dummy-package "foobar"))
  91          (s (search-path %load-path "guix.scm"))
  92          (t (options->transformation `((with-source . ,s)))))
  93     (with-store store
  94       (let* ((port (open-output-string))
  95              (new  (parameterize ((guix-warning-port port))
  96                      (t store p))))
  97         (and (eq? new p)
  98              (string-contains (get-output-string port)
  99                               "had no effect"))))))
 100
 101 (test-assert "options->transformation, with-source, PKG=URI"
 102   (let* ((p (dummy-package "foo"))
 103          (s (search-path %load-path "guix.scm"))
 104          (f (string-append "foo=" s))
 105          (t (options->transformation `((with-source . ,f)))))
 106     (with-store store
 107       (let ((new (t store p)))
 108         (and (not (eq? new p))
 109              (string=? (package-name new) (package-name p))
 110              (string=? (package-version new)
 111                        (package-version p))
 112              (string=? (package-source new)
 113                        (add-to-store store (basename s) #t
 114                                      "sha256" s)))))))
 115
 116 (test-assert "options->transformation, with-source, PKG@VER=URI"
 117   (let* ((p (dummy-package "foo"))
 118          (s (search-path %load-path "guix.scm"))
 119          (f (string-append "foo@42.0=" s))
 120          (t (options->transformation `((with-source . ,f)))))
 121     (with-store store
 122       (let ((new (t store p)))
 123         (and (not (eq? new p))
 124              (string=? (package-name new) (package-name p))
 125              (string=? (package-version new) "42.0")
 126              (string=? (package-source new)
 127                        (add-to-store store (basename s) #t
 128                                      "sha256" s)))))))
 129
 130 (test-assert "options->transformation, with-input"
 131   (let* ((p (dummy-package "guix.scm"
 132               (inputs `(("foo" ,(specification->package "coreutils"))
 133                         ("bar" ,(specification->package "grep"))
 134                         ("baz" ,(dummy-package "chbouib"
 135                                   (native-inputs `(("x" ,grep)))))))))
 136          (t (options->transformation '((with-input . "coreutils=busybox")
 137                                        (with-input . "grep=findutils")))))
 138     (with-store store
 139       (let ((new (t store p)))
 140         (and (not (eq? new p))
 141              (match (package-inputs new)
 142                ((("foo" dep1) ("bar" dep2) ("baz" dep3))
 143                 (and (string=? (package-full-name dep1)
 144                                (package-full-name busybox))
 145                      (string=? (package-full-name dep2)
 146                                (package-full-name findutils))
 147                      (string=? (package-name dep3) "chbouib")
 148                      (match (package-native-inputs dep3)
 149                        ((("x" dep))
 150                         (string=? (package-full-name dep)
 151                                   (package-full-name findutils))))))))))))
 152
 153 (test-assert "options->transformation, with-graft"
 154   (let* ((p (dummy-package "guix.scm"
 155               (inputs `(("foo" ,grep)
 156                         ("bar" ,(dummy-package "chbouib"
 157                                   (native-inputs `(("x" ,grep)))))))))
 158          (t (options->transformation '((with-graft . "grep=findutils")))))
 159     (with-store store
 160       (let ((new (t store p)))
 161         (and (not (eq? new p))
 162              (match (package-inputs new)
 163                ((("foo" dep1) ("bar" dep2))
 164                 (and (string=? (package-full-name dep1)
 165                                (package-full-name grep))
 166                      (eq? (package-replacement dep1) findutils)
 167                      (string=? (package-name dep2) "chbouib")
 168                      (match (package-native-inputs dep2)
 169                        ((("x" dep))
 170                         (eq? (package-replacement dep) findutils)))))))))))
 171
 172 (test-equal "options->transformation, with-branch"
 173   (git-checkout (url "https://example.org")
 174                 (branch "devel")
 175                 (recursive? #t))
 176   (let* ((p (dummy-package "guix.scm"
 177               (inputs `(("foo" ,grep)
 178                         ("bar" ,(dummy-package "chbouib"
 179                                   (source (origin
 180                                             (method git-fetch)
 181                                             (uri (git-reference
 182                                                   (url "https://example.org")
 183                                                   (commit "cabba9e")))
 184                                             (sha256 #f)))))))))
 185          (t (options->transformation '((with-branch . "chbouib=devel")))))
 186     (with-store store
 187       (let ((new (t store p)))
 188         (and (not (eq? new p))
 189              (match (package-inputs new)
 190                ((("foo" dep1) ("bar" dep2))
 191                 (and (string=? (package-full-name dep1)
 192                                (package-full-name grep))
 193                      (string=? (package-name dep2) "chbouib")
 194                      (package-source dep2)))))))))
 195
 196 (test-equal "options->transformation, with-commit"
 197   (git-checkout (url "https://example.org")
 198                 (commit "abcdef")
 199                 (recursive? #t))
 200   (let* ((p (dummy-package "guix.scm"
 201               (inputs `(("foo" ,grep)
 202                         ("bar" ,(dummy-package "chbouib"
 203                                   (source (origin
 204                                             (method git-fetch)
 205                                             (uri (git-reference
 206                                                   (url "https://example.org")
 207                                                   (commit "cabba9e")))
 208                                             (sha256 #f)))))))))
 209          (t (options->transformation '((with-commit . "chbouib=abcdef")))))
 210     (with-store store
 211       (let ((new (t store p)))
 212         (and (not (eq? new p))
 213              (match (package-inputs new)
 214                ((("foo" dep1) ("bar" dep2))
 215                 (and (string=? (package-full-name dep1)
 216                                (package-full-name grep))
 217                      (string=? (package-name dep2) "chbouib")
 218                      (package-source dep2)))))))))
 219
 220 (test-equal "options->transformation, with-git-url"
 221   (let ((source (git-checkout (url "https://example.org")
 222                               (recursive? #t))))
 223     (list source source))
 224   (let* ((p (dummy-package "guix.scm"
 225               (inputs `(("foo" ,grep)
 226                         ("bar" ,(dummy-package "chbouib"
 227                                   (native-inputs `(("x" ,grep)))))))))
 228          (t (options->transformation '((with-git-url . "grep=https://example.org")))))
 229     (with-store store
 230       (let ((new (t store p)))
 231         (and (not (eq? new p))
 232              (match (package-inputs new)
 233                ((("foo" dep1) ("bar" dep2))
 234                 (and (string=? (package-full-name dep1)
 235                                (package-full-name grep))
 236                      (string=? (package-name dep2) "chbouib")
 237                      (match (package-native-inputs dep2)
 238                        ((("x" dep3))
 239                         (map package-source (list dep1 dep3))))))))))))
 240
 241 (test-equal "options->transformation, with-git-url + with-branch"
 242   ;; Combine the two options and make sure the 'with-branch' transformation
 243   ;; comes after the 'with-git-url' transformation.
 244   (let ((source (git-checkout (url "https://example.org")
 245                               (branch "BRANCH")
 246                               (recursive? #t))))
 247     (list source source))
 248   (let* ((p (dummy-package "guix.scm"
 249               (inputs `(("foo" ,grep)
 250                         ("bar" ,(dummy-package "chbouib"
 251                                   (native-inputs `(("x" ,grep)))))))))
 252          (t (options->transformation
 253              (reverse '((with-git-url
 254                          . "grep=https://example.org")
 255                         (with-branch . "grep=BRANCH"))))))
 256     (with-store store
 257       (let ((new (t store p)))
 258         (and (not (eq? new p))
 259              (match (package-inputs new)
 260                ((("foo" dep1) ("bar" dep2))
 261                 (and (string=? (package-name dep1) "grep")
 262                      (string=? (package-name dep2) "chbouib")
 263                      (match (package-native-inputs dep2)
 264                        ((("x" dep3))
 265                         (map package-source (list dep1 dep3))))))))))))
 266
 267
 268 (test-end)