test-name: alist-cons-before
location: /home/singpolyma/src/guix/tests/build-utils.scm:37
source:
+ (test-equal
+   "alist-cons-before"
+   '((a . 1) (x . 42) (b . 2) (c . 3))
+   (alist-cons-before
+     'b
+     'x
+     42
+     '((a . 1) (b . 2) (c . 3))))
expected-value: ((a . 1) (x . 42) (b . 2) (c . 3))
actual-value: ((a . 1) (x . 42) (b . 2) (c . 3))
result: PASS

test-name: alist-cons-before, reference not found
location: /home/singpolyma/src/guix/tests/build-utils.scm:41
source:
+ (test-equal
+   "alist-cons-before, reference not found"
+   '((a . 1) (b . 2) (c . 3) (x . 42))
+   (alist-cons-before
+     'z
+     'x
+     42
+     '((a . 1) (b . 2) (c . 3))))
expected-value: ((a . 1) (b . 2) (c . 3) (x . 42))
actual-value: ((a . 1) (b . 2) (c . 3) (x . 42))
result: PASS

test-name: alist-cons-after
location: /home/singpolyma/src/guix/tests/build-utils.scm:45
source:
+ (test-equal
+   "alist-cons-after"
+   '((a . 1) (b . 2) (x . 42) (c . 3))
+   (alist-cons-after
+     'b
+     'x
+     42
+     '((a . 1) (b . 2) (c . 3))))
expected-value: ((a . 1) (b . 2) (x . 42) (c . 3))
actual-value: ((a . 1) (b . 2) (x . 42) (c . 3))
result: PASS

test-name: alist-cons-after, reference not found
location: /home/singpolyma/src/guix/tests/build-utils.scm:49
source:
+ (test-equal
+   "alist-cons-after, reference not found"
+   '((a . 1) (b . 2) (c . 3) (x . 42))
+   (alist-cons-after
+     'z
+     'x
+     42
+     '((a . 1) (b . 2) (c . 3))))
expected-value: ((a . 1) (b . 2) (c . 3) (x . 42))
actual-value: ((a . 1) (b . 2) (c . 3) (x . 42))
result: PASS

test-name: alist-replace
location: /home/singpolyma/src/guix/tests/build-utils.scm:53
source:
+ (test-equal
+   "alist-replace"
+   '((a . 1) (b . 77) (c . 3))
+   (alist-replace 'b 77 '((a . 1) (b . 2) (c . 3))))
expected-value: ((a . 1) (b . 77) (c . 3))
actual-value: ((a . 1) (b . 77) (c . 3))
result: PASS

test-name: alist-replace, key not found
location: /home/singpolyma/src/guix/tests/build-utils.scm:57
source:
+ (test-assert
+   "alist-replace, key not found"
+   (not (false-if-exception
+          (alist-replace 'z 77 '((a . 1) (b . 2) (c . 3))))))
actual-value: #t
result: PASS

test-name: fold-port-matches
location: /home/singpolyma/src/guix/tests/build-utils.scm:61
source:
+ (test-equal
+   "fold-port-matches"
+   (make-list 3 "Guix")
+   (call-with-input-string
+     "Guix is cool, Guix rocks, and it uses Guile, Guix!"
+     (lambda (port)
+       (fold-port-matches cons '() "Guix" port))))
expected-value: ("Guix" "Guix" "Guix")
actual-value: ("Guix" "Guix" "Guix")
result: PASS

test-name: fold-port-matches, trickier
location: /home/singpolyma/src/guix/tests/build-utils.scm:67
source:
+ (test-equal
+   "fold-port-matches, trickier"
+   (reverse '("Guix" "guix" "Guix" "guiX" "Guix"))
+   (call-with-input-string
+     "Guix, guix, GuiGuixguiX, Guix"
+     (lambda (port)
+       (fold-port-matches
+         cons
+         '()
+         (list (char-set #\G #\g)
+               (char-set #\u)
+               (char-set #\i)
+               (char-set #\x #\X))
+         port))))
expected-value: ("Guix" "guiX" "Guix" "guix" "Guix")
actual-value: ("Guix" "guiX" "Guix" "guix" "Guix")
result: PASS

test-name: fold-port-matches, with unmatched chars
location: /home/singpolyma/src/guix/tests/build-utils.scm:78
source:
+ (test-equal
+   "fold-port-matches, with unmatched chars"
+   '("Guix"
+     #\,
+     #\space
+     "guix"
+     #\,
+     #\space
+     #\G
+     #\u
+     #\i
+     "Guix"
+     "guiX"
+     #\,
+     #\space
+     "Guix")
+   (call-with-input-string
+     "Guix, guix, GuiGuixguiX, Guix"
+     (lambda (port)
+       (reverse
+         (fold-port-matches
+           cons
+           '()
+           (list (char-set #\G #\g)
+                 (char-set #\u)
+                 (char-set #\i)
+                 (char-set #\x #\X))
+           port
+           cons)))))
expected-value: ("Guix" #\, #\space "guix" #\, #\space #\G #\u #\i "Guix" "guiX" #\, #\space "Guix")
actual-value: ("Guix" #\, #\space "guix" #\, #\space #\G #\u #\i "Guix" "guiX" #\, #\space "Guix")
result: PASS

substitute: guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
waiting for locks or build slots...
test-name: wrap-program, one input, multiple calls
location: /home/singpolyma/src/guix/tests/build-utils.scm:94
source:
+ (test-equal
+   "wrap-program, one input, multiple calls"
+   "hello world\n"
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let ((bash (search-bootstrap-binary
+                     "bash"
+                     (%current-system)))
+             (foo (string-append directory "/foo")))
+         (call-with-output-file
+           foo
+           (lambda (p)
+             (format
+               p
+               "#!~a~%echo \"${GUIX_FOO} ${GUIX_BAR}\"~%"
+               bash)))
+         (chmod foo 511)
+         (with-environment-variable
+           "PATH"
+           (dirname bash)
+           (wrap-program foo `("GUIX_FOO" prefix ("hello")))
+           (wrap-program foo `("GUIX_BAR" prefix ("world")))
+           (unsetenv "LOCPATH")
+           (let* ((pipe (open-input-pipe foo))
+                  (str (get-string-all pipe)))
+             (with-directory-excursion
+               directory
+               (for-each delete-file '("foo" ".foo-real")))
+             (and (zero? (close-pipe pipe)) str)))))))
expected-value: "hello world\n"
actual-value: #f
actual-error:
+ (system-error
+   "copy-file"
+   "~A: ~S"
+   ("Permission denied"
+    "/home/singpolyma/src/guix/gnu/packages/bootstrap/i686-linux/bash")
+   (13))
result: FAIL

test-name: invoke/quiet, success
location: /home/singpolyma/src/guix/tests/build-utils.scm:128
source:
+ (test-assert
+   "invoke/quiet, success"
+   (begin (invoke/quiet "true") #t))
actual-value: #t
result: PASS

test-name: invoke/quiet, failure
location: /home/singpolyma/src/guix/tests/build-utils.scm:133
source:
+ (test-assert
+   "invoke/quiet, failure"
+   (guard (c ((message-condition? c)
+              (string-contains
+                (condition-message c)
+                "This is an error.")))
+          (invoke/quiet
+            "sh"
+            "-c"
+            "echo This is an error. ; false")
+          #f))
actual-value: 12
result: PASS

test-name: invoke/quiet, failure, message on stderr
location: /home/singpolyma/src/guix/tests/build-utils.scm:139
source:
+ (test-assert
+   "invoke/quiet, failure, message on stderr"
+   (guard (c ((message-condition? c)
+              (string-contains
+                (condition-message c)
+                "This is another error.")))
+          (invoke/quiet
+            "sh"
+            "-c"
+            "echo This is another error. >&2 ; false")
+          #f))
actual-value: 12
result: PASS

test-name: wrap-script, simple case
location: /home/singpolyma/src/guix/tests/build-utils.scm:151
source:
+ (test-equal
+   "wrap-script, simple case"
+   (string-append
+     (format
+       #f
+       "#!~a --no-auto-compile\n#!#; Guix wrapper\n#\\-~s\n#\\-~s\n"
+       (which "guile")
+       '(begin
+          (let ((current (getenv "GUIX_FOO")))
+            (setenv
+              "GUIX_FOO"
+              (if current
+                (string-append
+                  "/some/path:/some/other/path"
+                  ":"
+                  current)
+                "/some/path:/some/other/path"))))
+       '(let ((cl (command-line)))
+          (apply execl
+                 "/anything/cabbage-bash-1.2.3/bin/sh"
+                 (car cl)
+                 (cons (car cl) (append '("") cl)))))
+     script-contents)
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let ((script-file-name
+               (string-append directory "/foo")))
+         (call-with-output-file
+           script-file-name
+           (lambda (port) (display script-contents port)))
+         (chmod script-file-name 511)
+         (wrap-script
+           script-file-name
+           `("GUIX_FOO"
+             prefix
+             ("/some/path" "/some/other/path")))
+         (let ((str (call-with-input-file
+                      script-file-name
+                      get-string-all)))
+           (with-directory-excursion
+             directory
+             (delete-file "foo"))
+           str)))))
expected-value: "#!/home/singpolyma/src/guix/guile --no-auto-compile\n#!#; Guix wrapper\n#\\-(begin (let ((current (getenv \"GUIX_FOO\"))) (setenv \"GUIX_FOO\" (if current (string-append \"/some/path:/some/other/path\" \":\" current) \"/some/path:/some/other/path\"))))\n#\\-(let ((cl (command-line))) (apply execl \"/anything/cabbage-bash-1.2.3/bin/sh\" (car cl) (cons (car cl) (append (quote (\"\")) cl))))\n#!/anything/cabbage-bash-1.2.3/bin/sh\n\necho hello world"
actual-value: "#!/home/singpolyma/src/guix/guile --no-auto-compile\n#!#; Guix wrapper\n#\\-(begin (let ((current (getenv \"GUIX_FOO\"))) (setenv \"GUIX_FOO\" (if current (string-append \"/some/path:/some/other/path\" \":\" current) \"/some/path:/some/other/path\"))))\n#\\-(let ((cl (command-line))) (apply execl \"/anything/cabbage-bash-1.2.3/bin/sh\" (car cl) (cons (car cl) (append (quote (\"\")) cl))))\n#!/anything/cabbage-bash-1.2.3/bin/sh\n\necho hello world"
result: PASS

test-name: wrap-script, with encoding declaration
location: /home/singpolyma/src/guix/tests/build-utils.scm:192
source:
+ (test-equal
+   "wrap-script, with encoding declaration"
+   (string-append
+     (format
+       #f
+       "#!MYGUILE --no-auto-compile\n#!#; # vim:fileencoding=utf-8\n#\\-~s\n#\\-~s\n"
+       '(begin
+          (let ((current (getenv "GUIX_FOO")))
+            (setenv
+              "GUIX_FOO"
+              (if current
+                (string-append
+                  "/some/path:/some/other/path"
+                  ":"
+                  current)
+                "/some/path:/some/other/path"))))
+       `(let ((cl (command-line)))
+          (apply execl
+                 "/anything/cabbage-bash-1.2.3/bin/python3"
+                 (car cl)
+                 (cons (car cl) (append '("" "-and" "-args") cl)))))
+     script-contents)
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let ((script-file-name
+               (string-append directory "/foo")))
+         (call-with-output-file
+           script-file-name
+           (lambda (port) (format port script-contents)))
+         (chmod script-file-name 511)
+         (wrap-script
+           script-file-name
+           #:guile
+           "MYGUILE"
+           `("GUIX_FOO"
+             prefix
+             ("/some/path" "/some/other/path")))
+         (let ((str (call-with-input-file
+                      script-file-name
+                      get-string-all)))
+           (with-directory-excursion
+             directory
+             (delete-file "foo"))
+           str)))))
expected-value: "#!MYGUILE --no-auto-compile\n#!#; # vim:fileencoding=utf-8\n#\\-(begin (let ((current (getenv \"GUIX_FOO\"))) (setenv \"GUIX_FOO\" (if current (string-append \"/some/path:/some/other/path\" \":\" current) \"/some/path:/some/other/path\"))))\n#\\-(let ((cl (command-line))) (apply execl \"/anything/cabbage-bash-1.2.3/bin/python3\" (car cl) (cons (car cl) (append (quote (\"\" \"-and\" \"-args\")) cl))))\n#!/anything/cabbage-bash-1.2.3/bin/python3 -and -args\n# vim:fileencoding=utf-8\nprint('hello world')"
actual-value: "#!MYGUILE --no-auto-compile\n#!#; # vim:fileencoding=utf-8\n#\\-(begin (let ((current (getenv \"GUIX_FOO\"))) (setenv \"GUIX_FOO\" (if current (string-append \"/some/path:/some/other/path\" \":\" current) \"/some/path:/some/other/path\"))))\n#\\-(let ((cl (command-line))) (apply execl \"/anything/cabbage-bash-1.2.3/bin/python3\" (car cl) (cons (car cl) (append (quote (\"\" \"-and\" \"-args\")) cl))))\n#!/anything/cabbage-bash-1.2.3/bin/python3 -and -args\n# vim:fileencoding=utf-8\nprint('hello world')"
result: PASS

test-name: wrap-script, raises condition
location: /home/singpolyma/src/guix/tests/build-utils.scm:229
source:
+ (test-assert
+   "wrap-script, raises condition"
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let ((script-file-name
+               (string-append directory "/foo")))
+         (call-with-output-file
+           script-file-name
+           (lambda (port)
+             (format port "This is not a script")))
+         (chmod script-file-name 511)
+         (guard (c ((wrap-error? c) #t))
+                (wrap-script
+                  script-file-name
+                  #:guile
+                  "MYGUILE"
+                  `("GUIX_FOO"
+                    prefix
+                    ("/some/path" "/some/other/path")))
+                #f)))))
actual-value: #t
result: PASS