all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#25018: GC incorrectly removes the temporary root file of the calling process
@ 2016-11-24 14:07 Ludovic Courtès
  2022-10-07 20:59 ` Maxim Cournoyer
  2022-10-10 17:24 ` bug#25018: Broken test suite Ryan Sundberg via Bug reports for GNU Guix
  0 siblings, 2 replies; 10+ messages in thread
From: Ludovic Courtès @ 2016-11-24 14:07 UTC (permalink / raw)
  To: Eelco Dolstra; +Cc: h.goebel, 25018

[-- Attachment #1: Type: text/plain, Size: 2977 bytes --]

Hello,

The ‘readTempRoots’ function in gc.cc has this:

        /* Try to acquire a write lock without blocking.  This can
           only succeed if the owning process has died.  In that case
           we don't care about its temporary roots. */
        if (lockFile(*fd, ltWrite, false)) {
            printMsg(lvlError, format("removing stale temporary roots file `%1%'") % path);
            unlink(path.c_str());

There’s a thinko here: locking the file also succeeds when the lock is
already held by the calling process.

In that case, this code ends up removing the temporary root file of
calling process, which is bad.  Here’s a sample session:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,use(guix)
scheme@(guile-user)> (define s (open-connection))
scheme@(guile-user)> (current-build-output-port (current-error-port))
$2 = #<output: file /dev/pts/9>
scheme@(guile-user)> (set-build-options s #:verbosity 10)
$3 = #t
scheme@(guile-user)> (add-text-to-store s "foo" "bar!")
acquiring global GC lock `/var/guix/gc.lock'
acquiring read lock on `/var/guix/temproots/4259'
acquiring write lock on `/var/guix/temproots/4259'
downgrading to read lock on `/var/guix/temproots/4259'
locking path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
lock acquired on `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo.lock'
`/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' has hash `c756ef12a70bad10c9ac276ecd1213ea7cc3a2e6c462ba47e4f9a88756a055d0'
lock released on `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo.lock'
$4 = "/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo"
scheme@(guile-user)> (delete-paths s (list $4))
acquiring global GC lock `/var/guix/gc.lock'
finding garbage collector roots...
executing `/gnu/store/l99rkv2713nl53kr3gn4akinvifsx19h-guix-0.11.0-3.7ca3/libexec/guix/list-runtime-roots' to find additional roots
[…]
reading temporary root file `/var/guix/temproots/4259'
removing stale temporary roots file `/var/guix/temproots/4259'
[…]
considering whether to delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
|   invalidating path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
|   deleting `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
|   recursively deleting path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
|   |   /gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo
deleting `/gnu/store/trash'
recursively deleting path `/gnu/store/trash'
|   /gnu/store/trash
deleting unused links...
deleting unused link `/gnu/store/.links/1l2ml1b8ga7rwi3vlqn4wsic6z7a2c9csvi7mk4i1b8blw9fymn7'
note: currently hard linking saves 6699.22 MiB
$5 = ("/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo")
$6 = 4096
--8<---------------cut here---------------end--------------->8---

Notice the “removing stale temporary roots file” message.

Eelco: shouldn’t it be changed along the lines of the attached path?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1179 bytes --]

diff --git a/nix/libstore/gc.cc b/nix/libstore/gc.cc
index 72eff52..d92388f 100644
--- a/nix/libstore/gc.cc
+++ b/nix/libstore/gc.cc
@@ -2,6 +2,7 @@
 #include "misc.hh"
 #include "local-store.hh"
 
+#include <string>
 #include <functional>
 #include <queue>
 #include <algorithm>
@@ -225,10 +226,10 @@ static void readTempRoots(PathSet & tempRoots, FDs & fds)
         //FDPtr fd(new AutoCloseFD(openLockFile(path, false)));
         //if (*fd == -1) continue;
 
-        /* Try to acquire a write lock without blocking.  This can
-           only succeed if the owning process has died.  In that case
-           we don't care about its temporary roots. */
-        if (lockFile(*fd, ltWrite, false)) {
+        /* Try to acquire a write lock without blocking.  This can only
+           succeed if the owning process has died, in which case we don't care
+           about its temporary roots, or if we are the owning process.  */
+        if (i.name != std::to_string(getpid()) && lockFile(*fd, ltWrite, false)) {
             printMsg(lvlError, format("removing stale temporary roots file `%1%'") % path);
             unlink(path.c_str());
             writeFull(*fd, "d");

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2016-11-24 14:07 bug#25018: GC incorrectly removes the temporary root file of the calling process Ludovic Courtès
@ 2022-10-07 20:59 ` Maxim Cournoyer
  2022-10-10  8:01   ` Ludovic Courtès
  2022-10-10 17:24 ` bug#25018: Broken test suite Ryan Sundberg via Bug reports for GNU Guix
  1 sibling, 1 reply; 10+ messages in thread
From: Maxim Cournoyer @ 2022-10-07 20:59 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: h.goebel, Eelco Dolstra, 25018-done

Hi Ludo,

ludo@gnu.org (Ludovic Courtès) writes:

> Hello,
>
> The ‘readTempRoots’ function in gc.cc has this:
>
>         /* Try to acquire a write lock without blocking.  This can
>            only succeed if the owning process has died.  In that case
>            we don't care about its temporary roots. */
>         if (lockFile(*fd, ltWrite, false)) {
>             printMsg(lvlError, format("removing stale temporary roots file `%1%'") % path);
>             unlink(path.c_str());
>
> There’s a thinko here: locking the file also succeeds when the lock is
> already held by the calling process.
>
> In that case, this code ends up removing the temporary root file of
> calling process, which is bad.  Here’s a sample session:
>
> scheme@(guile-user)> ,use(guix)
> scheme@(guile-user)> (define s (open-connection))
> scheme@(guile-user)> (current-build-output-port (current-error-port))
> $2 = #<output: file /dev/pts/9>
> scheme@(guile-user)> (set-build-options s #:verbosity 10)
> $3 = #t
> scheme@(guile-user)> (add-text-to-store s "foo" "bar!")
> acquiring global GC lock `/var/guix/gc.lock'
> acquiring read lock on `/var/guix/temproots/4259'
> acquiring write lock on `/var/guix/temproots/4259'
> downgrading to read lock on `/var/guix/temproots/4259'
> locking path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> lock acquired on `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo.lock'
> `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' has hash `c756ef12a70bad10c9ac276ecd1213ea7cc3a2e6c462ba47e4f9a88756a055d0'
> lock released on `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo.lock'
> $4 = "/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo"
> scheme@(guile-user)> (delete-paths s (list $4))
> acquiring global GC lock `/var/guix/gc.lock'
> finding garbage collector roots...
> executing `/gnu/store/l99rkv2713nl53kr3gn4akinvifsx19h-guix-0.11.0-3.7ca3/libexec/guix/list-runtime-roots' to find additional roots
> […]
> reading temporary root file `/var/guix/temproots/4259'
> removing stale temporary roots file `/var/guix/temproots/4259'
> […]
> considering whether to delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> |   invalidating path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> |   deleting `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> |   recursively deleting path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> |   |   /gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo
> deleting `/gnu/store/trash'
> recursively deleting path `/gnu/store/trash'
> |   /gnu/store/trash
> deleting unused links...
> deleting unused link `/gnu/store/.links/1l2ml1b8ga7rwi3vlqn4wsic6z7a2c9csvi7mk4i1b8blw9fymn7'
> note: currently hard linking saves 6699.22 MiB
> $5 = ("/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo")
> $6 = 4096
>
> Notice the “removing stale temporary roots file” message.
>
> Eelco: shouldn’t it be changed along the lines of the attached path?
>
>
> Thanks,
> Ludo’.
>
> diff --git a/nix/libstore/gc.cc b/nix/libstore/gc.cc
> index 72eff52..d92388f 100644
> --- a/nix/libstore/gc.cc
> +++ b/nix/libstore/gc.cc
> @@ -2,6 +2,7 @@
>  #include "misc.hh"
>  #include "local-store.hh"
>  
> +#include <string>
>  #include <functional>
>  #include <queue>
>  #include <algorithm>
> @@ -225,10 +226,10 @@ static void readTempRoots(PathSet & tempRoots, FDs & fds)
>          //FDPtr fd(new AutoCloseFD(openLockFile(path, false)));
>          //if (*fd == -1) continue;
>  
> -        /* Try to acquire a write lock without blocking.  This can
> -           only succeed if the owning process has died.  In that case
> -           we don't care about its temporary roots. */
> -        if (lockFile(*fd, ltWrite, false)) {
> +        /* Try to acquire a write lock without blocking.  This can only
> +           succeed if the owning process has died, in which case we don't care
> +           about its temporary roots, or if we are the owning process.  */
> +        if (i.name != std::to_string(getpid()) && lockFile(*fd, ltWrite, false)) {
>              printMsg(lvlError, format("removing stale temporary roots file `%1%'") % path);
>              unlink(path.c_str());
>              writeFull(*fd, "d");
>

I'm not Eelco, but your change LGTM.  Note that the upstream version
still uses the original code [0].

I've installed the change, tested that it had the expected result:

--8<---------------cut here---------------start------------->8---
reading temporary root file `/var/guix/temproots/8386'
waiting for read lock on `/var/guix/temproots/8386'
got temporary root `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
considering whether to delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
|   cannot delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' because it's a root
|   cannot delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' because it's still reachable
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
ERROR:
  1. &store-protocol-error:
      message: "cannot delete path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' since it is still alive"
      status: 1
--8<---------------cut here---------------end--------------->8---

and pushed!

Closing.

[0]  https://github.com/NixOS/nix/blob/master/src/libstore/gc.cc#L194

-- 
Thanks,
Maxim




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-07 20:59 ` Maxim Cournoyer
@ 2022-10-10  8:01   ` Ludovic Courtès
  2022-10-10 10:29     ` Maxime Devos
  2022-10-14 20:30     ` Ludovic Courtès
  0 siblings, 2 replies; 10+ messages in thread
From: Ludovic Courtès @ 2022-10-10  8:01 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: h.goebel, Eelco Dolstra, 25018-done

Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> I'm not Eelco, but your change LGTM.  Note that the upstream version
> still uses the original code [0].

Right.

> I've installed the change, tested that it had the expected result:
>
> reading temporary root file `/var/guix/temproots/8386'
> waiting for read lock on `/var/guix/temproots/8386'
> got temporary root `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> considering whether to delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo'
> |   cannot delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' because it's a root
> |   cannot delete `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' because it's still reachable
> ice-9/boot-9.scm:1685:16: In procedure raise-exception:
> ERROR:
>   1. &store-protocol-error:
>       message: "cannot delete path `/gnu/store/0siy93lggjw7sfdg8gsvrzafaa974h2d-foo' since it is still alive"
>       status: 1
>
> and pushed!

Thank you!  (Your bug triage work is much appreciated!)  We could turn
the example here in a unit test; the only downside is that running the
GC in a test is expensive.

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-10  8:01   ` Ludovic Courtès
@ 2022-10-10 10:29     ` Maxime Devos
  2022-10-10 14:53       ` Ludovic Courtès
  2022-10-14 20:30     ` Ludovic Courtès
  1 sibling, 1 reply; 10+ messages in thread
From: Maxime Devos @ 2022-10-10 10:29 UTC (permalink / raw)
  To: Ludovic Courtès, Maxim Cournoyer; +Cc: h.goebel, Eelco Dolstra, 25018-done


[-- Attachment #1.1.1: Type: text/plain, Size: 493 bytes --]



On 10-10-2022 10:01, Ludovic Courtès wrote:
> Hi Maxim,
> 
> [...]
>> and pushed!
> 
> Thank you!  (Your bug triage work is much appreciated!)  We could turn
> the example here in a unit test; the only downside is that running the
> GC in a test is expensive.

It should be possible to run the GC on the test store instead of 
/gnu/store, no?  If that's still too expensive, how about creating an 
additional temporary test store only for the GC test?

Greetings,
Maxime.

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]

^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-10 10:29     ` Maxime Devos
@ 2022-10-10 14:53       ` Ludovic Courtès
  0 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2022-10-10 14:53 UTC (permalink / raw)
  To: Maxime Devos; +Cc: h.goebel, Eelco Dolstra, 25018-done, Maxim Cournoyer

Maxime Devos <maximedevos@telenet.be> skribis:

> On 10-10-2022 10:01, Ludovic Courtès wrote:
>> Hi Maxim,
>> [...]
>>> and pushed!
>> Thank you!  (Your bug triage work is much appreciated!)  We could
>> turn
>> the example here in a unit test; the only downside is that running the
>> GC in a test is expensive.
>
> It should be possible to run the GC on the test store instead of
> /gnu/store, no?

Yes, that’s what I meant and several tests already do this, but it’s
quite expensive.

> If that's still too expensive, how about creating an additional
> temporary test store only for the GC test?

Bah, that sounds complicated to me.

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: Broken test suite
  2016-11-24 14:07 bug#25018: GC incorrectly removes the temporary root file of the calling process Ludovic Courtès
  2022-10-07 20:59 ` Maxim Cournoyer
@ 2022-10-10 17:24 ` Ryan Sundberg via Bug reports for GNU Guix
  1 sibling, 0 replies; 10+ messages in thread
From: Ryan Sundberg via Bug reports for GNU Guix @ 2022-10-10 17:24 UTC (permalink / raw)
  To: 25018


[-- Attachment #1.1.1: Type: text/plain, Size: 305 bytes --]

Hello, this patch seems to have broken the test suite in
tests/store.scm. My test log file is attached.

    ./test-env make check TESTS=tests/store.scm

Cuirass did not detect the changes since they are at such a low level:
(https://ci.guix.gnu.org/eval/700414)



--
Sincerely,
Ryan Sundberg

[-- Attachment #1.1.2: test-suite.log --]
[-- Type: text/x-log, Size: 104049 bytes --]

========================================================
   GNU Guix 1.3.0.23687-73808-dirty: ./test-suite.log
========================================================

# TOTAL: 75
# PASS:  71
# SKIP:  0
# XFAIL: 0
# FAIL:  4
# XPASS: 0
# ERROR: 0

.. contents:: :depth: 2

FAIL: tests/store
=================

test-name: open-connection with file:// URI
location: /home/sundbry/guix/tests/store.scm:58
source:
+ (test-assert
+   "open-connection with file:// URI"
+   (let ((store (open-connection
+                  (string-append "file://" (%daemon-socket-uri)))))
+     (and (add-text-to-store store "foo" "bar")
+          (begin (close-connection store) #t))))
actual-value: #t
result: PASS

test-name: connection handshake error
location: /home/sundbry/guix/tests/store.scm:66
source:
+ (test-equal
+   "connection handshake error"
+   EPROTO
+   (let ((port (%make-void-port "rw")))
+     (guard (c ((store-connection-error? c)
+                (and (eq? port (store-connection-error-file c))
+                     (store-connection-error-code c))))
+            (open-connection #f #:port port)
+            'broken)))
expected-value: 71
actual-value: 71
result: PASS

test-name: store-path-hash-part
location: /home/sundbry/guix/tests/store.scm:75
source:
+ (test-equal
+   "store-path-hash-part"
+   "283gqy39v3g9dxjy26rynl0zls82fmcg"
+   (store-path-hash-part
+     (string-append
+       (%store-prefix)
+       "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
expected-value: "283gqy39v3g9dxjy26rynl0zls82fmcg"
actual-value: "283gqy39v3g9dxjy26rynl0zls82fmcg"
result: PASS

test-name: store-path-hash-part #f
location: /home/sundbry/guix/tests/store.scm:81
source:
+ (test-equal
+   "store-path-hash-part #f"
+   #f
+   (store-path-hash-part
+     (string-append
+       (%store-prefix)
+       "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
expected-value: #f
actual-value: #f
result: PASS

test-name: store-path-package-name
location: /home/sundbry/guix/tests/store.scm:87
source:
+ (test-equal
+   "store-path-package-name"
+   "guile-2.0.7"
+   (store-path-package-name
+     (string-append
+       (%store-prefix)
+       "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
expected-value: "guile-2.0.7"
actual-value: "guile-2.0.7"
result: PASS

test-name: store-path-package-name #f
location: /home/sundbry/guix/tests/store.scm:93
source:
+ (test-equal
+   "store-path-package-name #f"
+   #f
+   (store-path-package-name
+     "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
expected-value: #f
actual-value: #f
actual-error:
+ (wrong-type-arg
+   "substring"
+   "Wrong type argument in position ~A (expecting ~A): ~S"
+   (1 "string" #f)
+   (#f))
result: PASS

test-name: direct-store-path?
location: /home/sundbry/guix/tests/store.scm:98
source:
+ (test-assert
+   "direct-store-path?"
+   (and (direct-store-path?
+          (string-append
+            (%store-prefix)
+            "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))
+        (not (direct-store-path?
+               (string-append
+                 (%store-prefix)
+                 "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))
+        (not (direct-store-path? (%store-prefix)))))
actual-value: #t
result: PASS

test-name: profiles/per-user exists and is not writable
location: /home/sundbry/guix/tests/store.scm:110
source:
+ (test-equal
+   "profiles/per-user exists and is not writable"
+   493
+   (stat:perms
+     (stat (string-append
+             %state-directory
+             "/profiles/per-user"))))
expected-value: 493
actual-value: 493
result: PASS

test-name: profiles/per-user/$USER exists
location: /home/sundbry/guix/tests/store.scm:114
source:
+ (test-equal
+   "profiles/per-user/$USER exists"
+   (list (getuid) 493)
+   (let ((s (stat (string-append
+                    %state-directory
+                    "/profiles/per-user/"
+                    (passwd:name (getpwuid (getuid)))))))
+     (list (stat:uid s) (stat:perms s))))
expected-value: (1000 493)
actual-value: (1000 493)
result: PASS

test-name: add-to-store
location: /home/sundbry/guix/tests/store.scm:120
source:
+ (test-equal
+   "add-to-store"
+   '("sha1"
+     "sha256"
+     "sha512"
+     "sha3-256"
+     "sha3-512"
+     "blake2s-256")
+   (let* ((file (search-path %load-path "guix.scm"))
+          (content
+            (call-with-input-file file get-bytevector-all)))
+     (map (lambda (hash-algo)
+            (let ((file (add-to-store
+                          %store
+                          "guix.scm"
+                          #f
+                          hash-algo
+                          file)))
+              (and (direct-store-path? file)
+                   (bytevector=?
+                     (call-with-input-file file get-bytevector-all)
+                     content)
+                   hash-algo)))
+          '("sha1"
+            "sha256"
+            "sha512"
+            "sha3-256"
+            "sha3-512"
+            "blake2s-256"))))
expected-value: ("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256")
actual-value: ("sha1" "sha256" "sha512" "sha3-256" "sha3-512" "blake2s-256")
result: PASS

test-name: add-data-to-store
location: /home/sundbry/guix/tests/store.scm:132
source:
+ (test-equal
+   "add-data-to-store"
+   #vu8(1 2 3 4 5)
+   (call-with-input-file
+     (add-data-to-store %store "data" #vu8(1 2 3 4 5))
+     get-bytevector-all))
expected-value: #vu8(1 2 3 4 5)
actual-value: #vu8(1 2 3 4 5)
result: PASS

test-name: valid-path? live
location: /home/sundbry/guix/tests/store.scm:137
source:
+ (test-assert
+   "valid-path? live"
+   (let ((p (add-text-to-store %store "hello" "hello, world")))
+     (valid-path? %store p)))
actual-value: #t
result: PASS

test-name: valid-path? false
location: /home/sundbry/guix/tests/store.scm:141
source:
+ (test-assert
+   "valid-path? false"
+   (not (valid-path?
+          %store
+          (string-append
+            (%store-prefix)
+            "/"
+            (make-string 32 #\e)
+            "-foobar"))))
actual-value: #t
result: PASS

test-name: with-store, multiple values
location: /home/sundbry/guix/tests/store.scm:146
source:
+ (test-equal
+   "with-store, multiple values"
+   '(1 2 3)
+   (call-with-values
+     (lambda ()
+       (with-store
+         s
+         (add-text-to-store s "foo" "bar")
+         (values 1 2 3)))
+     list))
expected-value: (1 2 3)
actual-value: (1 2 3)
result: PASS

test-name: valid-path? error
location: /home/sundbry/guix/tests/store.scm:155
source:
+ (test-assert
+   "valid-path? error"
+   (with-store
+     s
+     (guard (c ((store-protocol-error? c) #t))
+            (valid-path? s "foo")
+            #f)))
actual-value: #t
result: PASS

test-name: valid-path? recovery
location: /home/sundbry/guix/tests/store.scm:161
source:
+ (test-assert
+   "valid-path? recovery"
+   (with-store
+     s
+     (let-syntax ((true-if-error
+                    (syntax-rules ()
+                      ((_ exp)
+                       (guard (c ((store-protocol-error? c) #t)) exp #f)))))
+       (and (true-if-error (valid-path? s "foo"))
+            (true-if-error (valid-path? s "bar"))
+            (true-if-error (valid-path? s "baz"))
+            (true-if-error (valid-path? s "chbouib"))
+            (valid-path?
+              s
+              (add-text-to-store s "valid" "yeah"))))))
actual-value: #t
result: PASS

test-name: hash-part->path
location: /home/sundbry/guix/tests/store.scm:178
source:
+ (test-assert
+   "hash-part->path"
+   (let ((p (add-text-to-store %store "hello" "hello, world")))
+     (equal?
+       (hash-part->path %store (store-path-hash-part p))
+       p)))
actual-value: #t
result: PASS

random seed for tests: 1665417557
finding garbage collector roots...
determining live/dead paths...
test-name: dead-paths
location: /home/sundbry/guix/tests/store.scm:183
source:
+ (test-assert
+   "dead-paths"
+   (let ((p (add-text-to-store
+              %store
+              "random-text"
+              (random-text))))
+     (->bool (member p (dead-paths %store)))))
actual-value: #f
result: FAIL

test-name: add-indirect-root and find-roots
location: /home/sundbry/guix/tests/store.scm:204
source:
+ (test-assert
+   "add-indirect-root and find-roots"
+   (call-with-temporary-directory
+     (lambda (directory)
+       (let* ((item (add-text-to-store
+                      %store
+                      "something"
+                      (random-text)))
+              (root (string-append directory "/gc-root")))
+         (symlink item root)
+         (add-indirect-root %store root)
+         (let ((result
+                 (member (cons root item) (find-roots %store))))
+           (delete-file root)
+           result)))))
actual-value: (("/tmp/guix-directory.5hzlcZ/gc-root" . "/home/sundbry/guix/test-tmp/store/g5h4s4f1qadic4ad50q3z47cj37971q0-something"))
result: PASS

finding garbage collector roots...
determining live/dead paths...
finding garbage collector roots...
determining live/dead paths...
test-name: permanent root
location: /home/sundbry/guix/tests/store.scm:215
source:
+ (test-assert
+   "permanent root"
+   (let* ((p (with-store
+               store
+               (let ((p (add-text-to-store
+                          store
+                          "random-text"
+                          (random-text))))
+                 (add-permanent-root p)
+                 (add-permanent-root p)
+                 p))))
+     (and (member p (live-paths %store))
+          (begin
+            (remove-permanent-root p)
+            (->bool (member p (dead-paths %store)))))))
actual-value: #t
result: PASS

finding garbage collector roots...
test-name: dead path can be explicitly collected
location: /home/sundbry/guix/tests/store.scm:227
source:
+ (test-assert
+   "dead path can be explicitly collected"
+   (let ((p (add-text-to-store
+              %store
+              "random-text"
+              (random-text)
+              '())))
+     (let-values
+       (((paths freed) (delete-paths %store (list p))))
+       (and (equal? paths (list p))
+            (not (file-exists? p))))))
actual-value: #f
actual-error:
+ (%exception
+   #<&store-protocol-error message: "cannot delete path `/home/sundbry/guix/test-tmp/store/bkj20znv3pjxm2mq051biwnbpkpags5l-random-text' since it is still alive" status: 1>)
result: FAIL

finding garbage collector roots...
removing stale temporary roots file `/home/sundbry/guix/test-tmp/var/4806/temproots/4842'
test-name: add-text-to-store/add-to-store vs. delete-paths
location: /home/sundbry/guix/tests/store.scm:237
source:
+ (test-assert
+   "add-text-to-store/add-to-store vs. delete-paths"
+   (with-store
+     store
+     (let* ((text (random-text))
+            (file (search-path %load-path "guix.scm"))
+            (path1 (add-text-to-store store "delete-me" text))
+            (path2 (add-to-store store "delete-me" #t "sha256" file))
+            (deleted (delete-paths store (list path1 path2))))
+       (and (string=?
+              path1
+              (add-text-to-store store "delete-me" text))
+            (string=?
+              path2
+              (add-to-store store "delete-me" #t "sha256" file))
+            (lset= string=? deleted (list path1 path2))
+            (valid-path? store path1)
+            (valid-path? store path2)
+            (file-exists? path1)
+            (file-exists? path2)))))
actual-value: #f
actual-error:
+ (%exception
+   #<&store-protocol-error message: "cannot delete path `/home/sundbry/guix/test-tmp/store/3ci4lpnw6kfw50ywghbm78fq9lrfv473-delete-me' since it is still alive" status: 1>)
result: FAIL

test-name: add-file-tree-to-store
location: /home/sundbry/guix/tests/store.scm:254
source:
+ (test-equal
+   "add-file-tree-to-store"
+   `(42
+     ("." directory #t)
+     ("./bar" directory #t)
+     ("./foo" directory #t)
+     ("./foo/a" regular "file a")
+     ("./foo/b" symlink "a")
+     ("./foo/c" directory #t)
+     ("./foo/c/p" regular "file p")
+     ("./foo/c/q" directory #t)
+     ("./foo/c/q/x"
+      regular
+      ,(string-append "#!" %shell "\nexit 42"))
+     ("./foo/c/q/y" symlink "..")
+     ("./foo/c/q/z" directory #t))
+   (let* ((tree `("file-tree"
+                  directory
+                  ("foo"
+                   directory
+                   ("a" regular (data "file a"))
+                   ("b" symlink "a")
+                   ("c"
+                    directory
+                    ("p" regular (data ,(string->utf8 "file p")))
+                    ("q"
+                     directory
+                     ("x"
+                      executable
+                      (data ,(string-append "#!" %shell "\nexit 42")))
+                     ("y" symlink "..")
+                     ("z" directory))))
+                  ("bar" directory)))
+          (result (add-file-tree-to-store %store tree)))
+     (cons (status:exit-val
+             (system* (string-append result "/foo/c/q/x")))
+           (with-directory-excursion
+             result
+             (map (lambda (file)
+                    (let ((type (stat:type (lstat file))))
+                      `(,file
+                        ,type
+                        ,(match type
+                                ((or 'regular 'executable)
+                                 (call-with-input-file file get-string-all))
+                                ('symlink (readlink file))
+                                ('directory #t)))))
+                  (find-files "." #:directories? #t))))))
expected-value: (42 ("." directory #t) ("./bar" directory #t) ("./foo" directory #t) ("./foo/a" regular "file a") ("./foo/b" symlink "a") ("./foo/c" directory #t) ("./foo/c/p" regular "file p") ("./foo/c/q" directory #t) ("./foo/c/q/x" regular "#!/bin/sh\nexit 42") ("./foo/c/q/y" symlink "..") ("./foo/c/q/z" directory #t))
actual-value: (42 ("." directory #t) ("./bar" directory #t) ("./foo" directory #t) ("./foo/a" regular "file a") ("./foo/b" symlink "a") ("./foo/c" directory #t) ("./foo/c/p" regular "file p") ("./foo/c/q" directory #t) ("./foo/c/q/x" regular "#!/bin/sh\nexit 42") ("./foo/c/q/y" symlink "..") ("./foo/c/q/z" directory #t))
result: PASS

test-name: add-file-tree-to-store, flat
location: /home/sundbry/guix/tests/store.scm:294
source:
+ (test-equal
+   "add-file-tree-to-store, flat"
+   "Hello, world!"
+   (let* ((tree `("flat-file" regular (data "Hello, world!")))
+          (result (add-file-tree-to-store %store tree)))
+     (and (file-exists? result)
+          (call-with-input-file result get-string-all))))
expected-value: "Hello, world!"
actual-value: "Hello, world!"
result: PASS

test-name: references
location: /home/sundbry/guix/tests/store.scm:301
source:
+ (test-assert
+   "references"
+   (let* ((t1 (add-text-to-store
+                %store
+                "random1"
+                (random-text)))
+          (t2 (add-text-to-store
+                %store
+                "random2"
+                (random-text)
+                (list t1))))
+     (and (equal? (list t1) (references %store t2))
+          (equal? (list t2) (referrers %store t1))
+          (null? (references %store t1))
+          (null? (referrers %store t2)))))
actual-value: #t
result: PASS

test-name: substitutable-path-info when substitutes are turned off
location: /home/sundbry/guix/tests/store.scm:311
source:
+ (test-equal
+   "substitutable-path-info when substitutes are turned off"
+   '()
+   (with-store
+     s
+     (set-build-options s #:use-substitutes? #f)
+     (let* ((b (add-to-store
+                 s
+                 "bash"
+                 #t
+                 "sha256"
+                 (search-bootstrap-binary
+                   "bash"
+                   (%current-system))))
+            (d (derivation
+                 s
+                 "the-thing"
+                 b
+                 '("--version")
+                 #:inputs
+                 `((,b))))
+            (o (derivation->output-path d)))
+       (with-derivation-narinfo
+         d
+         (substitutable-path-info s (list o))))))
expected-value: ()
actual-value: ()
result: PASS

test-name: substitutable-paths when substitutes are turned off
location: /home/sundbry/guix/tests/store.scm:324
source:
+ (test-equal
+   "substitutable-paths when substitutes are turned off"
+   '()
+   (with-store
+     s
+     (set-build-options s #:use-substitutes? #f)
+     (let* ((b (add-to-store
+                 s
+                 "bash"
+                 #t
+                 "sha256"
+                 (search-bootstrap-binary
+                   "bash"
+                   (%current-system))))
+            (d (derivation
+                 s
+                 "the-thing"
+                 b
+                 '("--version")
+                 #:inputs
+                 `((,b))))
+            (o (derivation->output-path d)))
+       (with-derivation-narinfo
+         d
+         (substitutable-paths s (list o))))))
expected-value: ()
actual-value: ()
result: PASS

test-name: requisites
location: /home/sundbry/guix/tests/store.scm:337
source:
+ (test-assert
+   "requisites"
+   (let* ((t1 (add-text-to-store
+                %store
+                "random1"
+                (random-text)
+                '()))
+          (t2 (add-text-to-store
+                %store
+                "random2"
+                (random-text)
+                (list t1)))
+          (t3 (add-text-to-store
+                %store
+                "random3"
+                (random-text)
+                (list t2)))
+          (t4 (add-text-to-store
+                %store
+                "random4"
+                (random-text)
+                (list t1 t3))))
+     (define (same? x y)
+       (and (= (length x) (length y))
+            (lset= equal? x y)))
+     (and (same? (requisites %store (list t1)) (list t1))
+          (same? (requisites %store (list t2))
+                 (list t1 t2))
+          (same? (requisites %store (list t3))
+                 (list t1 t2 t3))
+          (same? (requisites %store (list t4))
+                 (list t1 t2 t3 t4))
+          (same? (requisites %store (list t1 t2 t3 t4))
+                 (list t1 t2 t3 t4)))))
actual-value: #t
result: PASS

warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
@ build-started /home/sundbry/guix/test-tmp/store/7xa272r36873b0cl7n4bg0kw9accap1h-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/7x//a272r36873b0cl7n4bg0kw9accap1h-the-thing.drv.gz 4971
@ build-succeeded /home/sundbry/guix/test-tmp/store/7xa272r36873b0cl7n4bg0kw9accap1h-the-thing.drv -
test-name: derivers
location: /home/sundbry/guix/tests/store.scm:357
source:
+ (test-assert
+   "derivers"
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d (derivation
+               %store
+               "the-thing"
+               s
+               `("-e" ,b)
+               #:env-vars
+               `(("foo" unquote (random-text)))
+               #:inputs
+               `((,b) (,s))))
+          (o (derivation->output-path d)))
+     (and (build-derivations %store (list d))
+          (equal?
+            (query-derivation-outputs
+              %store
+              (derivation-file-name d))
+            (list o))
+          (equal?
+            (valid-derivers %store o)
+            (list (derivation-file-name d))))))
actual-value: #t
result: PASS

@ build-started /home/sundbry/guix/test-tmp/store/fln8hcl5c29m4j9y8b9mv5271ynilmym-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/fl//n8hcl5c29m4j9y8b9mv5271ynilmym-the-thing.drv.gz 4991
@ build-succeeded /home/sundbry/guix/test-tmp/store/fln8hcl5c29m4j9y8b9mv5271ynilmym-the-thing.drv -
test-name: with-build-handler
location: /home/sundbry/guix/tests/store.scm:373
source:
+ (test-equal
+   "with-build-handler"
+   'success
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d1 (derivation
+                %store
+                "the-thing"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)))
+                #:sources
+                (list b s)))
+          (d2 (derivation
+                %store
+                "the-thing"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)) ("bar" . "baz"))
+                #:sources
+                (list b s)))
+          (o1 (derivation->output-path d1))
+          (o2 (derivation->output-path d2)))
+     (with-build-handler
+       (let ((counter 0))
+         (lambda (continue store things mode)
+           (match things
+                  ((drv)
+                   (set! counter (+ 1 counter))
+                   (if (string=? drv (derivation-file-name d1))
+                     (continue #t)
+                     (and (string=? drv (derivation-file-name d2))
+                          (= counter 2)
+                          'success))))))
+       (build-derivations %store (list d1))
+       (build-derivations %store (list d2))
+       'fail)))
expected-value: success
actual-value: success
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!
building path(s) `/home/sundbry/guix/test-tmp/store/qvn0ivznh66pgy1n14wq4s2kfcmklh36-thingie'
test-name: with-build-handler + with-store
location: /home/sundbry/guix/tests/store.scm:405
source:
+ (test-equal
+   "with-build-handler + with-store"
+   'success
+   (with-build-handler
+     (lambda (continue store things mode)
+       (match things
+              ((drv)
+               (and (string-suffix? "thingie.drv" drv)
+                    (not (port-closed? (store-connection-socket store)))
+                    (continue #t)))))
+     (with-store
+       store
+       (let* ((b (add-text-to-store
+                   store
+                   "build"
+                   "echo $foo > $out"
+                   '()))
+              (s (add-to-store
+                   store
+                   "bash"
+                   #t
+                   "sha256"
+                   (search-bootstrap-binary
+                     "bash"
+                     (%current-system))))
+              (d (derivation
+                   store
+                   "thingie"
+                   s
+                   `("-e" ,b)
+                   #:env-vars
+                   `(("foo" unquote (random-text)))
+                   #:sources
+                   (list b s))))
+         (build-derivations store (list d))
+         (and (valid-path? store (derivation->output-path d))
+              'success)))))
expected-value: success
actual-value: success
result: PASS

test-name: map/accumulate-builds
location: /home/sundbry/guix/tests/store.scm:432
source:
+ (test-assert
+   "map/accumulate-builds"
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d1 (derivation
+                %store
+                "the-thing"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)))
+                #:sources
+                (list b s)))
+          (d2 (derivation
+                %store
+                "the-thing"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)) ("bar" . "baz"))
+                #:sources
+                (list b s))))
+     (with-build-handler
+       (lambda (continue store things mode)
+         (equal?
+           (map derivation-file-name (list d1 d2))
+           things))
+       (map/accumulate-builds
+         %store
+         (lambda (drv)
+           (build-derivations %store (list drv))
+           (add-to-store
+             %store
+             "content-addressed"
+             #t
+             "sha256"
+             (derivation->output-path drv)))
+         (list d1 d2)))))
actual-value: #t
result: PASS

test-name: map/accumulate-builds cutoff
location: /home/sundbry/guix/tests/store.scm:457
source:
+ (test-equal
+   "map/accumulate-builds cutoff"
+   (iota 20)
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d (map (lambda (i)
+                    (derivation
+                      %store
+                      (string-append "the-thing-" (number->string i))
+                      s
+                      `("-e" ,b)
+                      #:env-vars
+                      `(("foo" unquote (random-text)))
+                      #:sources
+                      (list b s)
+                      #:properties
+                      `((n unquote i))))
+                  (iota 20)))
+          (calls '()))
+     (define lst
+       (with-build-handler
+         (lambda (continue store things mode)
+           (set! calls (cons things calls))
+           (continue #f))
+         (map/accumulate-builds
+           %store
+           (lambda (d)
+             (build-derivations %store (list d))
+             (assq-ref (derivation-properties d) 'n))
+           d
+           #:cutoff
+           7)))
+     (match (reverse calls)
+            (((batch1 ...) (batch2 ...) (batch3 ...))
+             (and (equal?
+                    (map derivation-file-name (take d 8))
+                    batch1)
+                  (equal?
+                    (map derivation-file-name (take (drop d 8) 8))
+                    batch2)
+                  (equal?
+                    (map derivation-file-name (drop d 16))
+                    batch3)
+                  lst)))))
expected-value: (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
actual-value: (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
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!
building path(s) `/home/sundbry/guix/test-tmp/store/g8wvvb6rr765wwidkmn7csvnw86fzcyh-second'
test-name: map/accumulate-builds and different store
location: /home/sundbry/guix/tests/store.scm:493
source:
+ (test-equal
+   "map/accumulate-builds and different store"
+   '(d2)
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d1 (derivation
+                %store
+                "first"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)))
+                #:sources
+                (list b s)))
+          (d2 (derivation
+                %store
+                "second"
+                s
+                `("-e" ,b)
+                #:env-vars
+                `(("foo" unquote (random-text)) ("bar" . "baz"))
+                #:sources
+                (list b s))))
+     (with-store
+       alternate-store
+       (with-build-handler
+         (lambda (continue store things mode) 'failed)
+         (map/accumulate-builds
+           %store
+           (lambda (drv)
+             (build-derivations alternate-store (list d2))
+             'd2)
+           (list d1))))))
expected-value: (d2)
actual-value: (d2)
result: PASS


;;; (zz (#<derivation /home/sundbry/guix/test-tmp/store/xdcyi198r37rx4pibhg9vkzyj51ipvyn-foo.drv => /home/sundbry/guix/test-tmp/store/12wqlnh7rnvjxswig6jk91rlrbp8cjdm-foo 7fdf9e5ac640> #<derivation /home/sundbry/guix/test-tmp/store/b2ylhlixngmpp76jy3hyzs8mqa47zpqp-bar.drv => /home/sundbry/guix/test-tmp/store/xkcs3kwwb2mkq7iypl8hb22s0jf0nxzs-bar 7fdf9e5ac460>))

;;; (XX ("/home/sundbry/guix/test-tmp/store/xdcyi198r37rx4pibhg9vkzyj51ipvyn-foo.drv" "/home/sundbry/guix/test-tmp/store/b2ylhlixngmpp76jy3hyzs8mqa47zpqp-bar.drv"))
test-name: mapm/accumulate-builds
location: /home/sundbry/guix/tests/store.scm:521
source:
+ (test-assert
+   "mapm/accumulate-builds"
+   (let* ((d1 (run-with-store
+                %store
+                (gexp->derivation
+                  "foo"
+                  (gexp (mkdir (ungexp output))))))
+          (d2 (run-with-store
+                %store
+                (gexp->derivation
+                  "bar"
+                  (gexp (mkdir (ungexp output)))))))
+     (with-build-handler
+       (lambda (continue store things mode)
+         (equal?
+           (map derivation-file-name (pk 'zz (list d1 d2)))
+           (pk 'XX things)))
+       (run-with-store
+         %store
+         (mapm/accumulate-builds
+           built-derivations
+           `((,d1) (,d2)))))))
actual-value: #t
result: PASS

test-name: mapm/accumulate-builds, %current-target-system
location: /home/sundbry/guix/tests/store.scm:532
source:
+ (test-equal
+   "mapm/accumulate-builds, %current-target-system"
+   (make-list 2 '("i586-pc-gnu" "i586-pc-gnu"))
+   (run-with-store
+     %store
+     (mlet %store-monad
+           ((lst1 (mapm %store-monad
+                        (lambda _ (current-target-system))
+                        '(a b)))
+            (lst2 (mapm/accumulate-builds
+                    (lambda _ (current-target-system))
+                    '(a b))))
+           (return (list lst1 lst2)))
+     #:system
+     system
+     #:target
+     "i586-pc-gnu"))
expected-value: (("i586-pc-gnu" "i586-pc-gnu") ("i586-pc-gnu" "i586-pc-gnu"))
actual-value: (("i586-pc-gnu" "i586-pc-gnu") ("i586-pc-gnu" "i586-pc-gnu"))
result: PASS

test-name: topologically-sorted, one item
location: /home/sundbry/guix/tests/store.scm:549
source:
+ (test-assert
+   "topologically-sorted, one item"
+   (let* ((a (add-text-to-store %store "a" "a"))
+          (b (add-text-to-store %store "b" "b" (list a)))
+          (c (add-text-to-store %store "c" "c" (list b)))
+          (d (add-text-to-store %store "d" "d" (list c)))
+          (s (topologically-sorted %store (list d))))
+     (equal? s (list a b c d))))
actual-value: #t
result: PASS

test-name: topologically-sorted, several items
location: /home/sundbry/guix/tests/store.scm:557
source:
+ (test-assert
+   "topologically-sorted, several items"
+   (let* ((a (add-text-to-store %store "a" "a"))
+          (b (add-text-to-store %store "b" "b" (list a)))
+          (c (add-text-to-store %store "c" "c" (list b)))
+          (d (add-text-to-store %store "d" "d" (list c)))
+          (s1 (topologically-sorted %store (list d a c b)))
+          (s2 (topologically-sorted %store (list b d c a b d))))
+     (equal? s1 s2 (list a b c d))))
actual-value: #t
result: PASS

test-name: topologically-sorted, more difficult
location: /home/sundbry/guix/tests/store.scm:566
source:
+ (test-assert
+   "topologically-sorted, more difficult"
+   (let* ((a (add-text-to-store %store "a" "a"))
+          (b (add-text-to-store %store "b" "b" (list a)))
+          (c (add-text-to-store %store "c" "c" (list b)))
+          (d (add-text-to-store %store "d" "d" (list c)))
+          (w (add-text-to-store %store "w" "w"))
+          (x (add-text-to-store %store "x" "x" (list w)))
+          (y (add-text-to-store %store "y" "y" (list x d)))
+          (s1 (topologically-sorted %store (list y)))
+          (s2 (topologically-sorted %store (list c y)))
+          (s3 (topologically-sorted
+                %store
+                (cons y (references %store y)))))
+     (let* ((x-then-d?
+              (equal? (references %store y) (list x d))))
+       (and (equal?
+              s1
+              (if x-then-d?
+                (list w x a b c d y)
+                (list a b c d w x y)))
+            (equal?
+              s2
+              (if x-then-d?
+                (list a b c w x d y)
+                (list a b c d w x y)))
+            (lset= string=? s1 s3)))))
actual-value: #t
result: PASS

test-name: current-build-output-port, UTF-8
location: /home/sundbry/guix/tests/store.scm:590
source:
+ (test-assert
+   "current-build-output-port, UTF-8"
+   (string-contains
+     (with-fluids
+       ((%default-port-encoding "UTF-8"))
+       (call-with-output-string
+         (lambda (port)
+           (parameterize
+             ((current-build-output-port port))
+             (let* ((s "Here?s a Greek letter: ?.")
+                    (d (build-expression->derivation
+                         %store
+                         "foo"
+                         `(display ,s)
+                         #:guile-for-build
+                         (package-derivation
+                           %store
+                           %bootstrap-guile
+                           (%current-system)))))
+               (guard (c ((store-protocol-error? c) #t))
+                      (build-derivations %store (list d))))))))
+     "Here?s a Greek letter: ?."))
actual-value: 203
result: PASS

test-name: current-build-output-port, UTF-8 + garbage
location: /home/sundbry/guix/tests/store.scm:607
source:
+ (test-assert
+   "current-build-output-port, UTF-8 + garbage"
+   (string-contains
+     (with-fluids
+       ((%default-port-encoding "UTF-8"))
+       (call-with-output-string
+         (lambda (port)
+           (parameterize
+             ((current-build-output-port port))
+             (let ((d (build-expression->derivation
+                        %store
+                        "foo"
+                        `(begin
+                           (use-modules (rnrs io ports))
+                           (display "garbage: ")
+                           (put-bytevector (current-output-port) #vu8(128))
+                           (display "lambda: ?\n"))
+                        #:guile-for-build
+                        (package-derivation %store %bootstrap-guile))))
+               (guard (c ((store-protocol-error? c) #t))
+                      (build-derivations %store (list d))))))))
+     "garbage: ?lambda: ?"))
actual-value: 203
result: PASS

/home/sundbry/guix/tests/store.scm:598:20: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
/home/sundbry/guix/tests/store.scm:614:19: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
@ build-started /home/sundbry/guix/test-tmp/store/mshldz5q22c4ylc1zmbsijxryzlcfpgf-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/ms//hldz5q22c4ylc1zmbsijxryzlcfpgf-the-thing.drv.gz 5125
@ build-succeeded /home/sundbry/guix/test-tmp/store/mshldz5q22c4ylc1zmbsijxryzlcfpgf-the-thing.drv -

;;; ("/home/sundbry/guix/test-tmp/var/log/guix/drvs/ms/hldz5q22c4ylc1zmbsijxryzlcfpgf-the-thing.drv.gz")
test-name: log-file, derivation
location: /home/sundbry/guix/tests/store.scm:627
source:
+ (test-assert
+   "log-file, derivation"
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d (derivation
+               %store
+               "the-thing"
+               s
+               `("-e" ,b)
+               #:env-vars
+               `(("foo" unquote (random-text)))
+               #:inputs
+               `((,b) (,s)))))
+     (and (build-derivations %store (list d))
+          (file-exists?
+            (pk (log-file %store (derivation-file-name d)))))))
actual-value: #t
result: PASS

warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
@ build-started /home/sundbry/guix/test-tmp/store/9lg85nbk0y8mgdzlqa1wng2j5n6q4cvg-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/9l//g85nbk0y8mgdzlqa1wng2j5n6q4cvg-the-thing.drv.gz 5144
@ build-succeeded /home/sundbry/guix/test-tmp/store/9lg85nbk0y8mgdzlqa1wng2j5n6q4cvg-the-thing.drv -

;;; ("/home/sundbry/guix/test-tmp/var/log/guix/drvs/9l/g85nbk0y8mgdzlqa1wng2j5n6q4cvg-the-thing.drv.gz")
test-name: log-file, output file name
location: /home/sundbry/guix/tests/store.scm:639
source:
+ (test-assert
+   "log-file, output file name"
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d (derivation
+               %store
+               "the-thing"
+               s
+               `("-e" ,b)
+               #:env-vars
+               `(("foo" unquote (random-text)))
+               #:inputs
+               `((,b) (,s))))
+          (o (derivation->output-path d)))
+     (and (build-derivations %store (list d))
+          (file-exists? (pk (log-file %store o)))
+          (string=?
+            (log-file %store (derivation-file-name d))
+            (log-file %store o)))))
actual-value: #t
result: PASS

test-name: no substitutes
location: /home/sundbry/guix/tests/store.scm:654
source:
+ (test-assert
+   "no substitutes"
+   (with-store
+     s
+     (let* ((d1 (package-derivation
+                  s
+                  %bootstrap-guile
+                  (%current-system)))
+            (d2 (package-derivation
+                  s
+                  %bootstrap-glibc
+                  (%current-system)))
+            (o (map derivation->output-path (list d1 d2))))
+       (set-build-options s #:use-substitutes? #f)
+       (and (not (has-substitutes? s (derivation-file-name d1)))
+            (not (has-substitutes? s (derivation-file-name d2)))
+            (null? (substitutable-paths s o))
+            (null? (substitutable-path-info s o))))))
actual-value: #t
result: PASS

test-name: build-things with output path
location: /home/sundbry/guix/tests/store.scm:665
source:
+ (test-assert
+   "build-things with output path"
+   (with-store
+     s
+     (let* ((c (random-text))
+            (d (build-expression->derivation
+                 s
+                 "substitute-me"
+                 `(call-with-output-file
+                    %output
+                    (lambda (p) (display ,c p)))
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (set-build-options s #:use-substitutes? #f)
+       (build-things s (list o))
+       (not (valid-path? s o)))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:668:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!

;;; (spi (#<<substitutable> path: "/home/sundbry/guix/test-tmp/store/pahxs0dglvdhvafni03kw80zm3zkvbb7-guile-bootstrap-2.0" deriver: "/home/sundbry/guix/test-tmp/store/pgh94b880qslgvz6f805qfidqnp43xbv-guile-bootstrap-2.0.drv" refs: () dl-size: 0 nar-size: 1234>))
test-name: substitute query
location: /home/sundbry/guix/tests/store.scm:685
source:
+ (test-assert
+   "substitute query"
+   (with-store
+     s
+     (let* ((d (package-derivation
+                 s
+                 %bootstrap-guile
+                 (%current-system)))
+            (o (derivation->output-path d)))
+       (with-derivation-narinfo
+         d
+         (false-if-exception
+           (delete-file-recursively
+             (string-append
+               (getenv "XDG_CACHE_HOME")
+               "/guix/substitute")))
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (equal?
+                (list o)
+                (substitutable-paths s (list o)))
+              (match (pk 'spi (substitutable-path-info s (list o)))
+                     (((? substitutable? s))
+                      (and (string=?
+                             (substitutable-deriver s)
+                             (derivation-file-name d))
+                           (null? (substitutable-references s))
+                           (equal? (substitutable-nar-size s) 1234)))))))))
actual-value: #t
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!
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!
substitute: \rsubstitute: ^[[Kupdating substitutes from 'http://does-not-exist'...   0.0%guix substitute: warning: does-not-exist: host not found: Name or service not known
substitute: 
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!
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!
test-name: substitute query, alternating URLs
location: /home/sundbry/guix/tests/store.scm:709
source:
+ (test-assert
+   "substitute query, alternating URLs"
+   (let* ((d (with-store
+               s
+               (package-derivation
+                 s
+                 %bootstrap-guile
+                 (%current-system))))
+          (o (derivation->output-path d)))
+     (with-derivation-narinfo
+       d
+       (false-if-exception
+         (delete-file-recursively
+           (string-append
+             (getenv "XDG_CACHE_HOME")
+             "/guix/substitute")))
+       (and (with-store
+              s
+              (set-build-options
+                s
+                #:use-substitutes?
+                #t
+                #:substitute-urls
+                (%test-substitute-urls))
+              (has-substitutes? s o))
+            (with-store
+              s
+              (set-build-options
+                s
+                #:use-substitutes?
+                #t
+                #:substitute-urls
+                (list "http://does-not-exist"))
+              (not (has-substitutes? s o)))
+            (with-store
+              s
+              (set-build-options
+                s
+                #:use-substitutes?
+                #t
+                #:substitute-urls
+                (%test-substitute-urls))
+              (has-substitutes? s o))
+            (with-store
+              s
+              (set-build-options
+                s
+                #:use-substitutes?
+                #t
+                #:substitute-urls
+                '())
+              (not (has-substitutes? s o)))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:744:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/686v35dzk1lmrvi9x0xvh8yksgccc9dc-substitute-me substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  176B                       0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  176B                   228KiB/s 00:00 [##################] 100.0%\r^[[K example.nar  176B                   158KiB/s 00:00 [##################] 100.0%

@ substituter-succeeded /home/sundbry/guix/test-tmp/store/686v35dzk1lmrvi9x0xvh8yksgccc9dc-substitute-me
test-name: substitute
location: /home/sundbry/guix/tests/store.scm:741
source:
+ (test-assert
+   "substitute"
+   (with-store
+     s
+     (let* ((c (random-text))
+            (d (build-expression->derivation
+                 s
+                 "substitute-me"
+                 `(call-with-output-file
+                    %output
+                    (lambda (p) (exit 1) (display ,c p)))
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (with-derivation-substitute
+         d
+         c
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (build-derivations s (list d))
+              (canonical-file? o)
+              (equal?
+                c
+                (call-with-input-file o get-string-all)))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:767:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
/home/sundbry/guix/tests/store.scm:770:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ build-started /home/sundbry/guix/test-tmp/store/cas42c4fpm5hxl0cw4d0wsnj7frxsyaj-build-me.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/ca//s42c4fpm5hxl0cw4d0wsnj7frxsyaj-build-me.drv.gz 5317
@ build-succeeded /home/sundbry/guix/test-tmp/store/cas42c4fpm5hxl0cw4d0wsnj7frxsyaj-build-me.drv -
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/b02kaqnwnp4s1cpb45sc38xvhn9a3da7-substitute-me substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  13KiB                      0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  13KiB                  1.4MiB/s 00:00 [#                 ]   7.9%\r^[[K example.nar  13KiB                  9.4MiB/s 00:00 [##################] 100.0%

@ substituter-succeeded /home/sundbry/guix/test-tmp/store/b02kaqnwnp4s1cpb45sc38xvhn9a3da7-substitute-me
test-name: substitute, deduplication
location: /home/sundbry/guix/tests/store.scm:761
source:
+ (test-assert
+   "substitute, deduplication"
+   (with-store
+     s
+     (let* ((c (string-concatenate
+                 (make-list 200 (random-text))))
+            (g (package-derivation s %bootstrap-guile))
+            (d1 (build-expression->derivation
+                  s
+                  "substitute-me"
+                  `(begin ,c (exit 1))
+                  #:guile-for-build
+                  g))
+            (d2 (build-expression->derivation
+                  s
+                  "build-me"
+                  `(call-with-output-file
+                     %output
+                     (lambda (p) (display ,c p)))
+                  #:guile-for-build
+                  g))
+            (o1 (derivation->output-path d1))
+            (o2 (derivation->output-path d2)))
+       (with-derivation-substitute
+         d1
+         c
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o1)
+              (build-derivations s (list d2))
+              (build-derivations s (list d1))
+              (canonical-file? o1)
+              (equal?
+                c
+                (call-with-input-file o1 get-string-all))
+              (= (stat:ino (stat o1)) (stat:ino (stat o2))))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:790:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/j2cxxr8d9wq8gss8m1vixa5h3ifickzi-substitute-me substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  176B                       0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  176B                   232KiB/s 00:00 [##################] 100.0%\r^[[K example.nar  176B                   162KiB/s 00:00 [##################] 100.0%

@ substituter-succeeded /home/sundbry/guix/test-tmp/store/j2cxxr8d9wq8gss8m1vixa5h3ifickzi-substitute-me
test-name: substitute + build-things with output path
location: /home/sundbry/guix/tests/store.scm:787
source:
+ (test-assert
+   "substitute + build-things with output path"
+   (with-store
+     s
+     (let* ((c (random-text))
+            (d (build-expression->derivation
+                 s
+                 "substitute-me"
+                 `(call-with-output-file
+                    %output
+                    (lambda (p) (exit 1) (display ,c p)))
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (with-derivation-substitute
+         d
+         c
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (build-things s (list o))
+              (valid-path? s o)
+              (canonical-file? o)
+              (equal?
+                c
+                (call-with-input-file o get-string-all)))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:811:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/k2ngjpxii3dsf3559a6kg6wjqm33w9b5-substitute-me substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  176B                       0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  176B                   240KiB/s 00:00 [##################] 100.0%\r^[[K example.nar  176B                   167KiB/s 00:00 [##################] 100.0%

@ substituter-succeeded /home/sundbry/guix/test-tmp/store/k2ngjpxii3dsf3559a6kg6wjqm33w9b5-substitute-me
test-name: substitute + build-things with specific output
location: /home/sundbry/guix/tests/store.scm:808
source:
+ (test-assert
+   "substitute + build-things with specific output"
+   (with-store
+     s
+     (let* ((c (random-text))
+            (d (build-expression->derivation
+                 s
+                 "substitute-me"
+                 `(begin ,c (exit 1))
+                 #:outputs
+                 '("out" "one" "two")
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (with-derivation-substitute
+         d
+         c
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (build-things
+                s
+                `(((unquote (derivation-file-name d)) . "out")))
+              (valid-path? s o)
+              (canonical-file? o)
+              (equal?
+                c
+                (call-with-input-file o get-string-all)))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:835:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/pvais3mhj178h8g6qpcfnqlbk6249ycg-corrupt-substitute substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  128B                       0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  128B                   170KiB/s 00:00 [##################] 100.0%\r^[[K example.nar  128B                   119KiB/s 00:00 [##################] 100.0%

@ hash-mismatch /home/sundbry/guix/test-tmp/store/pvais3mhj178h8g6qpcfnqlbk6249ycg-corrupt-substitute sha256 0000000000000000000000000000000000000000000000000000 0dfmvk0v5jw3f5f1wpv8v8dgwxj62mg5nanyn5lk3rl0n9p3mxxq
@ substituter-failed /home/sundbry/guix/test-tmp/store/pvais3mhj178h8g6qpcfnqlbk6249ycg-corrupt-substitute hash-mismatch sha256 0000000000000000000000000000000000000000000000000000 0dfmvk0v5jw3f5f1wpv8v8dgwxj62mg5nanyn5lk3rl0n9p3mxxq hash mismatch for substituted item `/home/sundbry/guix/test-tmp/store/pvais3mhj178h8g6qpcfnqlbk6249ycg-corrupt-substitute'

;;; (corrupt #<&store-protocol-error message: "some substitutes for the outputs of derivation `/home/sundbry/guix/test-tmp/store/3api5s9k7hwxl6k09nj5amdpy2ikbxv8-corrupt-substitute.drv' failed (usually happens due to networking issues); try `--fallback' to build derivation from source " status: 1>)
test-name: substitute, corrupt output hash
location: /home/sundbry/guix/tests/store.scm:829
source:
+ (test-assert
+   "substitute, corrupt output hash"
+   (with-store
+     s
+     (let* ((c "hello, world")
+            (d (build-expression->derivation
+                 s
+                 "corrupt-substitute"
+                 `(mkdir %output)
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (with-derivation-substitute
+         d
+         c
+         (sha256 => (make-bytevector 32 0))
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:fallback?
+           #f
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (guard (c ((store-protocol-error? c)
+                         (pk 'corrupt c)
+                         (not (zero? (store-protocol-error-status c)))))
+                     (build-derivations s (list d))
+                     #f))))))
actual-value: #t
result: PASS

test-name: substitute, corrupt output hash, build trace
location: /home/sundbry/guix/tests/store.scm:859
source:
+ (test-assert
+   "substitute, corrupt output hash, build trace"
+   (with-store
+     s
+     (let* ((c "hello, world")
+            (d (build-expression->derivation
+                 s
+                 "corrupt-substitute"
+                 `(mkdir %output)
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (set-build-options
+         s
+         #:print-build-trace
+         #t
+         #:use-substitutes?
+         #t
+         #:fallback?
+         #f
+         #:substitute-urls
+         (%test-substitute-urls))
+       (with-derivation-substitute
+         d
+         c
+         (sha256 => (make-bytevector 32 0))
+         (define output
+           (call-with-output-string
+             (lambda (port)
+               (parameterize
+                 ((current-build-output-port port))
+                 (guard (c ((store-protocol-error? c) #t))
+                        (build-derivations s (list d))
+                        #f)))))
+         (define actual-hash
+           (let-values
+             (((port get-hash)
+               (gcrypt:open-hash-port
+                 (gcrypt:hash-algorithm gcrypt:sha256))))
+             (write-file-tree
+               "foo"
+               port
+               #:file-type+size
+               (lambda _ (values 'regular (string-length c)))
+               #:file-port
+               (lambda _ (open-input-string c)))
+             (close-port port)
+             (bytevector->nix-base32-string (get-hash))))
+         (define expected-hash
+           (bytevector->nix-base32-string
+             (make-bytevector 32 0)))
+         (define mismatch
+           (string-append
+             "@ hash-mismatch "
+             o
+             " sha256 "
+             expected-hash
+             " "
+             actual-hash
+             "\n"))
+         (define failure
+           (string-append "@ substituter-failed " o))
+         (and (string-contains output mismatch)
+              (string-contains output failure))))))
actual-value: 995
result: PASS

/home/sundbry/guix/tests/store.scm:863:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
/home/sundbry/guix/tests/store.scm:917:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
retrying download of '/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not' with other substitute URLs...
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
guix substitute: error: failed to find alternative substitute for '/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not'
@ substituter-failed /home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not  fetching path `/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not' (empty status: '')
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ substituter-started /home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
retrying download of '/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not' with other substitute URLs...
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
guix substitute: error: failed to find alternative substitute for '/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not'
@ substituter-failed /home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not  fetching path `/home/sundbry/guix/test-tmp/store/jgmdxhv2h7lb4brq24rwm0gdnjgy1sbp-substitute-me-not' (empty status: '')
@ build-started /home/sundbry/guix/test-tmp/store/nfamgys046n0vq8sja4ib8hlj9ggvvyh-substitute-me-not.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/nf//amgys046n0vq8sja4ib8hlj9ggvvyh-substitute-me-not.drv.gz 5560
@ build-succeeded /home/sundbry/guix/test-tmp/store/nfamgys046n0vq8sja4ib8hlj9ggvvyh-substitute-me-not.drv -
test-name: substitute --fallback
location: /home/sundbry/guix/tests/store.scm:914
source:
+ (test-assert
+   "substitute --fallback"
+   (with-store
+     s
+     (let* ((t (random-text))
+            (d (build-expression->derivation
+                 s
+                 "substitute-me-not"
+                 `(call-with-output-file
+                    %output
+                    (lambda (p) (display ,t p)))
+                 #:guile-for-build
+                 (package-derivation
+                   s
+                   %bootstrap-guile
+                   (%current-system))))
+            (o (derivation->output-path d)))
+       (with-derivation-narinfo
+         d
+         (set-build-options
+           s
+           #:use-substitutes?
+           #t
+           #:substitute-urls
+           (%test-substitute-urls))
+         (and (has-substitutes? s o)
+              (guard (c ((store-protocol-error? c)
+                         (set-build-options
+                           s
+                           #:use-substitutes?
+                           #t
+                           #:substitute-urls
+                           (%test-substitute-urls)
+                           #:fallback?
+                           #t)
+                         (and (build-derivations s (list d))
+                              (equal?
+                                t
+                                (call-with-input-file o get-string-all)))))
+                     (build-derivations s (list d))
+                     #f))))))
actual-value: #t
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!

;;; (spi (#<<substitutable> path: "/home/sundbry/guix/test-tmp/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size" deriver: "" refs: () dl-size: 0 nar-size: 9223372036854775908>))
test-name: substitute query and large size
location: /home/sundbry/guix/tests/store.scm:946
source:
+ (test-equal
+   "substitute query and large size"
+   (+ 100 (expt 2 63))
+   (with-store
+     s
+     (let* ((size (+ 100 (expt 2 63)))
+            (item (string-append
+                    (%store-prefix)
+                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size")))
+       (call-with-output-file
+         (string-append
+           (%substitute-directory)
+           "/"
+           (store-path-hash-part item)
+           ".narinfo")
+         (lambda (port)
+           (format
+             port
+             "StorePath: ~a\nURL: http://example.org\nCompression: none\nNarSize: ~a\nNarHash: sha256:0fj9vhblff2997pi7qjj7lhmy7wzhnjwmkm2hmq6gr4fzmg10s0w\nReferences: \nSystem: x86_64-linux~%"
+             item
+             size)))
+       (false-if-exception
+         (delete-file-recursively
+           (string-append
+             (getenv "XDG_CACHE_HOME")
+             "/guix/substitute")))
+       (set-build-options
+         s
+         #:use-substitutes?
+         #t
+         #:substitute-urls
+         (%test-substitute-urls))
+       (match (pk 'spi (substitutable-path-info s (list item)))
+              (((? substitutable? s))
+               (and (equal? (substitutable-path s) item)
+                    (substitutable-nar-size s)))))))
expected-value: 9223372036854775908
actual-value: 9223372036854775908
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!
@ substituter-started /home/sundbry/guix/test-tmp/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size-c9f75971c5bdd275b23228bc760d62c7d014cb901795f4906acc5dbbe2624a0a substitute
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/nar...
\r^[[K nar  128B                               0B/s 00:00 [                  ]   0.0%\r^[[K nar  128B                           170KiB/s 00:00 [##################] 100.0%\r^[[K nar  128B                           120KiB/s 00:00 [##################] 100.0%

@ substituter-succeeded /home/sundbry/guix/test-tmp/store/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size-c9f75971c5bdd275b23228bc760d62c7d014cb901795f4906acc5dbbe2624a0a
test-name: substitute and large size
location: /home/sundbry/guix/tests/store.scm:980
source:
+ (test-equal
+   "substitute and large size"
+   (+ 100 (expt 2 31))
+   (with-store
+     s
+     (let* ((size (+ 100 (expt 2 31)))
+            (item (string-append
+                    (%store-prefix)
+                    "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size-"
+                    (random-text)))
+            (nar (string-append (%substitute-directory) "/nar")))
+       (call-with-output-file
+         nar
+         (lambda (port)
+           (write-file-tree
+             (store-path-package-name item)
+             port
+             #:file-type+size
+             (lambda _ (values 'regular 12))
+             #:file-port
+             (lambda _ (open-input-string "Hello world.")))))
+       (call-with-output-file
+         (string-append
+           (%substitute-directory)
+           "/"
+           (store-path-hash-part item)
+           ".narinfo")
+         (lambda (port)
+           (format
+             port
+             "StorePath: ~a\nURL: file://~a\nCompression: none\nNarSize: ~a\nNarHash: sha256:~a\nReferences: \nSystem: x86_64-linux~%"
+             item
+             nar
+             size
+             (bytevector->nix-base32-string
+               (gcrypt:file-sha256 nar)))))
+       (false-if-exception
+         (delete-file-recursively
+           (string-append
+             (getenv "XDG_CACHE_HOME")
+             "/guix/substitute")))
+       (set-build-options
+         s
+         #:use-substitutes?
+         #t
+         #:substitute-urls
+         (%test-substitute-urls))
+       (ensure-path s item)
+       (path-info-nar-size (query-path-info s item)))))
expected-value: 2147483748
actual-value: 2147483748
result: PASS

finding garbage collector roots...
deleting unused links...
test-name: export/import several paths
location: /home/sundbry/guix/tests/store.scm:1024
source:
+ (test-assert
+   "export/import several paths"
+   (let* ((texts (unfold
+                   (cut >= <> 10)
+                   (lambda _ (random-text))
+                   #{1+}#
+                   0))
+          (files (map (cut add-text-to-store %store "text" <>)
+                      texts))
+          (dump (call-with-bytevector-output-port
+                  (cut export-paths %store files <>))))
+     (delete-paths %store files)
+     (and (every (negate file-exists?) files)
+          (let* ((source (open-bytevector-input-port dump))
+                 (imported (import-paths %store source)))
+            (and (equal? imported files)
+                 (every file-exists? files)
+                 (equal?
+                   texts
+                   (map (lambda (file)
+                          (call-with-input-file file get-string-all))
+                        files)))))))
actual-value: #t
result: PASS

finding garbage collector roots...
deleting unused links...
test-name: export/import paths, ensure topological order
location: /home/sundbry/guix/tests/store.scm:1044
source:
+ (test-assert
+   "export/import paths, ensure topological order"
+   (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+          (file1 (add-text-to-store
+                   %store
+                   "foo"
+                   (random-text)
+                   (list file0)))
+          (file2 (add-text-to-store
+                   %store
+                   "bar"
+                   (random-text)
+                   (list file1)))
+          (files (list file1 file2))
+          (dump1 (call-with-bytevector-output-port
+                   (cute export-paths %store (list file1 file2) <>)))
+          (dump2 (call-with-bytevector-output-port
+                   (cute export-paths %store (list file2 file1) <>))))
+     (delete-paths %store files)
+     (and (every (negate file-exists?) files)
+          (bytevector=? dump1 dump2)
+          (let* ((source (open-bytevector-input-port dump1))
+                 (imported (import-paths %store source)))
+            (and (equal? imported (list file1 file2))
+                 (every file-exists? files)
+                 (equal? (list file0) (references %store file1))
+                 (equal? (list file1) (references %store file2)))))))
actual-value: #t
result: PASS

finding garbage collector roots...
deleting unused links...
test-name: export/import incomplete
location: /home/sundbry/guix/tests/store.scm:1066
source:
+ (test-assert
+   "export/import incomplete"
+   (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+          (file1 (add-text-to-store
+                   %store
+                   "foo"
+                   (random-text)
+                   (list file0)))
+          (file2 (add-text-to-store
+                   %store
+                   "bar"
+                   (random-text)
+                   (list file1)))
+          (dump (call-with-bytevector-output-port
+                  (cute export-paths %store (list file2) <>))))
+     (delete-paths %store (list file0 file1 file2))
+     (guard (c ((store-protocol-error? c)
+                (and (not (zero? (store-protocol-error-status c)))
+                     (string-contains
+                       (store-protocol-error-message c)
+                       "not valid"))))
+            (import-paths
+              %store
+              (open-bytevector-input-port dump)))))
actual-value: 81
result: PASS

finding garbage collector roots...
deleting unused links...
test-name: export/import recursive
location: /home/sundbry/guix/tests/store.scm:1083
source:
+ (test-assert
+   "export/import recursive"
+   (let* ((file0 (add-text-to-store %store "baz" (random-text)))
+          (file1 (add-text-to-store
+                   %store
+                   "foo"
+                   (random-text)
+                   (list file0)))
+          (file2 (add-text-to-store
+                   %store
+                   "bar"
+                   (random-text)
+                   (list file1)))
+          (dump (call-with-bytevector-output-port
+                  (cute export-paths
+                        %store
+                        (list file2)
+                        <>
+                        #:recursive?
+                        #t))))
+     (delete-paths %store (list file0 file1 file2))
+     (let ((imported
+             (import-paths
+               %store
+               (open-bytevector-input-port dump))))
+       (and (equal? imported (list file0 file1 file2))
+            (every file-exists? (list file0 file1 file2))
+            (equal? (list file0) (references %store file1))
+            (equal? (list file1) (references %store file2))))))
actual-value: #t
result: PASS

@ build-started /home/sundbry/guix/test-tmp/store/42c69zalgrl1hj8pfchpif0ci0c8hhh3-bunch.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/42//c69zalgrl1hj8pfchpif0ci0c8hhh3-bunch.drv.gz 5752
@ build-succeeded /home/sundbry/guix/test-tmp/store/42c69zalgrl1hj8pfchpif0ci0c8hhh3-bunch.drv -
test-name: write-file & export-path yield the same result
location: /home/sundbry/guix/tests/store.scm:1099
source:
+ (test-assert
+   "write-file & export-path yield the same result"
+   (run-with-store
+     %store
+     (mlet* %store-monad
+            ((drv1 (package->derivation %bootstrap-guile))
+             (out1 -> (derivation->output-path drv1))
+             (data ->
+                   (unfold
+                     (cut >= <> 26)
+                     (lambda (i) (random-bytevector 128))
+                     #{1+}#
+                     0))
+             (build ->
+                    (gexp (begin
+                            (use-modules (rnrs io ports) (srfi srfi-1))
+                            (let ()
+                              (define letters
+                                (map (lambda (i)
+                                       (string
+                                         (integer->char
+                                           (+ i (char->integer #\a)))))
+                                     (iota 26)))
+                              (define (touch file data)
+                                (call-with-output-file
+                                  file
+                                  (lambda (port) (put-bytevector port data))))
+                              (mkdir (ungexp output))
+                              (chdir (ungexp output))
+                              (for-each
+                                touch
+                                (append (drop letters 10) (take letters 10))
+                                (list (ungexp-splicing data)))
+                              #t))))
+             (drv2 (gexp->derivation "bunch" build))
+             (out2 -> (derivation->output-path drv2))
+             (item-info -> (store-lift query-path-info)))
+            (mbegin
+              %store-monad
+              (built-derivations (list drv1 drv2))
+              (foldm %store-monad
+                     (lambda (item result)
+                       (define ref-hash
+                         (let-values
+                           (((port get) (gcrypt:open-sha256-port)))
+                           (write-file item port)
+                           (close-port port)
+                           (get)))
+                       (>>= (item-info item)
+                            (lambda (info)
+                              (return
+                                (and result
+                                     (bytevector=?
+                                       (path-info-hash info)
+                                       ref-hash))))))
+                     #t
+                     (list out1 out2))))
+     #:guile-for-build
+     (%guile-for-build)))
actual-value: #t
result: PASS

test-name: import not signed
location: /home/sundbry/guix/tests/store.scm:1166
source:
+ (test-assert
+   "import not signed"
+   (let* ((text (random-text))
+          (file (add-file-tree-to-store
+                  %store
+                  `("tree"
+                    directory
+                    ("text" regular (data ,text))
+                    ("link" symlink "text"))))
+          (dump (call-with-bytevector-output-port
+                  (lambda (port)
+                    (write-int 1 port)
+                    (write-file file port)
+                    (write-int 1163413838 port)
+                    (write-string file port)
+                    (write-string-list '() port)
+                    (write-string "" port)
+                    (write-int 0 port)
+                    (write-int 0 port)))))
+     (guard (c ((store-protocol-error? c)
+                (and (not (zero? (store-protocol-error-status c)))
+                     (string-contains
+                       (store-protocol-error-message c)
+                       "lacks a signature"))))
+            (let* ((source (open-bytevector-input-port dump))
+                   (imported (import-paths %store source)))
+              (pk 'unsigned-imported imported)
+              #f))))
actual-value: 94
result: PASS

test-name: import signed by unauthorized key
location: /home/sundbry/guix/tests/store.scm:1195
source:
+ (test-assert
+   "import signed by unauthorized key"
+   (let* ((text (random-text))
+          (file (add-file-tree-to-store
+                  %store
+                  `("tree"
+                    directory
+                    ("text" regular (data ,text))
+                    ("link" symlink "text"))))
+          (key (gcrypt:generate-key
+                 (gcrypt:string->canonical-sexp
+                   "(genkey (ecdsa (curve Ed25519) (flags rfc6979)))")))
+          (dump (call-with-bytevector-output-port
+                  (lambda (port)
+                    (write-int 1 port)
+                    (write-file file port)
+                    (write-int 1163413838 port)
+                    (write-string file port)
+                    (write-string-list '() port)
+                    (write-string "" port)
+                    (write-int 1 port)
+                    (write-string
+                      (gcrypt:canonical-sexp->string
+                        (signature-sexp
+                          (gcrypt:bytevector->hash-data
+                            (gcrypt:sha256 #vu8(0 1 2))
+                            #:key-type
+                            'ecc)
+                          (gcrypt:find-sexp-token key 'private-key)
+                          (gcrypt:find-sexp-token key 'public-key)))
+                      port)
+                    (write-int 0 port)))))
+     (guard (c ((store-protocol-error? c)
+                (and (not (zero? (store-protocol-error-status c)))
+                     (string-contains
+                       (store-protocol-error-message c)
+                       "unauthorized public key"))))
+            (let* ((source (open-bytevector-input-port dump))
+                   (imported (import-paths %store source)))
+              (pk 'unauthorized-imported imported)
+              #f))))
actual-value: 0
result: PASS

finding garbage collector roots...
deleting unused links...

;;; (c #<&store-protocol-error message: "signed hash doesn't match actual contents of imported archive; archive could be corrupt, or someone is trying to import a Trojan horse" status: 1>)
test-name: import corrupt path
location: /home/sundbry/guix/tests/store.scm:1235
source:
+ (test-assert
+   "import corrupt path"
+   (let* ((text (random-text))
+          (file (add-text-to-store %store "text" text))
+          (dump (call-with-bytevector-output-port
+                  (cut export-paths %store (list file) <>))))
+     (delete-paths %store (list file))
+     (let* ((index 112)
+            (byte (bytevector-u8-ref dump index)))
+       (bytevector-u8-set! dump index (logxor 255 byte)))
+     (and (not (file-exists? file))
+          (guard (c ((store-protocol-error? c)
+                     (pk 'c c)
+                     (and (not (zero? (store-protocol-error-status c)))
+                          (string-contains
+                            (store-protocol-error-message c)
+                            "corrupt"))))
+                 (let* ((source (open-bytevector-input-port dump))
+                        (imported (import-paths %store source)))
+                   (pk 'corrupt-imported imported)
+                   #f)))))
actual-value: 80
result: PASS

reading the store...

;;; (verify1 #t)
reading the store...
path `/home/sundbry/guix/test-tmp/store/qnnhl73x4hq09g374jiycc1my0fsf3jk-foo' disappeared, but it still has valid referrers!

;;; (verify2 #f)
reading the store...

;;; (verify3 #t)
test-name: verify-store
location: /home/sundbry/guix/tests/store.scm:1259
source:
+ (test-assert
+   "verify-store"
+   (let* ((text (random-text))
+          (file1 (add-text-to-store %store "foo" text))
+          (file2 (add-text-to-store
+                   %store
+                   "bar"
+                   (random-text)
+                   (list file1))))
+     (and (pk 'verify1 (verify-store %store))
+          (begin
+            (delete-file file1)
+            (not (pk 'verify2 (verify-store %store))))
+          (begin
+            (call-with-output-file
+              file1
+              (lambda (port) (display text port)))
+            (pk 'verify3 (verify-store %store))))))
actual-value: #t
result: PASS

/home/sundbry/guix/tests/store.scm:1280:17: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
fetching path `/home/sundbry/guix/test-tmp/store/zdkjjfpb78d7gbkhnbkxaqhml6x0q1sg-corrupt'...
guix substitute: warning: ACL for archive imports seems to be uninitialized, substitutes may be unavailable
Downloading file:/home/sundbry/guix/test-tmp/var/4806/substituter-data/example.nar...
\r^[[K example.nar  176B                        0B/s 00:00 [                  ]   0.0%\r^[[K example.nar  176B                    237KiB/s 00:00 [##################] 100.0%\r^[[K example.nar  176B                    167KiB/s 00:00 [##################] 100.0%

reading the store...
checking path existence...
checking hashes...
path `/home/sundbry/guix/test-tmp/store/p9avw883rl4gbnd0i8yyhz89dkyhqik7-corrupt' was modified! expected hash `64a4e1523e920f694ceb7fc054f4715f864d937077a10f21435d9f563f6151e4', got `e09c480e2e93336cd3c45aa129f81a0d7ba56c410b849d7779a8136074413b3d'
test-name: verify-store + check-contents
location: /home/sundbry/guix/tests/store.scm:1276
source:
+ (test-assert
+   "verify-store + check-contents"
+   (with-store
+     s
+     (let* ((text (random-text))
+            (drv (build-expression->derivation
+                   s
+                   "corrupt"
+                   `(let ((out (assoc-ref %outputs "out")))
+                      (call-with-output-file
+                        out
+                        (lambda (port) (display ,text port)))
+                      #t)
+                   #:guile-for-build
+                   (package-derivation
+                     s
+                     %bootstrap-guile
+                     (%current-system))))
+            (file (derivation->output-path drv)))
+       (with-derivation-substitute
+         drv
+         text
+         (and (build-derivations s (list drv))
+              (verify-store s #:check-contents? #t)
+              (begin
+                (chmod file 420)
+                (call-with-output-file
+                  file
+                  (lambda (port) (display "corrupt!" port)))
+                #t)
+              (not (verify-store s #:check-contents? #t))
+              (delete-paths s (list file)))))))
actual-value: #f
result: FAIL

/home/sundbry/guix/tests/store.scm:1319:20: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
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!
building path(s) `/home/sundbry/guix/test-tmp/store/q9kn7rvwkk7a9nr5i7iq0ywlf382dd5a-non-deterministic'
checking path(s) `/home/sundbry/guix/test-tmp/store/q9kn7rvwkk7a9nr5i7iq0ywlf382dd5a-non-deterministic'
warning: rewriting hashes in `/home/sundbry/guix/test-tmp/store/q9kn7rvwkk7a9nr5i7iq0ywlf382dd5a-non-deterministic'; cross fingers

;;; (determinism-exception #<&store-protocol-error message: "derivation `/home/sundbry/guix/test-tmp/store/pkady2q9ry8fch7116g5l48dlzg9bwgg-non-deterministic.drv' may not be deterministic: output `/home/sundbry/guix/test-tmp/store/q9kn7rvwkk7a9nr5i7iq0ywlf382dd5a-non-deterministic' differs" status: 1>)
test-name: build-things, check mode
location: /home/sundbry/guix/tests/store.scm:1313
source:
+ (test-assert
+   "build-things, check mode"
+   (with-store
+     store
+     (call-with-temporary-output-file
+       (lambda (entropy entropy-port)
+         (write (random-text) entropy-port)
+         (force-output entropy-port)
+         (let* ((drv (build-expression->derivation
+                       store
+                       "non-deterministic"
+                       `(begin
+                          (use-modules (rnrs io ports))
+                          (let ((out (assoc-ref %outputs "out")))
+                            (call-with-output-file
+                              out
+                              (lambda (port)
+                                (display
+                                  (call-with-input-file
+                                    ,entropy
+                                    get-string-all)
+                                  port)))
+                            #t))
+                       #:guile-for-build
+                       (package-derivation
+                         store
+                         %bootstrap-guile
+                         (%current-system))))
+                (file (derivation->output-path drv)))
+           (and (build-things
+                  store
+                  (list (derivation-file-name drv)))
+                (begin
+                  (write (random-text) entropy-port)
+                  (force-output entropy-port)
+                  (guard (c ((store-protocol-error? c)
+                             (pk 'determinism-exception c)
+                             (and (not (zero? (store-protocol-error-status
+                                                c)))
+                                  (string-contains
+                                    (store-protocol-error-message c)
+                                    "deterministic"))))
+                         (build-things
+                           store
+                           (list (derivation-file-name drv))
+                           (build-mode check))
+                         #f))))))))
actual-value: 83
result: PASS

test-name: build-succeeded trace in check mode
location: /home/sundbry/guix/tests/store.scm:1350
source:
+ (test-assert
+   "build-succeeded trace in check mode"
+   (string-contains
+     (call-with-output-string
+       (lambda (port)
+         (let ((d (build-expression->derivation
+                    %store
+                    "foo"
+                    '(mkdir (assoc-ref %outputs "out"))
+                    #:guile-for-build
+                    (package-derivation %store %bootstrap-guile))))
+           (build-derivations %store (list d))
+           (parameterize
+             ((current-build-output-port port))
+             (build-derivations
+               %store
+               (list d)
+               (build-mode check))))))
+     "@ build-succeeded"))
actual-value: 320
result: PASS

/home/sundbry/guix/tests/store.scm:1354:16: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
/home/sundbry/guix/tests/store.scm:1372:20: warning: 'build-expression->derivation' is deprecated, use 'gexp->derivation' instead
@ build-started /home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/xc//6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv.gz 5896
@ build-started /home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/xc//6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv.gz 5897
output ?/home/sundbry/guix/test-tmp/store/qpjlhr2dgcz1dqs05mkg35mmlckw0zdj-non-deterministic? of ?/home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv? differs from previous round
@ build-failed /home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv - 1 output ?/home/sundbry/guix/test-tmp/store/qpjlhr2dgcz1dqs05mkg35mmlckw0zdj-non-deterministic? of ?/home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv? differs from previous round

;;; (multiple-build #<&store-protocol-error message: "build of `/home/sundbry/guix/test-tmp/store/xc6ff6y6i8fb9x00lbcx6fbvlibmkzjw-non-deterministic.drv' failed" status: 1>)
test-name: build multiple times
location: /home/sundbry/guix/tests/store.scm:1363
source:
+ (test-assert
+   "build multiple times"
+   (with-store
+     store
+     (set-build-options
+       store
+       #:rounds
+       2
+       #:use-substitutes?
+       #f)
+     (call-with-temporary-output-file
+       (lambda (entropy entropy-port)
+         (write (random-text) entropy-port)
+         (force-output entropy-port)
+         (let* ((drv (build-expression->derivation
+                       store
+                       "non-deterministic"
+                       `(begin
+                          (use-modules (rnrs io ports))
+                          (let ((out (assoc-ref %outputs "out")))
+                            (call-with-output-file
+                              out
+                              (lambda (port)
+                                (display
+                                  (call-with-input-file
+                                    ,entropy
+                                    get-string-all)
+                                  port)
+                                (call-with-output-file
+                                  ,entropy
+                                  (lambda (port) (write 'foobar port)))))
+                            #t))
+                       #:guile-for-build
+                       (package-derivation
+                         store
+                         %bootstrap-guile
+                         (%current-system))))
+                (file (derivation->output-path drv)))
+           (guard (c ((store-protocol-error? c)
+                      (pk 'multiple-build c)
+                      (and (not (zero? (store-protocol-error-status c)))
+                           (string-contains
+                             (store-protocol-error-message c)
+                             "deterministic"))))
+                  (current-build-output-port (current-error-port))
+                  (build-things
+                    store
+                    (list (derivation-file-name drv)))
+                  #f))))))
actual-value: 81
result: PASS

test-name: store-lower
location: /home/sundbry/guix/tests/store.scm:1401
source:
+ (test-equal
+   "store-lower"
+   "Lowered."
+   (let* ((add (store-lower text-file))
+          (file (add %store "foo" "Lowered.")))
+     (call-with-input-file file get-string-all)))
expected-value: "Lowered."
actual-value: "Lowered."
result: PASS

test-name: current-system
location: /home/sundbry/guix/tests/store.scm:1407
source:
+ (test-equal
+   "current-system"
+   "bar"
+   (parameterize
+     ((%current-system "frob"))
+     (run-with-store
+       %store
+       (mbegin
+         %store-monad
+         (set-current-system "bar")
+         (current-system))
+       #:system
+       "foo")))
expected-value: "bar"
actual-value: "bar"
result: PASS

test-name: query-path-info
location: /home/sundbry/guix/tests/store.scm:1416
source:
+ (test-assert
+   "query-path-info"
+   (let* ((ref (add-text-to-store %store "ref" "foo"))
+          (item (add-text-to-store
+                  %store
+                  "item"
+                  "bar"
+                  (list ref)))
+          (info (query-path-info %store item)))
+     (and (equal? (path-info-references info) (list ref))
+          (equal?
+            (path-info-hash info)
+            (gcrypt:sha256
+              (string->utf8
+                (call-with-output-string
+                  (cut write-file item <>))))))))
actual-value: #t
result: PASS

warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
@ build-started /home/sundbry/guix/test-tmp/store/nqbdry8r80k9fhkz29295k3ys8182ma6-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/nq//bdry8r80k9fhkz29295k3ys8182ma6-the-thing.drv.gz 5917
@ build-succeeded /home/sundbry/guix/test-tmp/store/nqbdry8r80k9fhkz29295k3ys8182ma6-the-thing.drv -
test-name: path-info-deriver
location: /home/sundbry/guix/tests/store.scm:1426
source:
+ (test-assert
+   "path-info-deriver"
+   (let* ((b (add-text-to-store
+               %store
+               "build"
+               "echo $foo > $out"
+               '()))
+          (s (add-to-store
+               %store
+               "bash"
+               #t
+               "sha256"
+               (search-bootstrap-binary
+                 "bash"
+                 (%current-system))))
+          (d (derivation
+               %store
+               "the-thing"
+               s
+               `("-e" ,b)
+               #:env-vars
+               `(("foo" unquote (random-text)))
+               #:inputs
+               `((,b) (,s))))
+          (o (derivation->output-path d)))
+     (and (build-derivations %store (list d))
+          (not (path-info-deriver (query-path-info %store b)))
+          (string=?
+            (derivation-file-name d)
+            (path-info-deriver (query-path-info %store o))))))
actual-value: #t
result: PASS

warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
warning: in 'the-thing': deprecated 'derivation' calling convention used
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!
building path(s) `/home/sundbry/guix/test-tmp/store/d7fanjdmk9zz6x7f99ml8fwydvwcgl4a-the-thing'
substitute: guix substitute: warning: authentication and authorization of substitutes disabled!
@ build-started /home/sundbry/guix/test-tmp/store/29ncns95sz7c9p3zgmm5vh87vm8s8qrj-the-thing.drv - x86_64-linux /home/sundbry/guix/test-tmp/var/log/guix/drvs/29//ncns95sz7c9p3zgmm5vh87vm8s8qrj-the-thing.drv.gz 5974
@ build-succeeded /home/sundbry/guix/test-tmp/store/29ncns95sz7c9p3zgmm5vh87vm8s8qrj-the-thing.drv -
test-name: build-cores
location: /home/sundbry/guix/tests/store.scm:1441
source:
+ (test-equal
+   "build-cores"
+   (list 0 42)
+   (with-store
+     store
+     (let* ((build (add-text-to-store
+                     store
+                     "build.sh"
+                     "echo $NIX_BUILD_CORES > $out"))
+            (bash (add-to-store
+                    store
+                    "bash"
+                    #t
+                    "sha256"
+                    (search-bootstrap-binary
+                      "bash"
+                      (%current-system))))
+            (drv1 (derivation
+                    store
+                    "the-thing"
+                    bash
+                    `("-e" ,build)
+                    #:inputs
+                    `((,bash) (,build))
+                    #:env-vars
+                    `(("x" unquote (random-text)))))
+            (drv2 (derivation
+                    store
+                    "the-thing"
+                    bash
+                    `("-e" ,build)
+                    #:inputs
+                    `((,bash) (,build))
+                    #:env-vars
+                    `(("x" unquote (random-text))))))
+       (and (build-derivations store (list drv1))
+            (begin
+              (set-build-options store #:build-cores 42)
+              (build-derivations store (list drv2)))
+            (list (call-with-input-file
+                    (derivation->output-path drv1)
+                    read)
+                  (call-with-input-file
+                    (derivation->output-path drv2)
+                    read))))))
expected-value: (0 42)
actual-value: (0 42)
result: PASS

test-name: multiplexed-build-output
location: /home/sundbry/guix/tests/store.scm:1466
source:
+ (test-equal
+   "multiplexed-build-output"
+   '("Hello from first." "Hello from second.")
+   (with-store
+     store
+     (let* ((build (add-text-to-store
+                     store
+                     "build.sh"
+                     "echo Hello from $NAME.; echo > $out"))
+            (bash (add-to-store
+                    store
+                    "bash"
+                    #t
+                    "sha256"
+                    (search-bootstrap-binary
+                      "bash"
+                      (%current-system))))
+            (drv1 (derivation
+                    store
+                    "one"
+                    bash
+                    `("-e" ,build)
+                    #:inputs
+                    `((,bash) (,build))
+                    #:env-vars
+                    `(("NAME" . "first") ("x" unquote (random-text)))))
+            (drv2 (derivation
+                    store
+                    "two"
+                    bash
+                    `("-e" ,build)
+                    #:inputs
+                    `((,bash) (,build))
+                    #:env-vars
+                    `(("NAME" . "second") ("x" unquote (random-text))))))
+       (set-build-options
+         store
+         #:print-build-trace
+         #t
+         #:multiplexed-build-output?
+         #t
+         #:max-build-jobs
+         10)
+       (let ((port (open-output-string)))
+         (parameterize
+           ((current-build-output-port port))
+           (build-derivations store (list drv1 drv2)))
+         (let* ((log (get-output-string port))
+                (started
+                  (fold-matches
+                    (make-regexp
+                      "@ build-started ([^ ]+) - ([^ ]+) ([^ ]+) ([0-9]+)")
+                    log
+                    '()
+                    cons))
+                (done (fold-matches
+                        (make-regexp
+                          "@ build-succeeded (.*) - (.*) (.*) (.*)")
+                        log
+                        '()
+                        cons))
+                (output
+                  (fold-matches
+                    (make-regexp
+                      "@ build-log ([[:digit:]]+) ([[:digit:]]+)\n([A-Za-z .*]+)\n")
+                    log
+                    '()
+                    cons))
+                (drv-pid
+                  (lambda (name)
+                    (lambda (m)
+                      (let ((drv (match:substring m 1))
+                            (pid (string->number (match:substring m 4))))
+                        (and (string-suffix? name drv) pid)))))
+                (pid-log
+                  (lambda (pid)
+                    (lambda (m)
+                      (let ((n (string->number (match:substring m 1)))
+                            (len (string->number (match:substring m 2)))
+                            (str (match:substring m 3)))
+                        (and (= pid n)
+                             (= (string-length str) (- len 1))
+                             str)))))
+                (pid1 (any (drv-pid "one.drv") started))
+                (pid2 (any (drv-pid "two.drv") started)))
+           (list (any (pid-log pid1) output)
+                 (any (pid-log pid2) output)))))))
expected-value: ("Hello from first." "Hello from second.")
actual-value: ("Hello from first." "Hello from second.")
result: PASS

warning: in 'one': deprecated 'derivation' calling convention used
warning: in 'one': deprecated 'derivation' calling convention used
warning: in 'one': deprecated 'derivation' calling convention used
warning: in 'one': deprecated 'derivation' calling convention used
warning: in 'two': deprecated 'derivation' calling convention used
warning: in 'two': deprecated 'derivation' calling convention used
warning: in 'two': deprecated 'derivation' calling convention used
warning: in 'two': deprecated 'derivation' calling convention used


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 495 bytes --]

^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-10  8:01   ` Ludovic Courtès
  2022-10-10 10:29     ` Maxime Devos
@ 2022-10-14 20:30     ` Ludovic Courtès
  2022-10-17  1:25       ` Maxim Cournoyer
  1 sibling, 1 reply; 10+ messages in thread
From: Ludovic Courtès @ 2022-10-14 20:30 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: 25018

Hi Maxim,

(Stripping Cc:.)

Ludovic Courtès <ludo@gnu.org> skribis:

> Thank you!  (Your bug triage work is much appreciated!)  We could turn
> the example here in a unit test; the only downside is that running the
> GC in a test is expensive.

Actually, there are tests that most likely relied on the previous
behavior and are now failing in
tests/{derivations,nar,publish,pypi,store}.scm.  We’ll have to look at
each one to make sure they are indeed making the wrong assumption and to
fix them.

What about reverting the change first so we can do that without
pressure and come up with a self-contained patch?

Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-14 20:30     ` Ludovic Courtès
@ 2022-10-17  1:25       ` Maxim Cournoyer
  2022-10-17  8:51         ` Ludovic Courtès
  0 siblings, 1 reply; 10+ messages in thread
From: Maxim Cournoyer @ 2022-10-17  1:25 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 25018

Hi Ludovic!

Ludovic Courtès <ludo@gnu.org> writes:

> Hi Maxim,
>
> (Stripping Cc:.)
>
> Ludovic Courtès <ludo@gnu.org> skribis:
>
>> Thank you!  (Your bug triage work is much appreciated!)  We could turn
>> the example here in a unit test; the only downside is that running the
>> GC in a test is expensive.
>
> Actually, there are tests that most likely relied on the previous
> behavior and are now failing in
> tests/{derivations,nar,publish,pypi,store}.scm.  We’ll have to look at
> each one to make sure they are indeed making the wrong assumption and to
> fix them.

Hmm, I hadn't seen that coming.

> What about reverting the change first so we can do that without
> pressure and come up with a self-contained patch?

Sounds reasonable, if we can't think of an immediate fix.

-- 
Thanks,
Maxim




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-17  1:25       ` Maxim Cournoyer
@ 2022-10-17  8:51         ` Ludovic Courtès
  2022-10-18 15:33           ` Maxim Cournoyer
  0 siblings, 1 reply; 10+ messages in thread
From: Ludovic Courtès @ 2022-10-17  8:51 UTC (permalink / raw)
  To: Maxim Cournoyer; +Cc: 25018

Hi Maxim,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi Maxim,
>>
>> (Stripping Cc:.)
>>
>> Ludovic Courtès <ludo@gnu.org> skribis:
>>
>>> Thank you!  (Your bug triage work is much appreciated!)  We could turn
>>> the example here in a unit test; the only downside is that running the
>>> GC in a test is expensive.
>>
>> Actually, there are tests that most likely relied on the previous
>> behavior and are now failing in
>> tests/{derivations,nar,publish,pypi,store}.scm.  We’ll have to look at
>> each one to make sure they are indeed making the wrong assumption and to
>> fix them.
>
> Hmm, I hadn't seen that coming.
>
>> What about reverting the change first so we can do that without
>> pressure and come up with a self-contained patch?
>
> Sounds reasonable, if we can't think of an immediate fix.

I reverted it in eec920ba93ecb086366576e31b785962fbaf81c2.

The way forward will be to review those tests one by one, make sure they
were making the “wrong” assumption, adjust them accordingly, and
possibly add new tests.  It’s not necessarily difficult but takes a bit
of time.  (In the coming weeks I’m going to try and focus on more urgent
matters but I’m happy to review if you or someone else gets to it!)

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 10+ messages in thread

* bug#25018: GC incorrectly removes the temporary root file of the calling process
  2022-10-17  8:51         ` Ludovic Courtès
@ 2022-10-18 15:33           ` Maxim Cournoyer
  0 siblings, 0 replies; 10+ messages in thread
From: Maxim Cournoyer @ 2022-10-18 15:33 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 25018, GNU Debbugs

reopen 25018
quit

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

[...]

> I reverted it in eec920ba93ecb086366576e31b785962fbaf81c2.
>
> The way forward will be to review those tests one by one, make sure they
> were making the “wrong” assumption, adjust them accordingly, and
> possibly add new tests.  It’s not necessarily difficult but takes a bit
> of time.  (In the coming weeks I’m going to try and focus on more urgent
> matters but I’m happy to review if you or someone else gets to it!)

Thanks, and sorry for not noticing the breakage.  I'm reopening the bug
so that we don't forget about it.

-- 
Thanks,
Maxim




^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2022-10-18 15:34 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-11-24 14:07 bug#25018: GC incorrectly removes the temporary root file of the calling process Ludovic Courtès
2022-10-07 20:59 ` Maxim Cournoyer
2022-10-10  8:01   ` Ludovic Courtès
2022-10-10 10:29     ` Maxime Devos
2022-10-10 14:53       ` Ludovic Courtès
2022-10-14 20:30     ` Ludovic Courtès
2022-10-17  1:25       ` Maxim Cournoyer
2022-10-17  8:51         ` Ludovic Courtès
2022-10-18 15:33           ` Maxim Cournoyer
2022-10-10 17:24 ` bug#25018: Broken test suite Ryan Sundberg via Bug reports for GNU Guix

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.