tests/derivations.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016 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-derivations)
  20   #:use-module (guix derivations)
  21   #:use-module (guix grafts)
  22   #:use-module (guix store)
  23   #:use-module (guix utils)
  24   #:use-module (guix hash)
  25   #:use-module (guix base32)
  26   #:use-module (guix tests)
  27   #:use-module ((guix packages) #:select (package-derivation base32))
  28   #:use-module ((guix build utils) #:select (executable-file?))
  29   #:use-module ((gnu packages) #:select (search-bootstrap-binary))
  30   #:use-module (gnu packages bootstrap)
  31   #:use-module ((gnu packages guile) #:select (guile-1.8))
  32   #:use-module (srfi srfi-1)
  33   #:use-module (srfi srfi-11)
  34   #:use-module (srfi srfi-26)
  35   #:use-module (srfi srfi-34)
  36   #:use-module (srfi srfi-64)
  37   #:use-module (rnrs io ports)
  38   #:use-module (rnrs bytevectors)
  39   #:use-module (web uri)
  40   #:use-module (ice-9 rdelim)
  41   #:use-module (ice-9 regex)
  42   #:use-module (ice-9 ftw)
  43   #:use-module (ice-9 match))
  44
  45 (define %store
  46   (open-connection-for-tests))
  47
  48 ;; Globally disable grafts because they can trigger early builds.
  49 (%graft? #f)
  50
  51 (define (bootstrap-binary name)
  52   (let ((bin (search-bootstrap-binary name (%current-system))))
  53     (and %store
  54          (add-to-store %store name #t "sha256" bin))))
  55
  56 (define %bash
  57   (bootstrap-binary "bash"))
  58 (define %mkdir
  59   (bootstrap-binary "mkdir"))
  60
  61 (define* (directory-contents dir #:optional (slurp get-bytevector-all))
  62   "Return an alist representing the contents of DIR."
  63   (define prefix-len (string-length dir))
  64   (sort (file-system-fold (const #t)                   ; enter?
  65                           (lambda (path stat result)   ; leaf
  66                             (alist-cons (string-drop path prefix-len)
  67                                         (call-with-input-file path slurp)
  68                                         result))
  69                           (lambda (path stat result) result)      ; down
  70                           (lambda (path stat result) result)      ; up
  71                           (lambda (path stat result) result)      ; skip
  72                           (lambda (path stat errno result) result) ; error
  73                           '()
  74                           dir)
  75         (lambda (e1 e2)
  76           (string<? (car e1) (car e2)))))
  77
  78 \f
  79 (test-begin "derivations")
  80
  81 (test-assert "parse & export"
  82   (let* ((f  (search-path %load-path "tests/test.drv"))
  83          (b1 (call-with-input-file f get-bytevector-all))
  84          (d1 (read-derivation (open-bytevector-input-port b1)))
  85          (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
  86          (d2 (read-derivation (open-bytevector-input-port b2))))
  87     (and (equal? b1 b2)
  88          (equal? d1 d2))))
  89
  90 (test-skip (if %store 0 12))
  91
  92 (test-assert "add-to-store, flat"
  93   (let* ((file (search-path %load-path "language/tree-il/spec.scm"))
  94          (drv  (add-to-store %store "flat-test" #f "sha256" file)))
  95     (and (eq? 'regular (stat:type (stat drv)))
  96          (valid-path? %store drv)
  97          (equal? (call-with-input-file file get-bytevector-all)
  98                  (call-with-input-file drv get-bytevector-all)))))
  99
 100 (test-assert "add-to-store, recursive"
 101   (let* ((dir (dirname (search-path %load-path "language/tree-il/spec.scm")))
 102          (drv (add-to-store %store "dir-tree-test" #t "sha256" dir)))
 103     (and (eq? 'directory (stat:type (stat drv)))
 104          (valid-path? %store drv)
 105          (equal? (directory-contents dir)
 106                  (directory-contents drv)))))
 107
 108 (test-assert "derivation with no inputs"
 109   (let* ((builder  (add-text-to-store %store "my-builder.sh"
 110                                       "echo hello, world\n"
 111                                       '()))
 112          (drv      (derivation %store "foo"
 113                                %bash `("-e" ,builder)
 114                                #:env-vars '(("HOME" . "/homeless")))))
 115     (and (store-path? (derivation-file-name drv))
 116          (valid-path? %store (derivation-file-name drv)))))
 117
 118 (test-assert "build derivation with 1 source"
 119   (let* ((builder (add-text-to-store %store "my-builder.sh"
 120                                      "echo hello, world > \"$out\"\n"
 121                                      '()))
 122          (drv     (derivation %store "foo"
 123                               %bash `(,builder)
 124                               #:env-vars '(("HOME" . "/homeless")
 125                                            ("zzz"  . "Z!")
 126                                            ("AAA"  . "A!"))
 127                               #:inputs `((,%bash) (,builder))))
 128          (succeeded?
 129           (build-derivations %store (list drv))))
 130     (and succeeded?
 131          (let ((path (derivation->output-path drv)))
 132            (and (valid-path? %store path)
 133                 (string=? (call-with-input-file path read-line)
 134                           "hello, world"))))))
 135
 136 (test-assert "derivation with local file as input"
 137   (let* ((builder    (add-text-to-store
 138                       %store "my-builder.sh"
 139                       "(while read line ; do echo \"$line\" ; done) < $in > $out"
 140                       '()))
 141          (input      (search-path %load-path "ice-9/boot-9.scm"))
 142          (input*     (add-to-store %store (basename input)
 143                                    #t "sha256" input))
 144          (drv        (derivation %store "derivation-with-input-file"
 145                                  %bash `(,builder)
 146
 147                                  ;; Cheat to pass the actual file name to the
 148                                  ;; builder.
 149                                  #:env-vars `(("in" . ,input*))
 150
 151                                  #:inputs `((,%bash)
 152                                             (,builder)
 153                                             (,input))))) ; ← local file name
 154     (and (build-derivations %store (list drv))
 155          ;; Note: we can't compare the files because the above trick alters
 156          ;; the contents.
 157          (valid-path? %store (derivation->output-path drv)))))
 158
 159 (test-assert "derivation fails but keep going"
 160   ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
 161   ;; must return only after D2 has succeeded.
 162   (with-store store
 163     (let* ((d1 (derivation %store "fails"
 164                            %bash `("-c" "false")
 165                            #:inputs `((,%bash))))
 166            (d2 (build-expression->derivation %store "sleep-then-succeed"
 167                                              `(begin
 168                                                 ,(random-text)
 169                                                 ;; XXX: Hopefully that's long
 170                                                 ;; enough that D1 has already
 171                                                 ;; failed.
 172                                                 (sleep 2)
 173                                                 (mkdir %output)))))
 174       (set-build-options %store
 175                          #:use-substitutes? #f
 176                          #:keep-going? #t)
 177       (guard (c ((nix-protocol-error? c)
 178                  (and (= 100 (nix-protocol-error-status c))
 179                       (string-contains (nix-protocol-error-message c)
 180                                        (derivation-file-name d1))
 181                       (not (valid-path? %store (derivation->output-path d1)))
 182                       (valid-path? %store (derivation->output-path d2)))))
 183         (build-derivations %store (list d1 d2))
 184         #f))))
 185
 186 (test-assert "identical files are deduplicated"
 187   (let* ((build1  (add-text-to-store %store "one.sh"
 188                                      "echo hello, world > \"$out\"\n"
 189                                      '()))
 190          (build2  (add-text-to-store %store "two.sh"
 191                                      "# Hey!\necho hello, world > \"$out\"\n"
 192                                      '()))
 193          (drv1    (derivation %store "foo"
 194                               %bash `(,build1)
 195                               #:inputs `((,%bash) (,build1))))
 196          (drv2    (derivation %store "bar"
 197                               %bash `(,build2)
 198                               #:inputs `((,%bash) (,build2)))))
 199     (and (build-derivations %store (list drv1 drv2))
 200          (let ((file1 (derivation->output-path drv1))
 201                (file2 (derivation->output-path drv2)))
 202            (and (valid-path? %store file1) (valid-path? %store file2)
 203                 (string=? (call-with-input-file file1 get-string-all)
 204                           "hello, world\n")
 205                 (= (stat:ino (lstat file1))
 206                    (stat:ino (lstat file2))))))))
 207
 208 (test-equal "derivation-name"
 209   "foo-0.0"
 210   (let ((drv (derivation %store "foo-0.0" %bash '())))
 211     (derivation-name drv)))
 212
 213 (test-equal "derivation-output-names"
 214   '(("out") ("bar" "chbouib"))
 215   (let ((drv1 (derivation %store "foo-0.0" %bash '()))
 216         (drv2 (derivation %store "foo-0.0" %bash '()
 217                           #:outputs '("bar" "chbouib"))))
 218     (list (derivation-output-names drv1)
 219           (derivation-output-names drv2))))
 220
 221 (test-assert "offloadable-derivation?"
 222   (and (offloadable-derivation? (derivation %store "foo" %bash '()))
 223        (offloadable-derivation?               ;see <http://bugs.gnu.org/18747>
 224         (derivation %store "foo" %bash '()
 225                     #:substitutable? #f))
 226        (not (offloadable-derivation?
 227              (derivation %store "foo" %bash '()
 228                          #:local-build? #t)))))
 229
 230 (test-assert "substitutable-derivation?"
 231   (and (substitutable-derivation? (derivation %store "foo" %bash '()))
 232        (substitutable-derivation?             ;see <http://bugs.gnu.org/18747>
 233         (derivation %store "foo" %bash '()
 234                     #:local-build? #t))
 235        (not (substitutable-derivation?
 236              (derivation %store "foo" %bash '()
 237                          #:substitutable? #f)))))
 238
 239 (test-assert "fixed-output-derivation?"
 240   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 241                                         "echo -n hello > $out" '()))
 242          (hash       (sha256 (string->utf8 "hello")))
 243          (drv        (derivation %store "fixed"
 244                                  %bash `(,builder)
 245                                  #:inputs `((,builder))
 246                                  #:hash hash #:hash-algo 'sha256)))
 247     (fixed-output-derivation? drv)))
 248
 249 (test-assert "fixed-output derivation"
 250   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 251                                         "echo -n hello > $out" '()))
 252          (hash       (sha256 (string->utf8 "hello")))
 253          (drv        (derivation %store "fixed"
 254                                  %bash `(,builder)
 255                                  #:inputs `((,builder)) ; optional
 256                                  #:hash hash #:hash-algo 'sha256))
 257          (succeeded? (build-derivations %store (list drv))))
 258     (and succeeded?
 259          (let ((p (derivation->output-path drv)))
 260            (and (equal? (string->utf8 "hello")
 261                         (call-with-input-file p get-bytevector-all))
 262                 (bytevector? (query-path-hash %store p)))))))
 263
 264 (test-assert "fixed-output derivation: output paths are equal"
 265   (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
 266                                         "echo -n hello > $out" '()))
 267          (builder2   (add-text-to-store %store "fixed-builder2.sh"
 268                                         "echo hey; echo -n hello > $out" '()))
 269          (hash       (sha256 (string->utf8 "hello")))
 270          (drv1       (derivation %store "fixed"
 271                                  %bash `(,builder1)
 272                                  #:hash hash #:hash-algo 'sha256))
 273          (drv2       (derivation %store "fixed"
 274                                  %bash `(,builder2)
 275                                  #:hash hash #:hash-algo 'sha256))
 276          (succeeded? (build-derivations %store (list drv1 drv2))))
 277     (and succeeded?
 278          (equal? (derivation->output-path drv1)
 279                  (derivation->output-path drv2)))))
 280
 281 (test-assert "fixed-output derivation, recursive"
 282   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 283                                         "echo -n hello > $out" '()))
 284          (hash       (sha256 (string->utf8 "hello")))
 285          (drv        (derivation %store "fixed-rec"
 286                                  %bash `(,builder)
 287                                  #:inputs `((,builder))
 288                                  #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
 289                                  #:hash-algo 'sha256
 290                                  #:recursive? #t))
 291          (succeeded? (build-derivations %store (list drv))))
 292     (and succeeded?
 293          (let ((p (derivation->output-path drv)))
 294            (and (equal? (string->utf8 "hello")
 295                         (call-with-input-file p get-bytevector-all))
 296                 (bytevector? (query-path-hash %store p)))))))
 297
 298 (test-assert "derivation with a fixed-output input"
 299   ;; A derivation D using a fixed-output derivation F doesn't has the same
 300   ;; output path when passed F or F', as long as F and F' have the same output
 301   ;; path.
 302   (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
 303                                         "echo -n hello > $out" '()))
 304          (builder2   (add-text-to-store %store "fixed-builder2.sh"
 305                                         "echo hey; echo -n hello > $out" '()))
 306          (hash       (sha256 (string->utf8 "hello")))
 307          (fixed1     (derivation %store "fixed"
 308                                  %bash `(,builder1)
 309                                  #:hash hash #:hash-algo 'sha256))
 310          (fixed2     (derivation %store "fixed"
 311                                  %bash `(,builder2)
 312                                  #:hash hash #:hash-algo 'sha256))
 313          (fixed-out  (derivation->output-path fixed1))
 314          (builder3   (add-text-to-store
 315                       %store "final-builder.sh"
 316                       ;; Use Bash hackery to avoid Coreutils.
 317                       "echo $in ; (read -u 3 c; echo $c) 3< $in > $out" '()))
 318          (final1     (derivation %store "final"
 319                                  %bash `(,builder3)
 320                                  #:env-vars `(("in" . ,fixed-out))
 321                                  #:inputs `((,%bash) (,builder3) (,fixed1))))
 322          (final2     (derivation %store "final"
 323                                  %bash `(,builder3)
 324                                  #:env-vars `(("in" . ,fixed-out))
 325                                  #:inputs `((,%bash) (,builder3) (,fixed2))))
 326          (succeeded? (build-derivations %store
 327                                         (list final1 final2))))
 328     (and succeeded?
 329          (equal? (derivation->output-path final1)
 330                  (derivation->output-path final2)))))
 331
 332 (test-assert "multiple-output derivation"
 333   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 334                                         "echo one > $out ; echo two > $second"
 335                                         '()))
 336          (drv        (derivation %store "fixed"
 337                                  %bash `(,builder)
 338                                  #:env-vars '(("HOME" . "/homeless")
 339                                               ("zzz"  . "Z!")
 340                                               ("AAA"  . "A!"))
 341                                  #:inputs `((,%bash) (,builder))
 342                                  #:outputs '("out" "second")))
 343          (succeeded? (build-derivations %store (list drv))))
 344     (and succeeded?
 345          (let ((one (derivation->output-path drv "out"))
 346                (two (derivation->output-path drv "second")))
 347            (and (lset= equal?
 348                        (derivation->output-paths drv)
 349                        `(("out" . ,one) ("second" . ,two)))
 350                 (eq? 'one (call-with-input-file one read))
 351                 (eq? 'two (call-with-input-file two read)))))))
 352
 353 (test-assert "multiple-output derivation, non-alphabetic order"
 354   ;; Here, the outputs are not listed in alphabetic order.  Yet, the store
 355   ;; path computation must reorder them first.
 356   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 357                                         "echo one > $out ; echo two > $AAA"
 358                                         '()))
 359          (drv        (derivation %store "fixed"
 360                                  %bash `(,builder)
 361                                  #:inputs `((,%bash) (,builder))
 362                                  #:outputs '("out" "AAA")))
 363          (succeeded? (build-derivations %store (list drv))))
 364     (and succeeded?
 365          (let ((one (derivation->output-path drv "out"))
 366                (two (derivation->output-path drv "AAA")))
 367            (and (eq? 'one (call-with-input-file one read))
 368                 (eq? 'two (call-with-input-file two read)))))))
 369
 370 (test-assert "read-derivation vs. derivation"
 371   ;; Make sure 'derivation' and 'read-derivation' return objects that are
 372   ;; identical.
 373   (let* ((sources (unfold (cut >= <> 10)
 374                           (lambda (n)
 375                             (add-text-to-store %store
 376                                                (format #f "input~a" n)
 377                                                (random-text)))
 378                           1+
 379                           0))
 380          (inputs  (map (lambda (file)
 381                          (derivation %store "derivation-input"
 382                                      %bash '()
 383                                      #:inputs `((,%bash) (,file))))
 384                        sources))
 385          (builder (add-text-to-store %store "builder.sh"
 386                                      "echo one > $one ; echo two > $two"
 387                                      '()))
 388          (drv     (derivation %store "derivation"
 389                               %bash `(,builder)
 390                               #:inputs `((,%bash) (,builder)
 391                                          ,@(map list (append sources inputs)))
 392                               #:outputs '("two" "one")))
 393          (drv*    (call-with-input-file (derivation-file-name drv)
 394                     read-derivation)))
 395     (equal? drv* drv)))
 396
 397 (test-assert "multiple-output derivation, derivation-path->output-path"
 398   (let* ((builder    (add-text-to-store %store "builder.sh"
 399                                         "echo one > $out ; echo two > $second"
 400                                         '()))
 401          (drv        (derivation %store "multiple"
 402                                  %bash `(,builder)
 403                                  #:outputs '("out" "second")))
 404          (drv-file   (derivation-file-name drv))
 405          (one        (derivation->output-path drv "out"))
 406          (two        (derivation->output-path drv "second"))
 407          (first      (derivation-path->output-path drv-file "out"))
 408          (second     (derivation-path->output-path drv-file "second")))
 409     (and (not (string=? one two))
 410          (string-suffix? "-second" two)
 411          (string=? first one)
 412          (string=? second two))))
 413
 414 (test-assert "user of multiple-output derivation"
 415   ;; Check whether specifying several inputs coming from the same
 416   ;; multiple-output derivation works.
 417   (let* ((builder1   (add-text-to-store %store "my-mo-builder.sh"
 418                                         "echo one > $out ; echo two > $two"
 419                                         '()))
 420          (mdrv       (derivation %store "multiple-output"
 421                                  %bash `(,builder1)
 422                                  #:inputs `((,%bash) (,builder1))
 423                                  #:outputs '("out" "two")))
 424          (builder2   (add-text-to-store %store "my-mo-user-builder.sh"
 425                                         "read x < $one;
 426                                          read y < $two;
 427                                          echo \"($x $y)\" > $out"
 428                                         '()))
 429          (udrv       (derivation %store "multiple-output-user"
 430                                  %bash `(,builder2)
 431                                  #:env-vars `(("one"
 432                                                . ,(derivation->output-path
 433                                                    mdrv "out"))
 434                                               ("two"
 435                                                . ,(derivation->output-path
 436                                                    mdrv "two")))
 437                                  #:inputs `((,%bash)
 438                                             (,builder2)
 439                                             ;; two occurrences of MDRV:
 440                                             (,mdrv)
 441                                             (,mdrv "two")))))
 442     (and (build-derivations %store (list (pk 'udrv udrv)))
 443          (let ((p (derivation->output-path udrv)))
 444            (and (valid-path? %store p)
 445                 (equal? '(one two) (call-with-input-file p read)))))))
 446
 447 (test-assert "derivation with #:references-graphs"
 448   (let* ((input1  (add-text-to-store %store "foo" "hello"
 449                                      (list %bash)))
 450          (input2  (add-text-to-store %store "bar"
 451                                      (number->string (random 7777))
 452                                      (list input1)))
 453          (builder (add-text-to-store %store "build-graph"
 454                                      (format #f "
 455 ~a $out
 456  (while read l ; do echo $l ; done) < bash > $out/bash
 457  (while read l ; do echo $l ; done) < input1 > $out/input1
 458  (while read l ; do echo $l ; done) < input2 > $out/input2"
 459                                              %mkdir)
 460                                      (list %mkdir)))
 461          (drv     (derivation %store "closure-graphs"
 462                               %bash `(,builder)
 463                               #:references-graphs
 464                               `(("bash" . ,%bash)
 465                                 ("input1" . ,input1)
 466                                 ("input2" . ,input2))
 467                               #:inputs `((,%bash) (,builder))))
 468          (out     (derivation->output-path drv)))
 469     (define (deps path . deps)
 470       (let ((count (length deps)))
 471         (string-append path "\n\n" (number->string count) "\n"
 472                        (string-join (sort deps string<?) "\n")
 473                        (if (zero? count) "" "\n"))))
 474
 475     (and (build-derivations %store (list drv))
 476          (equal? (directory-contents out get-string-all)
 477                  `(("/bash"   . ,(string-append %bash "\n\n0\n"))
 478                    ("/input1" . ,(if (string>? input1 %bash)
 479                                      (string-append (deps %bash)
 480                                                     (deps input1 %bash))
 481                                      (string-append (deps input1 %bash)
 482                                                     (deps %bash))))
 483                    ("/input2" . ,(string-concatenate
 484                                   (map cdr
 485                                        (sort
 486                                         (map (lambda (p d)
 487                                                (cons p (apply deps p d)))
 488                                              (list %bash input1 input2)
 489                                              (list '() (list %bash) (list input1)))
 490                                         (lambda (x y)
 491                                           (match x
 492                                             ((p1 . _)
 493                                              (match y
 494                                                ((p2 . _)
 495                                                 (string<? p1 p2)))))))))))))))
 496
 497 (test-assert "derivation #:allowed-references, ok"
 498   (let ((drv (derivation %store "allowed" %bash
 499                          '("-c" "echo hello > $out")
 500                          #:inputs `((,%bash))
 501                          #:allowed-references '())))
 502     (build-derivations %store (list drv))))
 503
 504 (test-assert "derivation #:allowed-references, not allowed"
 505   (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
 506          (drv (derivation %store "disallowed" %bash
 507                           `("-c" ,(string-append "echo " txt "> $out"))
 508                           #:inputs `((,%bash) (,txt))
 509                           #:allowed-references '())))
 510     (guard (c ((nix-protocol-error? c)
 511                ;; There's no specific error message to check for.
 512                #t))
 513       (build-derivations %store (list drv))
 514       #f)))
 515
 516 (test-assert "derivation #:allowed-references, self allowed"
 517   (let ((drv (derivation %store "allowed" %bash
 518                          '("-c" "echo $out > $out")
 519                          #:inputs `((,%bash))
 520                          #:allowed-references '("out"))))
 521     (build-derivations %store (list drv))))
 522
 523 (test-assert "derivation #:allowed-references, self not allowed"
 524   (let ((drv (derivation %store "disallowed" %bash
 525                          `("-c" ,"echo $out > $out")
 526                          #:inputs `((,%bash))
 527                          #:allowed-references '())))
 528     (guard (c ((nix-protocol-error? c)
 529                ;; There's no specific error message to check for.
 530                #t))
 531       (build-derivations %store (list drv))
 532       #f)))
 533
 534 (test-assert "derivation #:disallowed-references, ok"
 535   (let ((drv (derivation %store "disallowed" %bash
 536                          '("-c" "echo hello > $out")
 537                          #:inputs `((,%bash))
 538                          #:disallowed-references '("out"))))
 539     (build-derivations %store (list drv))))
 540
 541 (test-assert "derivation #:disallowed-references, not ok"
 542   (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
 543          (drv (derivation %store "disdisallowed" %bash
 544                           `("-c" ,(string-append "echo " txt "> $out"))
 545                           #:inputs `((,%bash) (,txt))
 546                           #:disallowed-references (list txt))))
 547     (guard (c ((nix-protocol-error? c)
 548                ;; There's no specific error message to check for.
 549                #t))
 550       (build-derivations %store (list drv))
 551       #f)))
 552
 553 ;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
 554 ;; is a unique value for each test process; this value is the same as the one
 555 ;; we see in the process executing this file since it is set by 'test-env'.
 556 (test-equal "derivation #:leaked-env-vars"
 557   (getenv "NIX_STATE_DIR")
 558   (let* ((value (getenv "NIX_STATE_DIR"))
 559          (drv   (derivation %store "leaked-env-vars" %bash
 560                             '("-c" "echo -n $NIX_STATE_DIR > $out")
 561                             #:hash (sha256 (string->utf8 value))
 562                             #:hash-algo 'sha256
 563                             #:inputs `((,%bash))
 564                             #:leaked-env-vars '("NIX_STATE_DIR"))))
 565     (and (build-derivations %store (list drv))
 566          (call-with-input-file (derivation->output-path drv)
 567            get-string-all))))
 568
 569 \f
 570 (define %coreutils
 571   (false-if-exception
 572    (and (network-reachable?)
 573         (package-derivation %store %bootstrap-coreutils&co))))
 574
 575 (test-skip (if %coreutils 0 1))
 576
 577 (test-assert "build derivation with coreutils"
 578   (let* ((builder
 579           (add-text-to-store %store "build-with-coreutils.sh"
 580                              "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
 581                              '()))
 582          (drv
 583           (derivation %store "foo"
 584                       %bash `(,builder)
 585                       #:env-vars `(("PATH" .
 586                                     ,(string-append
 587                                       (derivation->output-path %coreutils)
 588                                       "/bin")))
 589                       #:inputs `((,builder)
 590                                  (,%coreutils))))
 591          (succeeded?
 592           (build-derivations %store (list drv))))
 593     (and succeeded?
 594          (let ((p (derivation->output-path drv)))
 595            (and (valid-path? %store p)
 596                 (file-exists? (string-append p "/good")))))))
 597
 598 (test-skip (if (%guile-for-build) 0 8))
 599
 600 (test-equal "build-expression->derivation and invalid module name"
 601   '(file-search-error "guix/module/that/does/not/exist.scm")
 602   (guard (c ((file-search-error? c)
 603              (list 'file-search-error
 604                    (file-search-error-file-name c))))
 605     (build-expression->derivation %store "foo" #t
 606                                   #:modules '((guix module that
 607                                                     does not exist)))))
 608
 609 (test-assert "build-expression->derivation and derivation-prerequisites"
 610   (let ((drv (build-expression->derivation %store "fail" #f)))
 611     (any (match-lambda
 612           (($ <derivation-input> path)
 613            (string=? path (derivation-file-name (%guile-for-build)))))
 614          (derivation-prerequisites drv))))
 615
 616 (test-assert "derivation-prerequisites and valid-derivation-input?"
 617   (let* ((a (build-expression->derivation %store "a" '(mkdir %output)))
 618          (b (build-expression->derivation %store "b" `(list ,(random-text))))
 619          (c (build-expression->derivation %store "c" `(mkdir %output)
 620                                           #:inputs `(("a" ,a) ("b" ,b)))))
 621     ;; Make sure both A and %BOOTSTRAP-GUILE are built (the latter could have
 622     ;; be removed by tests/guix-gc.sh.)
 623     (build-derivations %store
 624                        (list a (package-derivation %store %bootstrap-guile)))
 625
 626     (match (derivation-prerequisites c
 627                                      (cut valid-derivation-input? %store
 628                                           <>))
 629       ((($ <derivation-input> file ("out")))
 630        (string=? file (derivation-file-name b)))
 631       (x
 632        (pk 'fail x #f)))))
 633
 634 (test-assert "build-expression->derivation without inputs"
 635   (let* ((builder    '(begin
 636                         (mkdir %output)
 637                         (call-with-output-file (string-append %output "/test")
 638                           (lambda (p)
 639                             (display '(hello guix) p)))))
 640          (drv        (build-expression->derivation %store "goo" builder))
 641          (succeeded? (build-derivations %store (list drv))))
 642     (and succeeded?
 643          (let ((p (derivation->output-path drv)))
 644            (equal? '(hello guix)
 645                    (call-with-input-file (string-append p "/test") read))))))
 646
 647 (test-assert "build-expression->derivation and max-silent-time"
 648   (let* ((store      (let ((s (open-connection)))
 649                        (set-build-options s #:max-silent-time 1)
 650                        s))
 651          (builder    '(begin (sleep 100) (mkdir %output) #t))
 652          (drv        (build-expression->derivation store "silent" builder))
 653          (out-path   (derivation->output-path drv)))
 654     (guard (c ((nix-protocol-error? c)
 655                (and (string-contains (nix-protocol-error-message c)
 656                                      "failed")
 657                     (not (valid-path? store out-path)))))
 658       (build-derivations store (list drv))
 659       #f)))
 660
 661 (test-assert "build-expression->derivation and timeout"
 662   (let* ((store      (let ((s (open-connection)))
 663                        (set-build-options s #:timeout 1)
 664                        s))
 665          (builder    '(begin (sleep 100) (mkdir %output) #t))
 666          (drv        (build-expression->derivation store "slow" builder))
 667          (out-path   (derivation->output-path drv)))
 668     (guard (c ((nix-protocol-error? c)
 669                (and (string-contains (nix-protocol-error-message c)
 670                                      "failed")
 671                     (not (valid-path? store out-path)))))
 672       (build-derivations store (list drv))
 673       #f)))
 674
 675 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
 676   (let ((drv (build-expression->derivation %store "fail" #f)))
 677     ;; The only direct dependency is (%guile-for-build) and it's already
 678     ;; built.
 679     (null? (derivation-prerequisites-to-build %store drv))))
 680
 681 (test-assert "derivation-prerequisites-to-build when outputs already present"
 682   (let* ((builder    '(begin (mkdir %output) #t))
 683          (input-drv  (build-expression->derivation %store "input" builder))
 684          (input-path (derivation-output-path
 685                       (assoc-ref (derivation-outputs input-drv)
 686                                  "out")))
 687          (drv        (build-expression->derivation %store "something" builder
 688                                                    #:inputs
 689                                                    `(("i" ,input-drv))))
 690          (output     (derivation->output-path drv)))
 691     ;; Make sure these things are not already built.
 692     (when (valid-path? %store input-path)
 693       (delete-paths %store (list input-path)))
 694     (when (valid-path? %store output)
 695       (delete-paths %store (list output)))
 696
 697     (and (equal? (map derivation-input-path
 698                       (derivation-prerequisites-to-build %store drv))
 699                  (list (derivation-file-name input-drv)))
 700
 701          ;; Build DRV and delete its input.
 702          (build-derivations %store (list drv))
 703          (delete-paths %store (list input-path))
 704          (not (valid-path? %store input-path))
 705
 706          ;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
 707          ;; prerequisite to build because DRV itself is already built.
 708          (null? (derivation-prerequisites-to-build %store drv)))))
 709
 710 (test-assert "derivation-prerequisites-to-build and substitutes"
 711   (let* ((store  (open-connection))
 712          (drv    (build-expression->derivation store "prereq-subst"
 713                                                (random 1000)))
 714          (output (derivation->output-path drv)))
 715
 716     ;; Make sure substitutes are usable.
 717     (set-build-options store #:use-substitutes? #t
 718                        #:substitute-urls (%test-substitute-urls))
 719
 720     (with-derivation-narinfo drv
 721       (let-values (((build download)
 722                     (derivation-prerequisites-to-build store drv))
 723                    ((build* download*)
 724                     (derivation-prerequisites-to-build store drv
 725                                                        #:substitutable?
 726                                                        (const #f))))
 727         (and (null? build)
 728              (equal? download (list output))
 729              (null? download*)
 730              (null? build*))))))
 731
 732 (test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
 733   (let* ((store  (open-connection))
 734          (drv    (build-expression->derivation store "prereq-no-subst"
 735                                                (random 1000)
 736                                                #:substitutable? #f))
 737          (output (derivation->output-path drv)))
 738
 739     ;; Make sure substitutes are usable.
 740     (set-build-options store #:use-substitutes? #t
 741                        #:substitute-urls (%test-substitute-urls))
 742
 743     (with-derivation-narinfo drv
 744       (let-values (((build download)
 745                     (derivation-prerequisites-to-build store drv)))
 746         ;; Despite being available as a substitute, DRV will be built locally
 747         ;; due to #:substitutable? #f.
 748         (and (null? download)
 749              (match build
 750                (((? derivation-input? input))
 751                 (string=? (derivation-input-path input)
 752                           (derivation-file-name drv)))))))))
 753
 754 (test-assert "derivation-prerequisites-to-build and substitutes, local build"
 755   (with-store store
 756     (let* ((drv    (build-expression->derivation store "prereq-subst-local"
 757                                                  (random 1000)
 758                                                  #:local-build? #t))
 759            (output (derivation->output-path drv)))
 760
 761       ;; Make sure substitutes are usable.
 762       (set-build-options store #:use-substitutes? #t
 763                          #:substitute-urls (%test-substitute-urls))
 764
 765       (with-derivation-narinfo drv
 766         (let-values (((build download)
 767                       (derivation-prerequisites-to-build store drv)))
 768           ;; #:local-build? is *not* synonymous with #:substitutable?, so we
 769           ;; must be able to substitute DRV's output.
 770           ;; See <http://bugs.gnu.org/18747>.
 771           (and (null? build)
 772                (match download
 773                  (((? string? item))
 774                   (string=? item (derivation->output-path drv))))))))))
 775
 776 (test-assert "derivation-prerequisites-to-build in 'check' mode"
 777   (with-store store
 778     (let* ((dep (build-expression->derivation store "dep"
 779                                               `(begin ,(random-text)
 780                                                       (mkdir %output))))
 781            (drv (build-expression->derivation store "to-check"
 782                                               '(mkdir %output)
 783                                               #:inputs `(("dep" ,dep)))))
 784       (build-derivations store (list drv))
 785       (delete-paths store (list (derivation->output-path dep)))
 786
 787       ;; In 'check' mode, DEP must be rebuilt.
 788       (and (null? (derivation-prerequisites-to-build store drv))
 789            (match (derivation-prerequisites-to-build store drv
 790                                                      #:mode (build-mode
 791                                                              check))
 792              ((input)
 793               (string=? (derivation-input-path input)
 794                         (derivation-file-name dep))))))))
 795
 796 (test-assert "build-expression->derivation with expression returning #f"
 797   (let* ((builder  '(begin
 798                       (mkdir %output)
 799                       #f))                        ; fail!
 800          (drv      (build-expression->derivation %store "fail" builder))
 801          (out-path (derivation->output-path drv)))
 802     (guard (c ((nix-protocol-error? c)
 803                ;; Note that the output path may exist at this point, but it
 804                ;; is invalid.
 805                (and (string-match "build .* failed"
 806                                   (nix-protocol-error-message c))
 807                     (not (valid-path? %store out-path)))))
 808       (build-derivations %store (list drv))
 809       #f)))
 810
 811 (test-assert "build-expression->derivation with two outputs"
 812   (let* ((builder    '(begin
 813                         (call-with-output-file (assoc-ref %outputs "out")
 814                           (lambda (p)
 815                             (display '(hello) p)))
 816                         (call-with-output-file (assoc-ref %outputs "second")
 817                           (lambda (p)
 818                             (display '(world) p)))))
 819          (drv        (build-expression->derivation %store "double" builder
 820                                                    #:outputs '("out"
 821                                                                "second")))
 822          (succeeded? (build-derivations %store (list drv))))
 823     (and succeeded?
 824          (let ((one (derivation->output-path drv))
 825                (two (derivation->output-path drv "second")))
 826            (and (equal? '(hello) (call-with-input-file one read))
 827                 (equal? '(world) (call-with-input-file two read)))))))
 828
 829 (test-skip (if %coreutils 0 1))
 830 (test-assert "build-expression->derivation with one input"
 831   (let* ((builder    '(call-with-output-file %output
 832                         (lambda (p)
 833                           (let ((cu (assoc-ref %build-inputs "cu")))
 834                             (close 1)
 835                             (dup2 (port->fdes p) 1)
 836                             (execl (string-append cu "/bin/uname")
 837                                    "uname" "-a")))))
 838          (drv        (build-expression->derivation %store "uname" builder
 839                                                    #:inputs
 840                                                    `(("cu" ,%coreutils))))
 841          (succeeded? (build-derivations %store (list drv))))
 842     (and succeeded?
 843          (let ((p (derivation->output-path drv)))
 844            (string-contains (call-with-input-file p read-line) "GNU")))))
 845
 846 (test-assert "build-expression->derivation with modules"
 847   (let* ((builder  `(begin
 848                       (use-modules (guix build utils))
 849                       (let ((out (assoc-ref %outputs "out")))
 850                         (mkdir-p (string-append out "/guile/guix/nix"))
 851                         #t)))
 852          (drv      (build-expression->derivation %store "test-with-modules"
 853                                                  builder
 854                                                  #:modules
 855                                                  '((guix build utils)))))
 856     (and (build-derivations %store (list drv))
 857          (let* ((p (derivation->output-path drv))
 858                 (s (stat (string-append p "/guile/guix/nix"))))
 859            (eq? (stat:type s) 'directory)))))
 860
 861 (test-assert "build-expression->derivation: same fixed-output path"
 862   (let* ((builder1   '(call-with-output-file %output
 863                         (lambda (p)
 864                           (write "hello" p))))
 865          (builder2   '(call-with-output-file (pk 'difference-here! %output)
 866                         (lambda (p)
 867                           (write "hello" p))))
 868          (hash       (sha256 (string->utf8 "hello")))
 869          (input1     (build-expression->derivation %store "fixed" builder1
 870                                                    #:hash hash
 871                                                    #:hash-algo 'sha256))
 872          (input2     (build-expression->derivation %store "fixed" builder2
 873                                                    #:hash hash
 874                                                    #:hash-algo 'sha256))
 875          (succeeded? (build-derivations %store (list input1 input2))))
 876     (and succeeded?
 877          (not (string=? (derivation-file-name input1)
 878                         (derivation-file-name input2)))
 879          (string=? (derivation->output-path input1)
 880                    (derivation->output-path input2)))))
 881
 882 (test-assert "build-expression->derivation with a fixed-output input"
 883   (let* ((builder1   '(call-with-output-file %output
 884                         (lambda (p)
 885                           (write "hello" p))))
 886          (builder2   '(call-with-output-file (pk 'difference-here! %output)
 887                         (lambda (p)
 888                           (write "hello" p))))
 889          (hash       (sha256 (string->utf8 "hello")))
 890          (input1     (build-expression->derivation %store "fixed" builder1
 891                                                    #:hash hash
 892                                                    #:hash-algo 'sha256))
 893          (input2     (build-expression->derivation %store "fixed" builder2
 894                                                    #:hash hash
 895                                                    #:hash-algo 'sha256))
 896          (builder3  '(let ((input (assoc-ref %build-inputs "input")))
 897                        (call-with-output-file %output
 898                          (lambda (out)
 899                            (format #f "My input is ~a.~%" input)))))
 900          (final1    (build-expression->derivation %store "final" builder3
 901                                                   #:inputs
 902                                                   `(("input" ,input1))))
 903          (final2    (build-expression->derivation %store "final" builder3
 904                                                   #:inputs
 905                                                   `(("input" ,input2)))))
 906     (and (string=? (derivation->output-path final1)
 907                    (derivation->output-path final2))
 908          (string=? (derivation->output-path final1)
 909                    (derivation-path->output-path
 910                     (derivation-file-name final1)))
 911          (build-derivations %store (list final1 final2)))))
 912
 913 (test-assert "build-expression->derivation produces recursive fixed-output"
 914   (let* ((builder '(begin
 915                      (use-modules (srfi srfi-26))
 916                      (mkdir %output)
 917                      (chdir %output)
 918                      (call-with-output-file "exe"
 919                        (cut display "executable" <>))
 920                      (chmod "exe" #o777)
 921                      (symlink "exe" "symlink")
 922                      (mkdir "subdir")))
 923          (drv     (build-expression->derivation %store "fixed-rec" builder
 924                                                 #:hash-algo 'sha256
 925                                                 #:hash (base32
 926                                                         "10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p")
 927                                                 #:recursive? #t)))
 928     (and (build-derivations %store (list drv))
 929          (let* ((dir    (derivation->output-path drv))
 930                 (exe    (string-append dir "/exe"))
 931                 (link   (string-append dir "/symlink"))
 932                 (subdir (string-append dir "/subdir")))
 933            (and (executable-file? exe)
 934                 (string=? "executable"
 935                           (call-with-input-file exe get-string-all))
 936                 (string=? "exe" (readlink link))
 937                 (file-is-directory? subdir))))))
 938
 939 (test-assert "build-expression->derivation uses recursive fixed-output"
 940   (let* ((builder '(call-with-output-file %output
 941                      (lambda (port)
 942                        (display "hello" port))))
 943          (fixed   (build-expression->derivation %store "small-fixed-rec"
 944                                                 builder
 945                                                 #:hash-algo 'sha256
 946                                                 #:hash (base32
 947                                                         "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
 948                                                 #:recursive? #t))
 949          (in      (derivation->output-path fixed))
 950          (builder `(begin
 951                      (mkdir %output)
 952                      (chdir %output)
 953                      (symlink ,in "symlink")))
 954          (drv     (build-expression->derivation %store "fixed-rec-user"
 955                                                 builder
 956                                                 #:inputs `(("fixed" ,fixed)))))
 957     (and (build-derivations %store (list drv))
 958          (let ((out (derivation->output-path drv)))
 959            (string=? (readlink (string-append out "/symlink")) in)))))
 960
 961 (test-assert "build-expression->derivation with #:references-graphs"
 962   (let* ((input   (add-text-to-store %store "foo" "hello"
 963                                      (list %bash %mkdir)))
 964          (builder '(copy-file "input" %output))
 965          (drv     (build-expression->derivation %store "references-graphs"
 966                                                 builder
 967                                                 #:references-graphs
 968                                                 `(("input" . ,input))))
 969          (out     (derivation->output-path drv)))
 970     (define (deps path . deps)
 971       (let ((count (length deps)))
 972         (string-append path "\n\n" (number->string count) "\n"
 973                        (string-join (sort deps string<?) "\n")
 974                        (if (zero? count) "" "\n"))))
 975
 976     (and (build-derivations %store (list drv))
 977          (equal? (call-with-input-file out get-string-all)
 978                  (string-concatenate
 979                   (map cdr
 980                        (sort (map (lambda (p d)
 981                                     (cons p (apply deps p d)))
 982                                   (list input %bash %mkdir)
 983                                   (list (list %bash %mkdir)
 984                                         '() '()))
 985                              (lambda (x y)
 986                                (match x
 987                                  ((p1 . _)
 988                                   (match y
 989                                     ((p2 . _)
 990                                      (string<? p1 p2)))))))))))))
 991
 992 (test-equal "map-derivation"
 993   "hello"
 994   (let* ((joke (package-derivation %store guile-1.8))
 995          (good (package-derivation %store %bootstrap-guile))
 996          (drv1 (build-expression->derivation %store "original-drv1"
 997                                              #f   ; systematically fail
 998                                              #:guile-for-build joke))
 999          (drv2 (build-expression->derivation %store "original-drv2"
1000                                              '(call-with-output-file %output
1001                                                 (lambda (p)
1002                                                   (display "hello" p)))))
1003          (drv3 (build-expression->derivation %store "drv-to-remap"
1004                                              '(let ((in (assoc-ref
1005                                                          %build-inputs "in")))
1006                                                 (copy-file in %output))
1007                                              #:inputs `(("in" ,drv1))
1008                                              #:guile-for-build joke))
1009          (drv4 (map-derivation %store drv3 `((,drv1 . ,drv2)
1010                                              (,joke . ,good))))
1011          (out  (derivation->output-path drv4)))
1012     (and (build-derivations %store (list (pk 'remapped drv4)))
1013          (call-with-input-file out get-string-all))))
1014
1015 (test-equal "map-derivation, sources"
1016   "hello"
1017   (let* ((script1   (add-text-to-store %store "fail.sh" "exit 1"))
1018          (script2   (add-text-to-store %store "hi.sh" "echo -n hello > $out"))
1019          (bash-full (package-derivation %store (@ (gnu packages bash) bash)))
1020          (drv1      (derivation %store "drv-to-remap"
1021
1022                                 ;; XXX: This wouldn't work in practice, but if
1023                                 ;; we append "/bin/bash" then we can't replace
1024                                 ;; it with the bootstrap bash, which is a
1025                                 ;; single file.
1026                                 (derivation->output-path bash-full)
1027
1028                                 `("-e" ,script1)
1029                                 #:inputs `((,bash-full) (,script1))))
1030          (drv2      (map-derivation %store drv1
1031                                     `((,bash-full . ,%bash)
1032                                       (,script1 . ,script2))))
1033          (out       (derivation->output-path drv2)))
1034     (and (build-derivations %store (list (pk 'remapped* drv2)))
1035          (call-with-input-file out get-string-all))))
1036
1037 (test-end)