tests/scripts-build.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2017, 2019, 2020 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 derivations)
  23   #:use-module (guix packages)
  24   #:use-module (guix git-download)
  25   #:use-module (guix build-system)
  26   #:use-module (guix build-system gnu)
  27   #:use-module (guix scripts build)
  28   #:use-module (guix ui)
  29   #:use-module (guix utils)
  30   #:use-module (guix git)
  31   #:use-module (gnu packages)
  32   #:use-module (gnu packages base)
  33   #:use-module (gnu packages busybox)
  34   #:use-module (ice-9 match)
  35   #:use-module (srfi srfi-1)
  36   #:use-module (srfi srfi-26)
  37   #:use-module (srfi srfi-64))
  38
  39 \f
  40 (test-begin "scripts-build")
  41
  42 (test-assert "options->transformation, no transformations"
  43   (let ((p (dummy-package "foo"))
  44         (t (options->transformation '())))
  45     (with-store store
  46       (eq? (t store p) p))))
  47
  48 (test-assert "options->transformation, with-source"
  49   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
  50   ;; be applicable.
  51   (let* ((p (dummy-package "guix.scm"))
  52          (s (search-path %load-path "guix.scm"))
  53          (t (options->transformation `((with-source . ,s)))))
  54     (with-store store
  55       (let ((new (t store p)))
  56         (and (not (eq? new p))
  57              (string=? (package-source new)
  58                        (add-to-store store "guix.scm" #t
  59                                      "sha256" s)))))))
  60
  61 (test-assert "options->transformation, with-source, replacement"
  62   ;; Same, but this time the original package has a 'replacement' field.  We
  63   ;; expect that replacement to be set to #f in the new package.
  64   (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
  65          (s (search-path %load-path "guix.scm"))
  66          (t (options->transformation `((with-source . ,s)))))
  67     (with-store store
  68       (let ((new (t store p)))
  69         (and (not (eq? new p))
  70              (string=? (package-source new)
  71                        (add-to-store store "guix.scm" #t "sha256" s))
  72              (not (package-replacement new)))))))
  73
  74 (test-assert "options->transformation, with-source, with version"
  75   ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
  76   ;; should be applicable, and its version should be extracted.
  77   (let ((p (dummy-package "foo"))
  78         (s (search-path %load-path "guix.scm")))
  79     (call-with-temporary-directory
  80      (lambda (directory)
  81        (let* ((f (string-append directory "/foo-42.0.tar.gz"))
  82               (t (options->transformation `((with-source . ,f)))))
  83          (copy-file s f)
  84          (with-store store
  85            (let ((new (t store p)))
  86              (and (not (eq? new p))
  87                   (string=? (package-name new) (package-name p))
  88                   (string=? (package-version new) "42.0")
  89                   (string=? (package-source new)
  90                             (add-to-store store (basename f) #t
  91                                           "sha256" f))))))))))
  92
  93 (test-assert "options->transformation, with-source, no matches"
  94   ;; When a transformation in not applicable, a warning must be raised.
  95   (let* ((p (dummy-package "foobar"))
  96          (s (search-path %load-path "guix.scm"))
  97          (t (options->transformation `((with-source . ,s)))))
  98     (with-store store
  99       (let* ((port (open-output-string))
 100              (new  (parameterize ((guix-warning-port port))
 101                      (t store p))))
 102         (and (eq? new p)
 103              (string-contains (get-output-string port)
 104                               "had no effect"))))))
 105
 106 (test-assert "options->transformation, with-source, PKG=URI"
 107   (let* ((p (dummy-package "foo"))
 108          (s (search-path %load-path "guix.scm"))
 109          (f (string-append "foo=" s))
 110          (t (options->transformation `((with-source . ,f)))))
 111     (with-store store
 112       (let ((new (t store p)))
 113         (and (not (eq? new p))
 114              (string=? (package-name new) (package-name p))
 115              (string=? (package-version new)
 116                        (package-version p))
 117              (string=? (package-source new)
 118                        (add-to-store store (basename s) #t
 119                                      "sha256" s)))))))
 120
 121 (test-assert "options->transformation, with-source, PKG@VER=URI"
 122   (let* ((p (dummy-package "foo"))
 123          (s (search-path %load-path "guix.scm"))
 124          (f (string-append "foo@42.0=" s))
 125          (t (options->transformation `((with-source . ,f)))))
 126     (with-store store
 127       (let ((new (t store p)))
 128         (and (not (eq? new p))
 129              (string=? (package-name new) (package-name p))
 130              (string=? (package-version new) "42.0")
 131              (string=? (package-source new)
 132                        (add-to-store store (basename s) #t
 133                                      "sha256" s)))))))
 134
 135 (test-assert "options->transformation, with-input"
 136   (let* ((p (dummy-package "guix.scm"
 137               (inputs `(("foo" ,(specification->package "coreutils"))
 138                         ("bar" ,(specification->package "grep"))
 139                         ("baz" ,(dummy-package "chbouib"
 140                                   (native-inputs `(("x" ,grep)))))))))
 141          (t (options->transformation '((with-input . "coreutils=busybox")
 142                                        (with-input . "grep=findutils")))))
 143     (with-store store
 144       (let ((new (t store p)))
 145         (and (not (eq? new p))
 146              (match (package-inputs new)
 147                ((("foo" dep1) ("bar" dep2) ("baz" dep3))
 148                 (and (string=? (package-full-name dep1)
 149                                (package-full-name busybox))
 150                      (string=? (package-full-name dep2)
 151                                (package-full-name findutils))
 152                      (string=? (package-name dep3) "chbouib")
 153                      (match (package-native-inputs dep3)
 154                        ((("x" dep))
 155                         (string=? (package-full-name dep)
 156                                   (package-full-name findutils))))))))))))
 157
 158 (test-assert "options->transformation, with-graft"
 159   (let* ((p (dummy-package "guix.scm"
 160               (inputs `(("foo" ,grep)
 161                         ("bar" ,(dummy-package "chbouib"
 162                                   (native-inputs `(("x" ,grep)))))))))
 163          (t (options->transformation '((with-graft . "grep=findutils")))))
 164     (with-store store
 165       (let ((new (t store p)))
 166         (and (not (eq? new p))
 167              (match (package-inputs new)
 168                ((("foo" dep1) ("bar" dep2))
 169                 (and (string=? (package-full-name dep1)
 170                                (package-full-name grep))
 171                      (string=? (package-full-name (package-replacement dep1))
 172                                (package-full-name findutils))
 173                      (string=? (package-name dep2) "chbouib")
 174                      (match (package-native-inputs dep2)
 175                        ((("x" dep))
 176                         (with-store store
 177                           (string=? (derivation-file-name
 178                                      (package-derivation store findutils))
 179                                     (derivation-file-name
 180                                      (package-derivation store dep))))))))))))))
 181
 182 (test-equal "options->transformation, with-branch"
 183   (git-checkout (url "https://example.org")
 184                 (branch "devel")
 185                 (recursive? #t))
 186   (let* ((p (dummy-package "guix.scm"
 187               (inputs `(("foo" ,grep)
 188                         ("bar" ,(dummy-package "chbouib"
 189                                   (source (origin
 190                                             (method git-fetch)
 191                                             (uri (git-reference
 192                                                   (url "https://example.org")
 193                                                   (commit "cabba9e")))
 194                                             (sha256 #f)))))))))
 195          (t (options->transformation '((with-branch . "chbouib=devel")))))
 196     (with-store store
 197       (let ((new (t store p)))
 198         (and (not (eq? new p))
 199              (match (package-inputs new)
 200                ((("foo" dep1) ("bar" dep2))
 201                 (and (string=? (package-full-name dep1)
 202                                (package-full-name grep))
 203                      (string=? (package-name dep2) "chbouib")
 204                      (package-source dep2)))))))))
 205
 206 (test-equal "options->transformation, with-commit"
 207   (git-checkout (url "https://example.org")
 208                 (commit "abcdef")
 209                 (recursive? #t))
 210   (let* ((p (dummy-package "guix.scm"
 211               (inputs `(("foo" ,grep)
 212                         ("bar" ,(dummy-package "chbouib"
 213                                   (source (origin
 214                                             (method git-fetch)
 215                                             (uri (git-reference
 216                                                   (url "https://example.org")
 217                                                   (commit "cabba9e")))
 218                                             (sha256 #f)))))))))
 219          (t (options->transformation '((with-commit . "chbouib=abcdef")))))
 220     (with-store store
 221       (let ((new (t store p)))
 222         (and (not (eq? new p))
 223              (match (package-inputs new)
 224                ((("foo" dep1) ("bar" dep2))
 225                 (and (string=? (package-full-name dep1)
 226                                (package-full-name grep))
 227                      (string=? (package-name dep2) "chbouib")
 228                      (package-source dep2)))))))))
 229
 230 (test-equal "options->transformation, with-git-url"
 231   (let ((source (git-checkout (url "https://example.org")
 232                               (recursive? #t))))
 233     (list source source))
 234   (let* ((p (dummy-package "guix.scm"
 235               (inputs `(("foo" ,grep)
 236                         ("bar" ,(dummy-package "chbouib"
 237                                   (native-inputs `(("x" ,grep)))))))))
 238          (t (options->transformation '((with-git-url . "grep=https://example.org")))))
 239     (with-store store
 240       (let ((new (t store p)))
 241         (and (not (eq? new p))
 242              (match (package-inputs new)
 243                ((("foo" dep1) ("bar" dep2))
 244                 (and (string=? (package-full-name dep1)
 245                                (package-full-name grep))
 246                      (string=? (package-name dep2) "chbouib")
 247                      (match (package-native-inputs dep2)
 248                        ((("x" dep3))
 249                         (map package-source (list dep1 dep3))))))))))))
 250
 251 (test-equal "options->transformation, with-git-url + with-branch"
 252   ;; Combine the two options and make sure the 'with-branch' transformation
 253   ;; comes after the 'with-git-url' transformation.
 254   (let ((source (git-checkout (url "https://example.org")
 255                               (branch "BRANCH")
 256                               (recursive? #t))))
 257     (list source source))
 258   (let* ((p (dummy-package "guix.scm"
 259               (inputs `(("foo" ,grep)
 260                         ("bar" ,(dummy-package "chbouib"
 261                                   (native-inputs `(("x" ,grep)))))))))
 262          (t (options->transformation
 263              (reverse '((with-git-url
 264                          . "grep=https://example.org")
 265                         (with-branch . "grep=BRANCH"))))))
 266     (with-store store
 267       (let ((new (t store p)))
 268         (and (not (eq? new p))
 269              (match (package-inputs new)
 270                ((("foo" dep1) ("bar" dep2))
 271                 (and (string=? (package-name dep1) "grep")
 272                      (string=? (package-name dep2) "chbouib")
 273                      (match (package-native-inputs dep2)
 274                        ((("x" dep3))
 275                         (map package-source (list dep1 dep3))))))))))))
 276
 277 (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain"))
 278   "Return true if P depends on TOOLCHAIN instead of the default tool chain."
 279   (define toolchain-packages
 280     '("gcc" "binutils" "glibc" "ld-wrapper"))
 281
 282   (define (package-name* obj)
 283     (and (package? obj) (package-name obj)))
 284
 285   (match (bag-build-inputs (package->bag p))
 286     (((_ (= package-name* packages) . _) ...)
 287      (and (not (any (cut member <> packages) toolchain-packages))
 288           (member toolchain packages)))))
 289
 290 (test-assert "options->transformation, with-c-toolchain"
 291   (let* ((dep0 (dummy-package "chbouib"
 292                  (build-system gnu-build-system)
 293                  (native-inputs `(("y" ,grep)))))
 294          (dep1 (dummy-package "stuff"
 295                  (native-inputs `(("x" ,dep0)))))
 296          (p    (dummy-package "thingie"
 297                  (build-system gnu-build-system)
 298                  (inputs `(("foo" ,grep)
 299                            ("bar" ,dep1)))))
 300          (t    (options->transformation
 301                 '((with-c-toolchain . "chbouib=gcc-toolchain")))))
 302     ;; Here we check that the transformation applies to DEP0 and all its
 303     ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN
 304     ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on.
 305     (with-store store
 306       (let ((new (t store p)))
 307         (and (depends-on-toolchain? new "gcc-toolchain")
 308              (match (bag-build-inputs (package->bag new))
 309                ((("foo" dep0) ("bar" dep1) _ ...)
 310                 (and (depends-on-toolchain? dep1 "gcc-toolchain")
 311                      (not (depends-on-toolchain? dep0 "gcc-toolchain"))
 312                      (string=? (package-full-name dep0)
 313                                (package-full-name grep))
 314                      (match (bag-build-inputs (package->bag dep1))
 315                        ((("x" dep) _ ...)
 316                         (and (depends-on-toolchain? dep "gcc-toolchain")
 317                              (match (bag-build-inputs (package->bag dep))
 318                                ((("y" dep) _ ...) ;this one is unchanged
 319                                 (eq? dep grep))))))))))))))
 320
 321 (test-equal "options->transformation, with-c-toolchain twice"
 322   (package-full-name grep)
 323   (let* ((dep0 (dummy-package "chbouib"))
 324          (dep1 (dummy-package "stuff"))
 325          (p    (dummy-package "thingie"
 326                  (build-system gnu-build-system)
 327                  (inputs `(("foo" ,dep0)
 328                            ("bar" ,dep1)
 329                            ("baz" ,grep)))))
 330          (t    (options->transformation
 331                 '((with-c-toolchain . "chbouib=clang-toolchain")
 332                   (with-c-toolchain . "stuff=clang-toolchain")))))
 333     (with-store store
 334       (let ((new (t store p)))
 335         (and (depends-on-toolchain? new "clang-toolchain")
 336              (match (bag-build-inputs (package->bag new))
 337                ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...)
 338                 (and (depends-on-toolchain? dep0 "clang-toolchain")
 339                      (depends-on-toolchain? dep1 "clang-toolchain")
 340                      (not (depends-on-toolchain? dep2 "clang-toolchain"))
 341                      (package-full-name dep2)))))))))
 342
 343 (test-assert "options->transformation, with-c-toolchain, no effect"
 344   (let ((p (dummy-package "thingie"))
 345         (t (options->transformation
 346             '((with-c-toolchain . "does-not-exist=gcc-toolchain")))))
 347     ;; When it has no effect, '--with-c-toolchain' returns P.
 348     (with-store store
 349       (eq? (t store p) p))))
 350
 351 (test-equal "options->transformation, with-debug-info"
 352   '(#:strip-binaries? #f)
 353   (let* ((dep  (dummy-package "chbouib"))
 354          (p    (dummy-package "thingie"
 355                  (build-system gnu-build-system)
 356                  (inputs `(("foo" ,dep)
 357                            ("bar" ,grep)))))
 358          (t    (options->transformation
 359                 '((with-debug-info . "chbouib")))))
 360     (with-store store
 361       (let ((new (t store p)))
 362         (match (package-inputs new)
 363           ((("foo" dep0) ("bar" dep1))
 364            (and (string=? (package-full-name dep1)
 365                           (package-full-name grep))
 366                 (package-arguments (package-replacement dep0)))))))))
 367
 368 (test-assert "options->transformation, without-tests"
 369   (let* ((dep (dummy-package "dep"))
 370          (p   (dummy-package "foo"
 371                 (inputs `(("dep" ,dep)))))
 372          (t   (options->transformation '((without-tests . "dep")
 373                                          (without-tests . "tar")))))
 374     (with-store store
 375       (let ((new (t store p)))
 376         (match (bag-direct-inputs (package->bag new))
 377           ((("dep" dep) ("tar" tar) _ ...)
 378            ;; TODO: Check whether TAR has #:tests? #f when transformations
 379            ;; apply to implicit inputs.
 380            (equal? (package-arguments dep)
 381                    '(#:tests? #f))))))))
 382
 383 (test-end)
 384
 385 ;;; Local Variables:
 386 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)
 387 ;;; End: