Received: (at 75302) by debbugs.gnu.org; 8 Jan 2025 10:06:21 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Wed Jan 08 05:06:21 2025
Received: from localhost ([127.0.0.1]:46041 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tVSxA-000283-VD
for submit <at> debbugs.gnu.org; Wed, 08 Jan 2025 05:06:21 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:56690)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tVSxA-00027r-4S
for 75302 <at> debbugs.gnu.org; Wed, 08 Jan 2025 05:06:20 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
id 1tVSx2-0000Hb-1b; Wed, 08 Jan 2025 05:06:12 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To:
From; bh=bc8WIUY9RRfrAp1Vj8VDuzZB4S99BoR2JAIWLcWX7q4=; b=HaDqkP2B96UMB1jWc+R9
wQeo4zKylVF2nrMavEJXV7taF5nG3dKj7AWHxVBPE6jc6zAhtn5xy8Dr8omwZKBxuPwUMwXRnSiK1
asSodFsQupHI3bJhGBk9/DYkPB0P4WTcY984vTTYVHt54NwRLJz+c/CjamERHg59SVgXCBecmv/+h
ozl7KR9LmV9Gj0DZovl4wxj5mN0FFaFDkLfE4gsmiCF5owrmtKYiUuQ8ROC4oRR6IqSkHL2SZ4OuA
d6ewBweYjSAjht4/wJnzNBlaz4COfLODpvRHbegi+xNWXOtFWQq1mL7SNkWS623YBbpPZZdc28awd
50o//YZSRcWb4w==;
From: =?utf-8?Q?Ludovic_Court=C3=A8s?= <ludo@HIDDEN>
To: Herman Rimm <herman@HIDDEN>
Subject: Re: [bug#75302] [PATCH] packages: Match renamed origin fields.
In-Reply-To: <pir4su3fxpi27nh4zsrly5bzu4a6zadjruod6uct7phdm3eikf@xiblxxsl7a4q>
(Herman Rimm's message of "Mon, 6 Jan 2025 19:48:46 +0100")
References: <18c0be606434165893e9566caa34aff0f3776a0e.1735851535.git.herman@HIDDEN>
<87h66epa72.fsf@HIDDEN>
<pir4su3fxpi27nh4zsrly5bzu4a6zadjruod6uct7phdm3eikf@xiblxxsl7a4q>
X-URL: http://www.fdn.fr/~lcourtes/
X-Revolutionary-Date: Nonidi 19 =?utf-8?Q?Niv=C3=B4se?= an 233 de la
=?utf-8?Q?R=C3=A9volution=2C?= jour du Marbre
X-PGP-Key-ID: 0x090B11993D9AEBB5
X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc
X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5
X-OS: x86_64-pc-linux-gnu
Date: Wed, 08 Jan 2025 11:06:08 +0100
Message-ID: <87r05dvcvj.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: 75302
Cc: 75302 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)
Hi,
Herman Rimm <herman@HIDDEN> skribis:
> On Sat, Jan 04, 2025 at 09:59:13PM +0100, Ludovic Court=C3=A8s wrote:
>> The patch LGTM but, (1) fields haven=E2=80=99t been renamed recently, an=
d=E2=80=A6
>
> I misunderstood how (match _ (($ _) _)) works. Can you amend the commit
> to start like: 'packages: Replace match with match-record.', instead?
OK.
> In a checkout at b8858d8b1344525d0d7ac78d8fb9dc1a577b85d3 with this
> patch applied, running:
>
> guix shell -CPWN
> ./pre-inst-env guix repl < tests/packages.scm
If you really wanted to do this, try:
./pre-inst-env guile --no-auto-compile tests/packages.scm
I recommend sticking to the documented procedure though.
> I get the three errors mentioned, see attached log. I run the tests
> like this because running:
>
> guix shell -CPWN
> make check TESTS=3D"tests/packages.scm"
>
> returns:
[...]
> [ 77%] LOAD gnu.scm
> ice-9/eval.scm:293:34: error: diff: unbound variable
> hint: Did you forget a `use-modules' form?
> make[2]: *** [Makefile:7518: make-system-go] Error 1
Well, it definitely builds here. Could it be that you have local
changes in your tree? Or perhaps you need =E2=80=98make clean-go=E2=80=99 =
first?
> source-form: (test-assert "package-source-derivation, local-file" (let*=
((file (local-file "../guix/base32.scm")) (package (package (inherit (dumm=
y-package "p")) (source file))) (source (package-source-derivation %store (=
package-source package)))) (and (store-path? source) (string-suffix? "base3=
2.scm" source) (valid-path? %store source) (equal? (call-with-input-file so=
urce get-bytevector-all) (call-with-input-file (search-path %load-path "gui=
x/base32.scm") get-bytevector-all)))))
> Test end:
> result-kind: fail
> actual-value: #f
> actual-error: (system-error "canonicalize-path" "~A: ~S" ("No such file=
or directory" "../guix/base32.scm") (2))
Probably has to do with running the test through standard input =E2=80=98gu=
ix
repl=E2=80=99: in that case it cannot correctly determine what the current =
file
name is, and so relative file name resolution fails.
Ludo=E2=80=99.
guix-patches@HIDDEN:bug#75302; Package guix-patches.
Full text available.
Received: (at 75302) by debbugs.gnu.org; 6 Jan 2025 18:49:56 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Jan 06 13:49:56 2025
Received: from localhost ([127.0.0.1]:40074 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tUsAh-0004Fl-8u
for submit <at> debbugs.gnu.org; Mon, 06 Jan 2025 13:49:56 -0500
Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:33345
helo=email.rimm.ee)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.84_2) (envelope-from <herman@HIDDEN>) id 1tUsAa-0004F6-5o
for 75302 <at> debbugs.gnu.org; Mon, 06 Jan 2025 13:49:49 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman;
t=1736189369;
h=from:from:reply-to:subject:subject:date:date:message-id:message-id:
to:to:cc:cc:mime-version:mime-version:content-type:content-type:
content-transfer-encoding:content-transfer-encoding:
in-reply-to:in-reply-to:references:references;
bh=W8R+e8dJZXPfbAlZl4vBKA1Ds07EERAKKbpargnmFzw=;
b=prY0vjVDe1g6ijilRvpNCVlMG39NudAbz1zxdHujurhlacXuVpiPZEfEQCX4hBOV6uaCbE
WKut0GVyDn9SmcfgtJmFwg9mIp2lzt3mW+MsjWBFcUp4yGUBnZjJYyS2QgtCRcUZ1Y4Usz
J2UavhWLSjzKZQ2REembAsT2d1cf6MnkY9xXzo5G5yF8K40Uu/jaUJR6RekobFquXR4rXY
6Tjq+dp6SjbvXYNBepLjjbtjHzvcVzVr+wH5pIg+X8BPUiCt3xLR4QDOULcCPdQWW1Kytm
tplEwMglBWkOwQmwTpP1F961B1WSruqJkm9yLfyxoDiOs2N1r43PFhrwv7hmPQ==
Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 54d144f3
(TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO);
Mon, 6 Jan 2025 18:49:29 +0000 (UTC)
Date: Mon, 6 Jan 2025 19:48:46 +0100
From: Herman Rimm <herman@HIDDEN>
To: Ludovic =?utf-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Subject: Re: [bug#75302] [PATCH] packages: Match renamed origin fields.
Message-ID: <pir4su3fxpi27nh4zsrly5bzu4a6zadjruod6uct7phdm3eikf@xiblxxsl7a4q>
References: <18c0be606434165893e9566caa34aff0f3776a0e.1735851535.git.herman@HIDDEN>
<87h66epa72.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="scw34k2xpbd75e33"
Content-Disposition: inline
Content-Transfer-Encoding: 8bit
In-Reply-To: <87h66epa72.fsf@HIDDEN>
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 75302
Cc: 75302 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
--scw34k2xpbd75e33
Content-Type: text/plain; charset=utf-8
Content-Disposition: inline
Content-Transfer-Encoding: 8bit
Hello,
On Sat, Jan 04, 2025 at 09:59:13PM +0100, Ludovic Courtès wrote:
> The patch LGTM but, (1) fields haven’t been renamed recently, and…
I misunderstood how (match _ (($ _) _)) works. Can you amend the commit
to start like: 'packages: Replace match with match-record.', instead?
> > Three tests in (tests packages) fail as before:
> > "package-source-derivation, local-file"
> > "package-source-derivation, origin, sha512"
> > "package-source-derivation, origin, sha3-512"
>
> … (2) I don’t see these failures as of
> b8858d8b1344525d0d7ac78d8fb9dc1a577b85d3.
In a checkout at b8858d8b1344525d0d7ac78d8fb9dc1a577b85d3 with this
patch applied, running:
guix shell -CPWN
./pre-inst-env guix repl < tests/packages.scm
I get the three errors mentioned, see attached log. I run the tests
like this because running:
guix shell -CPWN
make check TESTS="tests/packages.scm"
returns:
make check-recursive
make[1]: Entering directory '/home/herman/git/guix'
Making check in po/guix
make[2]: Entering directory '/home/herman/git/guix/po/guix'
make[2]: Nothing to be done for 'check'.
make[2]: Leaving directory '/home/herman/git/guix/po/guix'
Making check in po/packages
make[2]: Entering directory '/home/herman/git/guix/po/packages'
make[2]: Nothing to be done for 'check'.
make[2]: Leaving directory '/home/herman/git/guix/po/packages'
make[2]: Entering directory '/home/herman/git/guix'
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
Compiling Scheme modules...
[ 77%] LOAD gnu.scm
ice-9/eval.scm:293:34: error: diff: unbound variable
hint: Did you forget a `use-modules' form?
make[2]: *** [Makefile:7518: make-system-go] Error 1
make[2]: Leaving directory '/home/herman/git/guix'
make[1]: *** [Makefile:6553: check-recursive] Error 1
make[1]: Leaving directory '/home/herman/git/guix'
make: *** [Makefile:7027: check] Error 2
Cheers,
Herman
--scw34k2xpbd75e33
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="packages.log"
Content-Transfer-Encoding: quoted-printable
%%%% Starting test packages
Group begin: packages
Test begin:
test-name: "printer with location"
source-line: 85
source-form: (test-assert "printer with location" (string-match "^#<packa=
ge foo@0 foo.scm:42 [[:xdigit:]]+>$" (with-output-to-string (lambda () (wri=
te (dummy-package "foo" (location (make-location "foo.scm" 42 7))))))))
Test end:
result-kind: pass
actual-value: #("#<package foo@0 foo.scm:42 7feecae619a0>" (0 . 40))
Test begin:
test-name: "printer without location"
source-line: 93
source-form: (test-assert "printer without location" (string-match "^#<pa=
ckage foo@0 [[:xdigit:]]+>$" (with-output-to-string (lambda () (write (dumm=
y-package "foo" (location #f)))))))
Test end:
result-kind: pass
actual-value: #("#<package foo@0 7feecae61840>" (0 . 29))
Test begin:
test-name: "license type checking"
source-line: 100
source-form: (test-equal "license type checking" (quote bad-license) (gua=
rd (c ((package-license-error? c) (package-error-invalid-license c))) (dumm=
y-package "foo" (license (quote bad-license)))))
Test end:
result-kind: pass
actual-value: bad-license
expected-value: bad-license
Test begin:
test-name: "hidden-package"
source-line: 107
source-form: (test-assert "hidden-package" (and (hidden-package? (hidden-=
package (dummy-package "foo"))) (not (hidden-package? (dummy-package "foo")=
))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-superseded"
source-line: 111
source-form: (test-assert "package-superseded" (let* ((new (dummy-package=
"bar")) (old (deprecated-package "foo" new))) (and (eq? (package-supersede=
d old) new) (mock ((gnu packages) find-best-packages-by-name (const (list o=
ld))) (specification->package "foo") (and (eq? new (specification->package =
"foo")) (eq? new (specification->package+output "foo")))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, zero upgrades"
source-line: 120
source-form: (test-assert "transaction-upgrade-entry, zero upgrades" (let=
* ((old (dummy-package "foo" (version "1"))) (tx (mock ((gnu packages) find=
-best-packages-by-name (const (quote ()))) (transaction-upgrade-entry #f (m=
anifest-entry (inherit (package->manifest-entry old)) (item (string-append =
(%store-prefix) "/" (make-string 32 #\e) "-foo-1"))) (manifest-transaction)=
)))) (manifest-transaction-null? tx)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, zero upgrades, equivalent package"
source-line: 133
source-form: (test-assert "transaction-upgrade-entry, zero upgrades, equi=
valent package" (let* ((old (dummy-package "foo" (version "1"))) (drv (pack=
age-derivation %store old)) (tx (mock ((gnu packages) find-best-packages-by=
-name (const (list old))) (transaction-upgrade-entry %store (manifest-entry=
(inherit (package->manifest-entry old)) (item (derivation->output-path drv=
))) (manifest-transaction))))) (manifest-transaction-null? tx)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, zero upgrades, propagated inputs"
source-line: 146
source-form: (test-assert "transaction-upgrade-entry, zero upgrades, prop=
agated inputs" (let* ((dep (dummy-package "dep" (version "2"))) (old (dummy=
-package "foo" (version "1") (propagated-inputs (list dep)))) (drv (package=
-derivation %store old)) (tx (mock ((gnu packages) find-best-packages-by-na=
me (const (list old))) (transaction-upgrade-entry %store (manifest-entry (i=
nherit (package->manifest-entry old)) (item (derivation->output-path drv)) =
(dependencies (list (manifest-entry (inherit (package->manifest-entry dep))=
(item (derivation->output-path (package-derivation %store dep))))))) (mani=
fest-transaction))))) (manifest-transaction-null? tx)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, one upgrade"
source-line: 168
source-form: (test-assert "transaction-upgrade-entry, one upgrade" (let* =
((old (dummy-package "foo" (version "1"))) (new (dummy-package "foo" (versi=
on "2"))) (tx (mock ((gnu packages) find-best-packages-by-name (const (list=
new))) (transaction-upgrade-entry #f (manifest-entry (inherit (package->ma=
nifest-entry old)) (item (string-append (%store-prefix) "/" (make-string 32=
#\e) "-foo-1"))) (manifest-transaction))))) (and (match (manifest-transact=
ion-install tx) ((($ <manifest-entry> "foo" "2" "out" item)) (eq? item new)=
)) (null? (manifest-transaction-remove tx)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, superseded package"
source-line: 185
source-form: (test-assert "transaction-upgrade-entry, superseded package"=
(let* ((old (dummy-package "foo" (version "1"))) (new (dummy-package "bar"=
(version "2"))) (dep (deprecated-package "foo" new)) (tx (mock ((gnu packa=
ges) find-best-packages-by-name (const (list dep))) (transaction-upgrade-en=
try #f (manifest-entry (inherit (package->manifest-entry old)) (item (strin=
g-append (%store-prefix) "/" (make-string 32 #\e) "-foo-1"))) (manifest-tra=
nsaction))))) (and (match (manifest-transaction-install tx) ((($ <manifest-=
entry> "bar" "2" "out" item)) (eq? item new))) (match (manifest-transaction=
-remove tx) (((? manifest-pattern? pattern)) (and (string=3D? (manifest-pat=
tern-name pattern) "foo") (string=3D? (manifest-pattern-version pattern) "1=
") (string=3D? (manifest-pattern-output pattern) "out")))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "transaction-upgrade-entry, transformation options preserved"
source-line: 207
source-form: (test-equal "transaction-upgrade-entry, transformation optio=
ns preserved" (derivation-file-name (package-derivation %store grep)) (let*=
((old (dummy-package "emacs" (version "1"))) (props (quote ((transformatio=
ns (with-input . "emacs=3Dgrep"))))) (tx (transaction-upgrade-entry %store =
(manifest-entry (inherit (package->manifest-entry old)) (properties props) =
(item (string-append (%store-prefix) "/" (make-string 32 #\e) "-foo-1"))) (=
manifest-transaction)))) (match (manifest-transaction-install tx) (((? mani=
fest-entry? entry)) (and (string=3D? (manifest-entry-version entry) (packag=
e-version grep)) (string=3D? (manifest-entry-name entry) (package-name grep=
)) (equal? (manifest-entry-properties entry) props) (derivation-file-name (=
package-derivation %store (manifest-entry-item entry))))))))
Test end:
result-kind: pass
actual-value: "/gnu/store/89g815zm0040xv4b0yb8v0qragx7kf6s-grep-3.11.drv"
expected-value: "/gnu/store/89g815zm0040xv4b0yb8v0qragx7kf6s-grep-3.11.dr=
v"
Test begin:
test-name: "transaction-upgrade-entry, grafts"
source-line: 230
source-form: (test-assert "transaction-upgrade-entry, grafts" (with-build=
-handler (const (quote failed!)) (parameterize ((%graft? #t)) (let* ((old (=
dummy-package "foo" (version "1"))) (bar (dummy-package "bar" (version "0")=
(replacement old))) (new (dummy-package "foo" (version "1") (inputs (list =
bar)))) (tx (mock ((gnu packages) find-best-packages-by-name (const (list n=
ew))) (transaction-upgrade-entry %store (manifest-entry (inherit (package->=
manifest-entry old)) (item (string-append (%store-prefix) "/" (make-string =
32 #\e) "-foo-1"))) (manifest-transaction))))) (and (match (manifest-transa=
ction-install tx) ((($ <manifest-entry> "foo" "1" "out" item)) (eq? item ne=
w))) (null? (manifest-transaction-remove tx)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-definition-location"
source-line: 254
source-form: (test-assert "package-definition-location" (let ((location (=
package-location hello)) (definition (package-definition-location hello))) =
(and (string=3D? (location-file location) (location-file definition)) (=3D =
0 (location-column definition)) (=3D 2 (location-column location)) (=3D (lo=
cation-line definition) (- (location-line location) 1)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-field-location"
source-line: 265
source-form: (test-assert "package-field-location" (let () (define (goto =
port line column) (unless (and (=3D (port-column port) (- column 1)) (=3D (=
port-line port) (- line 1))) (unless (eof-object? (get-char port)) (goto po=
rt line column)))) (define read-at (match-lambda (($ <location> file line c=
olumn) (call-with-input-file (search-path %load-path file) (lambda (port) (=
goto port line column) (read port)))))) (and (member (read-at (package-fiel=
d-location %bootstrap-guile (quote name))) (let ((name (package-name %boots=
trap-guile))) (list name (quasiquote (name (unquote name)))))) (member (rea=
d-at (package-field-location %bootstrap-guile (quote version))) (let ((vers=
ion (package-version %bootstrap-guile))) (list version (quasiquote (version=
(unquote version)))))) (not (package-field-location %bootstrap-guile (quot=
e does-not-exist))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-field-location, relative file name"
source-line: 292
source-form: (test-equal "package-field-location, relative file name" (lo=
cation-file (package-location %bootstrap-guile)) (with-fluids ((%file-port-=
name-canonicalization (quote absolute))) (location-file (package-field-loca=
tion %bootstrap-guile (quote version)))))
Test end:
result-kind: pass
actual-value: "gnu/packages/bootstrap.scm"
expected-value: "gnu/packages/bootstrap.scm"
Test begin:
test-name: "package-transitive-inputs"
source-line: 297
source-form: (test-assert "package-transitive-inputs" (let* ((a (dummy-pa=
ckage "a")) (b (dummy-package "b" (propagated-inputs (list a)))) (c (dummy-=
package "c" (inputs (list a)))) (d (dummy-package "d" (propagated-inputs (q=
uasiquote (("x" "something.drv")))))) (e (dummy-package "e" (inputs (list b=
c d))))) (and (null? (package-transitive-inputs a)) (equal? (quasiquote ((=
"a" (unquote a)))) (package-transitive-inputs b)) (equal? (quasiquote (("a"=
(unquote a)))) (package-transitive-inputs c)) (equal? (package-propagated-=
inputs d) (package-transitive-inputs d)) (equal? (quasiquote (("b" (unquote=
b)) ("c" (unquote c)) ("d" (unquote d)) ("a" (unquote a)) ("x" "something.=
drv"))) (pk (quote x) (package-transitive-inputs e))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-transitive-inputs, no duplicates"
source-line: 316
source-form: (test-assert "package-transitive-inputs, no duplicates" (let=
* ((a (dummy-package "a")) (b (dummy-package "b" (inputs (quasiquote (("a+"=
(unquote a))))) (native-inputs (quasiquote (("a*" (unquote a))))) (propaga=
ted-inputs (quasiquote (("a" (unquote a))))))) (c (dummy-package "c" (propa=
gated-inputs (quasiquote (("b" (unquote b))))))) (d (dummy-package "d" (inp=
uts (quasiquote (("a" (unquote a)) ("c" (unquote c))))))) (e (dummy-package=
"e" (inputs (quasiquote (("b" (unquote b)) ("c" (unquote c)))))))) (and (n=
ull? (package-transitive-inputs a)) (equal? (quasiquote (("a*" (unquote a))=
("a+" (unquote a)) ("a" (unquote a)))) (package-transitive-inputs b)) (equ=
al? (quasiquote (("b" (unquote b)) ("a" (unquote a)))) (package-transitive-=
inputs c)) (equal? (quasiquote (("a" (unquote a)) ("c" (unquote c)) ("b" (u=
nquote b)))) (package-transitive-inputs d)) (equal? (quasiquote (("b" (unqu=
ote b)) ("c" (unquote c)) ("a" (unquote a)))) (package-transitive-inputs e)=
))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-transitive-supported-systems"
source-line: 338
source-form: (test-equal "package-transitive-supported-systems" (quote ((=
"x" "y" "z") ("x" "y") ("y") ("y") ("y"))) (let* ((a (dummy-package "a" (bu=
ild-system trivial-build-system) (supported-systems (quote ("x" "y" "z"))))=
) (b (dummy-package "b" (build-system trivial-build-system) (supported-syst=
ems (quote ("x" "y"))) (inputs (list a)))) (c (dummy-package "c" (build-sys=
tem trivial-build-system) (supported-systems (quote ("y" "z"))) (inputs (li=
st b)))) (d (dummy-package "d" (build-system trivial-build-system) (support=
ed-systems (quote ("x" "y" "z"))) (inputs (list b c)))) (e (dummy-package "=
e" (build-system trivial-build-system) (supported-systems (quote ("x" "y" "=
z"))) (inputs (list d))))) (list (package-transitive-supported-systems a) (=
package-transitive-supported-systems b) (package-transitive-supported-syste=
ms c) (package-transitive-supported-systems d) (package-transitive-supporte=
d-systems e))))
Test end:
result-kind: pass
actual-value: (("x" "y" "z") ("x" "y") ("y") ("y") ("y"))
expected-value: (("x" "y" "z") ("x" "y") ("y") ("y") ("y"))
Test begin:
test-name: "package-transitive-supported-systems detects cycles"
source-line: 371
source-form: (test-equal "package-transitive-supported-systems detects cy=
cles" (quote ("c" "a" "b" "c")) (letrec* ((a (dummy-package "a" (build-syst=
em trivial-build-system) (native-inputs (list c)))) (b (dummy-package "b" (=
build-system trivial-build-system) (inputs (list a)))) (c (dummy-package "c=
" (build-system trivial-build-system) (inputs (list b))))) (guard (c ((pack=
age-cyclic-dependency-error? c) (map package-name (cons (package-error-pack=
age c) (package-error-dependency-cycle c))))) (package-transitive-supported=
-systems c))))
Test end:
result-kind: pass
actual-value: ("c" "a" "b" "c")
expected-value: ("c" "a" "b" "c")
Test begin:
test-name: "package-development-inputs"
source-line: 388
source-form: (test-assert "package-development-inputs" (lset<=3D equal? (=
quasiquote (("source" (unquote (package-source hello))) (unquote-splicing (=
standard-packages)))) (package-development-inputs hello)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-development-inputs, cross-compilation"
source-line: 395
source-form: (test-assert "package-development-inputs, cross-compilation"=
(lset<=3D equal? (quasiquote (("source" (unquote (package-source hello))) =
(unquote-splicing (standard-cross-packages "mips64el-linux-gnu" (quote host=
))) (unquote-splicing (standard-cross-packages "mips64el-linux-gnu" (quote =
target))))) (package-development-inputs hello #:target "mips64el-linux-gnu"=
)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-closure"
source-line: 402
source-form: (test-assert "package-closure" (let-syntax ((dummy-package/n=
o-implicit (syntax-rules () ((_ name rest ...) (package (inherit (dummy-pac=
kage name rest ...)) (build-system trivial-build-system)))))) (let* ((a (du=
mmy-package/no-implicit "a")) (b (dummy-package/no-implicit "b" (propagated=
-inputs (list a)))) (c (dummy-package/no-implicit "c" (inputs (list a)))) (=
d (dummy-package/no-implicit "d" (native-inputs (list b)))) (e (dummy-packa=
ge/no-implicit "e" (inputs (list c d))))) (lset=3D eq? (list a b c d e) (pa=
ckage-closure (list e)) (package-closure (list e d)) (package-closure (list=
e c b))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "origin-actual-file-name"
source-line: 424
source-form: (test-equal "origin-actual-file-name" "foo-1.tar.gz" (let ((=
o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz")))) (origin-actu=
al-file-name o)))
Test end:
result-kind: pass
actual-value: "foo-1.tar.gz"
expected-value: "foo-1.tar.gz"
Test begin:
test-name: "origin-actual-file-name, file-name"
source-line: 429
source-form: (test-equal "origin-actual-file-name, file-name" "foo-1.tar.=
gz" (let ((o (dummy-origin (uri "http://www.example.com/tarball") (file-nam=
e "foo-1.tar.gz")))) (origin-actual-file-name o)))
Test end:
result-kind: pass
actual-value: "foo-1.tar.gz"
expected-value: "foo-1.tar.gz"
Test begin:
test-name: "package-direct-sources, no source"
source-line: 448
source-form: (test-assert "package-direct-sources, no source" (null? (pac=
kage-direct-sources a)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-direct-sources, #f source"
source-line: 450
source-form: (test-equal "package-direct-sources, #f source" (list i) (pa=
ckage-direct-sources b))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590780>)
expected-value: (#<origin "http://www.example.com" #<content-hash sha256:=
1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590780>)
Test begin:
test-name: "package-direct-sources, not input source"
source-line: 453
source-form: (test-equal "package-direct-sources, not input source" (list=
u) (package-direct-sources d))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590840>)
expected-value: (#<origin "http://www.example.com" #<content-hash sha256:=
1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590840>)
Test begin:
test-name: "package-direct-sources"
source-line: 456
source-form: (test-assert "package-direct-sources" (let ((s (package-dire=
ct-sources c))) (and (=3D (length (pk (quote s-sources) s)) 2) (member o s)=
(member i s))))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590780>)
Test begin:
test-name: "package-direct-sources, with patches"
source-line: 461
source-form: (test-assert "package-direct-sources, with patches" (let ((s=
(package-direct-sources e))) (and (=3D (length (pk (quote s-sources) s)) 2=
) (member o s) (member j s))))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> (#<origin "http://www.e=
xample.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=
xxxxxxxxxxx> () 7feecb590900>) 7feecb590660> #<origin "http://www.example.c=
om" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=
xxx> () 7feecb590900>)
Test begin:
test-name: "package-direct-sources, with patches and inputs"
source-line: 466
source-form: (test-assert "package-direct-sources, with patches and input=
s" (let ((s (package-direct-sources f))) (and (=3D (length (pk (quote s-sou=
rces) s)) 3) (member o s) (member j s) (member u s))))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590840>)
Test begin:
test-name: "package-transitive-sources"
source-line: 472
source-form: (test-assert "package-transitive-sources" (let ((s (package-=
transitive-sources d))) (and (=3D (length (pk (quote d-sources) s)) 3) (mem=
ber o s) (member i s) (member u s))))
Test end:
result-kind: pass
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1x=
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590840> #<orig=
in "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxx=
xxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7feecb590900> #<origin "http://www.example.=
com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx=
xxxx> () 7feecb590780>)
Test begin:
test-name: "transitive-input-references"
source-line: 479
source-form: (test-assert "transitive-input-references" (let* ((a (dummy-=
package "a")) (b (dummy-package "b")) (c (dummy-package "c" (inputs (quasiq=
uote (("a" (unquote a))))) (propagated-inputs (quasiquote (("boo" (unquote =
b))))))) (d (dummy-package "d" (inputs (quasiquote (("c*" (unquote c)))))))=
(keys (map (match-lambda (((quote assoc-ref) (quote l) key) key)) (pk (quo=
te refs) (transitive-input-references (quote l) (package-inputs d)))))) (an=
d (=3D (length keys) 2) (member "c*" keys) (member "boo" keys))))
Test end:
result-kind: pass
actual-value: ("boo")
Test begin:
test-name: "package-transitive-supported-systems, implicit inputs"
source-line: 496
source-form: (test-equal "package-transitive-supported-systems, implicit =
inputs" (filter target-linux? %supported-systems) (let ((p (dummy-package "=
foo" (build-system gnu-build-system) (supported-systems (quasiquote ("does-=
not-exist" "foobar" (unquote-splicing %supported-systems))))))) (parameteri=
ze ((%current-system "armhf-linux")) (package-transitive-supported-systems =
p))))
Test end:
result-kind: pass
actual-value: ("x86_64-linux" "mips64el-linux" "aarch64-linux" "powerpc64=
le-linux" "riscv64-linux" "i686-linux" "armhf-linux" "powerpc-linux")
expected-value: ("x86_64-linux" "mips64el-linux" "aarch64-linux" "powerpc=
64le-linux" "riscv64-linux" "i686-linux" "armhf-linux" "powerpc-linux")
Test begin:
test-name: "package-transitive-supported-systems: reduced binary seed, im=
plicit inputs"
source-line: 508
source-form: (test-equal "package-transitive-supported-systems: reduced b=
inary seed, implicit inputs" (quote ("x86_64-linux" "i686-linux")) (let ((p=
(dummy-package "foo" (build-system gnu-build-system) (supported-systems (q=
uasiquote ("does-not-exist" "foobar" (unquote-splicing %supported-systems))=
))))) (parameterize ((%current-system "x86_64-linux")) (package-transitive-=
supported-systems p))))
Test end:
result-kind: pass
actual-value: ("x86_64-linux" "i686-linux")
expected-value: ("x86_64-linux" "i686-linux")
Test begin:
test-name: "supported-package?"
source-line: 520
source-form: (test-assert "supported-package?" (let* ((d (dummy-package "=
dep" (build-system trivial-build-system) (supported-systems (quote ("x86_64=
-linux"))))) (p (dummy-package "foo" (build-system gnu-build-system) (input=
s (list d)) (supported-systems (quote ("x86_64-linux" "armhf-linux")))))) (=
and (supported-package? p "x86_64-linux") (not (supported-package? p "i686-=
linux")) (not (supported-package? p "armhf-linux")))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "supported-package? vs. system-dependent graph"
source-line: 532
source-form: (test-assert "supported-package? vs. system-dependent graph"=
(let* ((p0a (dummy-package "foo-arm" (build-system trivial-build-system) (=
supported-systems (quote ("armhf-linux"))))) (p0b (dummy-package "foo-x86_6=
4" (build-system trivial-build-system) (supported-systems (quote ("x86_64-l=
inux"))))) (p (dummy-package "bar" (build-system trivial-build-system) (inp=
uts (if (string=3D? (%current-system) "armhf-linux") (quasiquote (("foo" (u=
nquote p0a)))) (quasiquote (("foo" (unquote p0b))))))))) (and (supported-pa=
ckage? p "x86_64-linux") (supported-package? p "armhf-linux"))))
Test end:
result-kind: pass
actual-value: ("armhf-linux")
Test begin:
test-name: "supported-package? vs. %current-target-system"
source-line: 552
source-form: (test-assert "supported-package? vs. %current-target-system"=
(parameterize ((%current-target-system "arm-linux-gnueabihf")) (let ((p (d=
ummy-package "foo" (build-system gnu-build-system) (supported-systems (quot=
e ("x86_64-linux" "armhf-linux")))))) (and (supported-package? p "x86_64-li=
nux") (not (supported-package? p "i686-linux")) (supported-package? p "armh=
f-linux")))))
Test end:
result-kind: pass
actual-value: ("armhf-linux")
Test begin:
test-name: "package-source-derivation, file"
source-line: 564
source-form: (test-assert "package-source-derivation, file" (let* ((file =
(search-path %load-path "guix.scm")) (package (package (inherit (dummy-pack=
age "p")) (source file))) (source (package-source-derivation %store (packag=
e-source package)))) (and (store-path? source) (valid-path? %store source) =
(equal? (call-with-input-file source get-bytevector-all) (call-with-input-f=
ile file get-bytevector-all)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-source-derivation, store path"
source-line: 575
source-form: (test-assert "package-source-derivation, store path" (let* (=
(file (add-to-store %store "guix.scm" #t "sha256" (search-path %load-path "=
guix.scm"))) (package (package (inherit (dummy-package "p")) (source file))=
) (source (package-source-derivation %store (package-source package)))) (st=
ring=3D? file source)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-source-derivation, indirect store path"
source-line: 584
source-form: (test-assert "package-source-derivation, indirect store path=
" (let* ((dir (add-to-store %store "guix-build" #t "sha256" (dirname (searc=
h-path %load-path "guix/build/utils.scm")))) (package (package (inherit (du=
mmy-package "p")) (source (string-append dir "/utils.scm")))) (source (pack=
age-source-derivation %store (package-source package)))) (and (direct-store=
-path? source) (string-suffix? "utils.scm" source))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-source-derivation, local-file"
source-line: 595
source-form: (test-assert "package-source-derivation, local-file" (let* (=
(file (local-file "../guix/base32.scm")) (package (package (inherit (dummy-=
package "p")) (source file))) (source (package-source-derivation %store (pa=
ckage-source package)))) (and (store-path? source) (string-suffix? "base32.=
scm" source) (valid-path? %store source) (equal? (call-with-input-file sour=
ce get-bytevector-all) (call-with-input-file (search-path %load-path "guix/=
base32.scm") get-bytevector-all)))))
Test end:
result-kind: fail
actual-value: #f
actual-error: (system-error "canonicalize-path" "~A: ~S" ("No such file o=
r directory" "../guix/base32.scm") (2))
Test begin:
test-name: "package-source-derivation, origin, sha512"
source-line: 609
source-form: (test-equal "package-source-derivation, origin, sha512" "hel=
lo" (let* ((bash (search-bootstrap-binary "bash" (%current-system))) (build=
er (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" (=
quote ()))) (method (lambda* (url hash-algo hash #:optional name #:rest res=
t) (and (eq? hash-algo (quote sha512)) (raw-derivation name bash (list buil=
der) #:sources (list builder) #:hash hash #:hash-algo hash-algo)))) (source=
(origin (method method) (uri "unused://") (file-name "origin-sha512") (has=
h (content-hash (gcrypt:bytevector-hash (string->utf8 "hello") (gcrypt:look=
up-hash-algorithm (quote sha512))) sha512)))) (drv (package-source-derivati=
on %store source)) (output (derivation->output-path drv))) (build-derivatio=
ns %store (list drv)) (call-with-input-file output get-string-all)))
Test end:
result-kind: fail
actual-value: #f
actual-error: (%exception #<&store-protocol-error message: "build of `/gn=
u/store/km82fxzrhcc67hnsyrskwvlpgsy2fscz-origin-sha512.drv' failed" status:=
1>)
expected-value: "hello"
Test begin:
test-name: "package-source-derivation, origin, sha3-512"
source-line: 635
source-form: (test-equal "package-source-derivation, origin, sha3-512" "h=
ello, sha3" (let* ((bash (search-bootstrap-binary "bash" (%current-system))=
) (builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello, =
sha3 > $out" (quote ()))) (method (lambda* (url hash-algo hash #:optional n=
ame #:rest rest) (and (eq? hash-algo (quote sha3-512)) (raw-derivation name=
bash (list builder) #:sources (list builder) #:hash hash #:hash-algo hash-=
algo)))) (source (origin (method method) (uri "unused://") (file-name "orig=
in-sha3") (hash (content-hash (gcrypt:bytevector-hash (string->utf8 "hello,=
sha3") (gcrypt:lookup-hash-algorithm (quote sha3-512))) sha3-512)))) (drv =
(package-source-derivation %store source)) (output (derivation->output-path=
drv))) (build-derivations %store (list drv)) (call-with-input-file output =
get-string-all)))
Test end:
result-kind: fail
actual-value: #f
actual-error: (%exception #<&store-protocol-error message: "build of `/gn=
u/store/bcpj7ha0ipcc6nd1mqyj0ca50ldh7wjp-origin-sha3.drv' failed" status: 1=
>)
expected-value: "hello, sha3"
Test begin:
test-name: "package-upstream-name*"
source-line: 661
source-form: (test-equal "package-upstream-name*" (package-upstream-name*=
(specification->package "guile-gcrypt")) "gcrypt")
Test end:
result-kind: pass
actual-value: "gcrypt"
expected-value: "gcrypt"
Test begin:
test-name: "package-source-derivation, snippet"
source-line: 671
source-form: (test-equal "package-source-derivation, snippet" "OK" (let* =
((source (bootstrap-origin (origin (inherit (bootstrap-guile-origin (%curre=
nt-system))) (patch-inputs (quasiquote (("tar" (unquote %bootstrap-coreutil=
s&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("patch" (unquote %bootstra=
p-coreutils&co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix b=
uild utils)))) (snippet (quote (begin (chmod "." 511) (symlink "guile" "gui=
le-rocks") (copy-recursively "../share/guile/2.0/scripts" "scripts") (chmod=
".." 511))))))) (package (package (inherit (dummy-package "with-snippet"))=
(source source) (build-system trivial-build-system) (inputs (quasiquote ((=
"tar" (unquote (search-bootstrap-binary "tar" (%current-system)))) ("xz" (u=
nquote (search-bootstrap-binary "xz" (%current-system))))))) (arguments (qu=
asiquote (#:guile (unquote %bootstrap-guile) #:modules ((guix build utils))=
#:builder (begin (use-modules (guix build utils)) (let ((tar (assoc-ref %b=
uild-inputs "tar")) (xz (assoc-ref %build-inputs "xz")) (source (assoc-ref =
%build-inputs "source"))) (invoke tar "xvf" source "--use-compress-program"=
xz) (unless (and (string=3D? "guile" (readlink "bin/guile-rocks")) (file-e=
xists? "bin/scripts/compile.scm")) (error "the snippet apparently failed"))=
(let ((out (assoc-ref %outputs "out"))) (call-with-output-file out (lambda=
(p) (display "OK" p)))) #t))))))) (drv (package-derivation %store package)=
) (out (derivation->output-path drv))) (and (build-derivations %store (list=
(pk (quote snippet-drv) drv))) (call-with-input-file out get-string-all))))
Test end:
result-kind: pass
actual-value: "OK"
expected-value: "OK"
Test begin:
test-name: "origin->derivation, single file with snippet (compression: gz=
ip)"
source-line: 736
source-form: (test-equal (string-append "origin->derivation, single file =
with snippet " "(compression: " (if comp comp "None") ")") "2 + 2 =3D 4" (l=
et*-values (((name) "maths") ((compressed-name) (if comp (string-append nam=
e "." ext) name)) ((file hash) (test-file %store compressed-name "2 + 2 =3D=
5")) ((source) (origin (method url-fetch) (uri (string-append "file://" fi=
le)) (file-name compressed-name) (patch-inputs (quasiquote (("tar" (unquote=
%bootstrap-coreutils&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("bzip2=
" (unquote %bootstrap-coreutils&co)) ("gzip" (unquote %bootstrap-coreutils&=
co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix build utils))=
)) (snippet (quasiquote (substitute* (unquote name) (("5") "4")))) (hash (c=
ontent-hash hash)))) ((drv) (run-with-store %store (origin->derivation sour=
ce))) ((out) (derivation->output-path drv))) (and (build-derivations %store=
(list drv)) (if (tarball? out) (let* ((bin (gexp (string-append (ungexp-na=
tive %bootstrap-coreutils&co) "/bin"))) (f (computed-file name (with-import=
ed-modules (quote ((guix build utils))) (gexp (begin (use-modules (guix bui=
ld utils)) (setenv "PATH" (ungexp-native bin)) (invoke "tar" "xvf" (ungexp-=
native out)) (copy-file (ungexp-native name) (ungexp output))))) #:guile %b=
ootstrap-guile)) (drv (run-with-store %store (lower-object f))) (_ (build-d=
erivations %store (list drv)))) (call-with-input-file (derivation->output-p=
ath drv) get-string-all)) (call-with-input-file out get-string-all)))))
Test end:
result-kind: pass
actual-value: "2 + 2 =3D 4"
expected-value: "2 + 2 =3D 4"
Test begin:
test-name: "origin->derivation, single file with snippet (compression: xz=
)"
source-line: 736
source-form: (test-equal (string-append "origin->derivation, single file =
with snippet " "(compression: " (if comp comp "None") ")") "2 + 2 =3D 4" (l=
et*-values (((name) "maths") ((compressed-name) (if comp (string-append nam=
e "." ext) name)) ((file hash) (test-file %store compressed-name "2 + 2 =3D=
5")) ((source) (origin (method url-fetch) (uri (string-append "file://" fi=
le)) (file-name compressed-name) (patch-inputs (quasiquote (("tar" (unquote=
%bootstrap-coreutils&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("bzip2=
" (unquote %bootstrap-coreutils&co)) ("gzip" (unquote %bootstrap-coreutils&=
co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix build utils))=
)) (snippet (quasiquote (substitute* (unquote name) (("5") "4")))) (hash (c=
ontent-hash hash)))) ((drv) (run-with-store %store (origin->derivation sour=
ce))) ((out) (derivation->output-path drv))) (and (build-derivations %store=
(list drv)) (if (tarball? out) (let* ((bin (gexp (string-append (ungexp-na=
tive %bootstrap-coreutils&co) "/bin"))) (f (computed-file name (with-import=
ed-modules (quote ((guix build utils))) (gexp (begin (use-modules (guix bui=
ld utils)) (setenv "PATH" (ungexp-native bin)) (invoke "tar" "xvf" (ungexp-=
native out)) (copy-file (ungexp-native name) (ungexp output))))) #:guile %b=
ootstrap-guile)) (drv (run-with-store %store (lower-object f))) (_ (build-d=
erivations %store (list drv)))) (call-with-input-file (derivation->output-p=
ath drv) get-string-all)) (call-with-input-file out get-string-all)))))
Test end:
result-kind: pass
actual-value: "2 + 2 =3D 4"
expected-value: "2 + 2 =3D 4"
Test begin:
test-name: "origin->derivation, single file with snippet (compression: bz=
ip2)"
source-line: 736
source-form: (test-equal (string-append "origin->derivation, single file =
with snippet " "(compression: " (if comp comp "None") ")") "2 + 2 =3D 4" (l=
et*-values (((name) "maths") ((compressed-name) (if comp (string-append nam=
e "." ext) name)) ((file hash) (test-file %store compressed-name "2 + 2 =3D=
5")) ((source) (origin (method url-fetch) (uri (string-append "file://" fi=
le)) (file-name compressed-name) (patch-inputs (quasiquote (("tar" (unquote=
%bootstrap-coreutils&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("bzip2=
" (unquote %bootstrap-coreutils&co)) ("gzip" (unquote %bootstrap-coreutils&=
co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix build utils))=
)) (snippet (quasiquote (substitute* (unquote name) (("5") "4")))) (hash (c=
ontent-hash hash)))) ((drv) (run-with-store %store (origin->derivation sour=
ce))) ((out) (derivation->output-path drv))) (and (build-derivations %store=
(list drv)) (if (tarball? out) (let* ((bin (gexp (string-append (ungexp-na=
tive %bootstrap-coreutils&co) "/bin"))) (f (computed-file name (with-import=
ed-modules (quote ((guix build utils))) (gexp (begin (use-modules (guix bui=
ld utils)) (setenv "PATH" (ungexp-native bin)) (invoke "tar" "xvf" (ungexp-=
native out)) (copy-file (ungexp-native name) (ungexp output))))) #:guile %b=
ootstrap-guile)) (drv (run-with-store %store (lower-object f))) (_ (build-d=
erivations %store (list drv)))) (call-with-input-file (derivation->output-p=
ath drv) get-string-all)) (call-with-input-file out get-string-all)))))
Test end:
result-kind: pass
actual-value: "2 + 2 =3D 4"
expected-value: "2 + 2 =3D 4"
Test begin:
test-name: "origin->derivation, single file with snippet (compression: No=
ne)"
source-line: 736
source-form: (test-equal (string-append "origin->derivation, single file =
with snippet " "(compression: " (if comp comp "None") ")") "2 + 2 =3D 4" (l=
et*-values (((name) "maths") ((compressed-name) (if comp (string-append nam=
e "." ext) name)) ((file hash) (test-file %store compressed-name "2 + 2 =3D=
5")) ((source) (origin (method url-fetch) (uri (string-append "file://" fi=
le)) (file-name compressed-name) (patch-inputs (quasiquote (("tar" (unquote=
%bootstrap-coreutils&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("bzip2=
" (unquote %bootstrap-coreutils&co)) ("gzip" (unquote %bootstrap-coreutils&=
co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix build utils))=
)) (snippet (quasiquote (substitute* (unquote name) (("5") "4")))) (hash (c=
ontent-hash hash)))) ((drv) (run-with-store %store (origin->derivation sour=
ce))) ((out) (derivation->output-path drv))) (and (build-derivations %store=
(list drv)) (if (tarball? out) (let* ((bin (gexp (string-append (ungexp-na=
tive %bootstrap-coreutils&co) "/bin"))) (f (computed-file name (with-import=
ed-modules (quote ((guix build utils))) (gexp (begin (use-modules (guix bui=
ld utils)) (setenv "PATH" (ungexp-native bin)) (invoke "tar" "xvf" (ungexp-=
native out)) (copy-file (ungexp-native name) (ungexp output))))) #:guile %b=
ootstrap-guile)) (drv (run-with-store %store (lower-object f))) (_ (build-d=
erivations %store (list drv)))) (call-with-input-file (derivation->output-p=
ath drv) get-string-all)) (call-with-input-file out get-string-all)))))
Test end:
result-kind: pass
actual-value: "2 + 2 =3D 4"
expected-value: "2 + 2 =3D 4"
Test begin:
test-name: "return value"
source-line: 783
source-form: (test-assert "return value" (let ((drv (package-derivation %=
store (dummy-package "p")))) (and (derivation? drv) (file-exists? (derivati=
on-file-name drv)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-derivation, inputs deduplicated"
source-line: 788
source-form: (test-assert "package-derivation, inputs deduplicated" (let*=
((dep (dummy-package "dep")) (p0 (dummy-package "p" (inputs (list dep)))) =
(p1 (package (inherit p0) (inputs (quasiquote (("dep" (unquote (package (in=
herit dep)))) (unquote-splicing (package-inputs p0)))))))) (string=3D? (der=
ivation-file-name (package-derivation %store p0)) (derivation-file-name (pa=
ckage-derivation %store p1)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-derivation, different system"
source-line: 801
source-form: (test-assert "package-derivation, different system" (let* ((=
system (if (string=3D? (%current-system) "x86_64-linux") "aarch64-linux" "x=
86_64-linux")) (drv (package-derivation %store (dummy-package "p") system #=
:graft? #f))) (define right-system? (mlambdaq (drv) (and (string=3D? (deriv=
ation-system drv) system) (every (compose right-system? derivation-input-de=
rivation) (derivation-inputs drv))))) (right-system? drv)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-output"
source-line: 816
source-form: (test-assert "package-output" (let* ((package (dummy-package=
"p")) (drv (package-derivation %store package))) (and (derivation? drv) (s=
tring=3D? (derivation->output-path drv) (package-output %store package "out=
")))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "patch not found yields a run-time error"
source-line: 823
source-form: (test-equal "patch not found yields a run-time error" (quote=
("~a: patch not found\n" "does-not-exist.patch")) (guard (c ((formatted-me=
ssage? c) (cons (formatted-message-string c) (formatted-message-arguments c=
)))) (let ((p (package (inherit (dummy-package "p")) (source (origin (metho=
d (const #f)) (uri "http://whatever") (patches (list (search-patch "does-no=
t-exist.patch"))) (sha256 (base32 "0amn0bbwqvsvvsh6drfwz20ydc2czk374lzw5kks=
bh6bf78k4ks4"))))))) (package-derivation %store p) #f)))
Test end:
result-kind: pass
actual-value: ("~a: patch not found\n" "does-not-exist.patch")
expected-value: ("~a: patch not found\n" "does-not-exist.patch")
Test begin:
test-name: "&package-input-error"
source-line: 842
source-form: (test-equal "&package-input-error" (list dummy (quasiquote (=
"x" (unquote (current-module))))) (guard (c ((package-input-error? c) (list=
(package-error-package c) (package-error-invalid-input c)))) (package-deri=
vation %store dummy)))
Test end:
result-kind: pass
actual-value: (#<package foo@0 7feec5502580> ("x" #<directory (tests pack=
ages) 7feedcb7ca00>))
expected-value: (#<package foo@0 7feec5502580> ("x" #<directory (tests pa=
ckages) 7feedcb7ca00>))
Test begin:
test-name: "reference to non-existent output"
source-line: 849
source-form: (test-assert "reference to non-existent output" (parameteriz=
e ((%graft? #f)) (let* ((dep (dummy-package "dep")) (p (dummy-package "p" (=
inputs (list (quasiquote ((unquote dep) "non-existent"))))))) (guard (c ((d=
erivation-missing-output-error? c) (and (string=3D? (derivation-missing-out=
put c) "non-existent") (equal? (package-derivation %store dep) (derivation-=
error-derivation c))))) (package-derivation %store p)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial"
source-line: 861
source-form: (test-assert "trivial" (let* ((p (package (inherit (dummy-pa=
ckage "trivial")) (build-system trivial-build-system) (source #f) (argument=
s (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (begin (mkdir %=
output) (call-with-output-file (string-append %output "/test") (lambda (p) =
(display (quote (hello guix)) p))) #t)))))) (d (package-derivation %store p=
))) (and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (de=
rivation->output-path d)))) (equal? (quote (hello guix)) (call-with-input-f=
ile (string-append p "/test") read))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial with local file as input"
source-line: 880
source-form: (test-assert "trivial with local file as input" (let* ((i (s=
earch-path %load-path "ice-9/boot-9.scm")) (p (package (inherit (dummy-pack=
age "trivial-with-input-file")) (build-system trivial-build-system) (source=
#f) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (=
begin (copy-file (assoc-ref %build-inputs "input") %output) #t)))) (inputs =
(quasiquote (("input" (unquote i))))))) (d (package-derivation %store p))) =
(and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (deriva=
tion->output-path d)))) (equal? (call-with-input-file p get-bytevector-all)=
(call-with-input-file i get-bytevector-all))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial with source"
source-line: 898
source-form: (test-assert "trivial with source" (let* ((i (search-path %l=
oad-path "ice-9/boot-9.scm")) (p (package (inherit (dummy-package "trivial-=
with-source")) (build-system trivial-build-system) (source i) (arguments (q=
uasiquote (#:guile (unquote %bootstrap-guile) #:builder (begin (copy-file (=
assoc-ref %build-inputs "source") %output) #t)))))) (d (package-derivation =
%store p))) (and (build-derivations %store (list d)) (let ((p (derivation->=
output-path d))) (equal? (call-with-input-file p get-bytevector-all) (call-=
with-input-file i get-bytevector-all))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial with system-dependent input"
source-line: 915
source-form: (test-assert "trivial with system-dependent input" (let* ((p=
(package (inherit (dummy-package "trivial-system-dependent-input")) (build=
-system trivial-build-system) (source #f) (arguments (quasiquote (#:guile (=
unquote %bootstrap-guile) #:modules ((guix build utils)) #:builder (begin (=
use-modules (guix build utils)) (let ((out (assoc-ref %outputs "out")) (bas=
h (assoc-ref %build-inputs "bash"))) (invoke bash "-c" (format #f "echo hel=
lo > ~a" out))))))) (inputs (quasiquote (("bash" (unquote (search-bootstrap=
-binary "bash" (%current-system))))))))) (d (package-derivation %store p)))=
(and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (deriv=
ation->output-path d)))) (eq? (quote hello) (call-with-input-file p read)))=
)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial with #:allowed-references"
source-line: 936
source-form: (test-assert "trivial with #:allowed-references" (let* ((p (=
package (inherit (dummy-package "trivial")) (build-system trivial-build-sys=
tem) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:allowed-r=
eferences ((unquote %bootstrap-guile)) #:builder (begin (mkdir %output) (sy=
mlink %output (string-append %output "/self")) #t)))))) (d (package-derivat=
ion %store p))) (guard (c ((store-protocol-error? c) #t)) (build-derivation=
s %store (list d)) #f)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "trivial with #:allowed-references + grafts"
source-line: 955
source-form: (test-assert "trivial with #:allowed-references + grafts" (l=
et* ((g (package (inherit %bootstrap-guile) (replacement (package (inherit =
%bootstrap-guile) (version "9.9"))))) (p (package (inherit (dummy-package "=
trivial")) (build-system trivial-build-system) (inputs (list g)) (arguments=
(quasiquote (#:guile (unquote g) #:allowed-references ((unquote g)) #:buil=
der (mkdir %output)))))) (d0 (package-derivation %store p #:graft? #f)) (d1=
(parameterize ((%graft? #t)) (package-derivation %store p #:graft? #t)))) =
(string=3D? (derivation-file-name d1) (derivation-file-name d0))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "search paths"
source-line: 977
source-form: (test-assert "search paths" (let* ((p (make-prompt-tag "retu=
rn-search-paths")) (t (make-parameter "guile-0")) (s (build-system (name (q=
uote raw)) (description "Raw build system with direct store access") (lower=
(lambda* (name #:key source inputs system target #:allow-other-keys) (bag =
(name name) (system system) (target target) (build-inputs inputs) (build (l=
ambda* (name inputs #:key outputs system search-paths) (if (string=3D? name=
(t)) (abort-to-prompt p search-paths) (gexp->derivation name (gexp (mkdir =
(ungexp output)))))))))))) (x (list (search-path-specification (variable "G=
UILE_LOAD_PATH") (files (quote ("share/guile/site/2.0")))) (search-path-spe=
cification (variable "GUILE_LOAD_COMPILED_PATH") (files (quote ("share/guil=
e/site/2.0")))))) (a (package (inherit (dummy-package "guile")) (build-syst=
em s) (native-search-paths x))) (b (package (inherit (dummy-package "guile-=
foo")) (build-system s) (inputs (quasiquote (("guile" (unquote a))))))) (c =
(package (inherit (dummy-package "guile-bar")) (build-system s) (inputs (qu=
asiquote (("guile" (unquote a)) ("guile-foo" (unquote b)))))))) (let-syntax=
((collect (syntax-rules () ((_ body ...) (call-with-prompt p (lambda () bo=
dy ...) (lambda (k search-paths) search-paths)))))) (and (null? (collect (p=
ackage-derivation %store a))) (parameterize ((t "guile-foo-0")) (equal? x (=
collect (package-derivation %store b)))) (parameterize ((t "guile-bar-0")) =
(equal? x (collect (package-derivation %store c))))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-transitive-native-search-paths"
source-line: 1025
source-form: (test-assert "package-transitive-native-search-paths" (let* =
((sp (lambda (name) (list (search-path-specification (variable name) (files=
(quote ("foo/bar"))))))) (p0 (dummy-package "p0" (native-search-paths (sp =
"PATH0")))) (p1 (dummy-package "p1" (native-search-paths (sp "PATH1")))) (p=
2 (dummy-package "p2" (native-search-paths (sp "PATH2")) (inputs (list p0))=
(propagated-inputs (list p1)))) (p3 (dummy-package "p3" (native-search-pat=
hs (sp "PATH3")) (native-inputs (list p0)) (propagated-inputs (list p2)))))=
(lset=3D string=3D? (quote ("PATH1" "PATH2" "PATH3")) (map search-path-spe=
cification-variable (package-transitive-native-search-paths p3)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-cross-derivation"
source-line: 1045
source-form: (test-assert "package-cross-derivation" (let ((drv (package-=
cross-derivation %store (dummy-package "p") "mips64el-linux-gnu"))) (and (d=
erivation? drv) (file-exists? (derivation-file-name drv)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-cross-derivation, trivial-build-system"
source-line: 1051
source-form: (test-assert "package-cross-derivation, trivial-build-system=
" (let ((p (package (inherit (dummy-package "p")) (build-system trivial-bui=
ld-system) (arguments (quote (#:builder (exit 1))))))) (let ((drv (package-=
cross-derivation %store p "mips64el-linux-gnu"))) (derivation? drv))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-cross-derivation, no cross builder"
source-line: 1058
source-form: (test-assert "package-cross-derivation, no cross builder" (l=
et* ((b (build-system (inherit trivial-build-system) (lower (const #f)))) (=
p (package (inherit (dummy-package "p")) (build-system b)))) (guard (c ((pa=
ckage-cross-build-system-error? c) (eq? (package-error-package c) p))) (pac=
kage-cross-derivation %store p "mips64el-linux-gnu") #f)))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-grafts, indirect grafts"
source-line: 1086
source-form: (test-assert "package-grafts, indirect grafts" (let* ((new (=
dummy-package "dep" (arguments (quote (#:implicit-inputs? #f))))) (dep (pac=
kage (inherit new) (version "0.0"))) (dep* (package (inherit dep) (replacem=
ent new))) (dummy (dummy-package "dummy" (arguments (quote (#:implicit-inpu=
ts? #f))) (inputs (list dep*))))) (equal? (package-grafts %store dummy) (li=
st (graft (origin (package-derivation %store dep)) (replacement (package-de=
rivation %store new)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-grafts, indirect grafts, propagated inputs"
source-line: 1119
source-form: (test-assert "package-grafts, indirect grafts, propagated in=
puts" (let* ((new (dummy-package "dep" (arguments (quote (#:implicit-inputs=
? #f))))) (dep (package (inherit new) (version "0.0"))) (dep* (package (inh=
erit dep) (replacement new))) (prop (dummy-package "propagated" (propagated=
-inputs (list dep*)) (arguments (quote (#:implicit-inputs? #f))))) (dummy (=
dummy-package "dummy" (arguments (quote (#:implicit-inputs? #f))) (inputs (=
list prop))))) (equal? (package-grafts %store dummy) (list (graft (origin (=
package-derivation %store dep)) (replacement (package-derivation %store new=
)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-grafts, same replacement twice"
source-line: 1135
source-form: (test-assert "package-grafts, same replacement twice" (let* =
((new (dummy-package "dep" (version "1") (arguments (quote (#:implicit-inpu=
ts? #f))))) (dep (package (inherit new) (version "0") (replacement new))) (=
p1 (dummy-package "intermediate1" (arguments (quote (#:implicit-inputs? #f)=
)) (inputs (list dep)))) (p2 (dummy-package "intermediate2" (arguments (quo=
te (#:implicit-inputs? #f))) (inputs (list (package (inherit dep)))))) (p3 =
(dummy-package "final" (arguments (quote (#:implicit-inputs? #f))) (inputs =
(list p1 p2))))) (equal? (package-grafts %store p3) (list (graft (origin (p=
ackage-derivation %store (package (inherit dep) (replacement #f)))) (replac=
ement (package-derivation %store new)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-grafts, dependency on several outputs"
source-line: 1159
source-form: (test-assert "package-grafts, dependency on several outputs"=
(letrec* ((p0 (dummy-package "p0" (version "1.0") (replacement p0*) (argum=
ents (quote (#:implicit-inputs? #f))) (outputs (quote ("out" "lib"))))) (p0=
* (package (inherit p0) (version "1.1"))) (p1 (dummy-package "p1" (argument=
s (quote (#:implicit-inputs? #f))) (inputs (list p0 (quasiquote ((unquote p=
0) "lib"))))))) (lset=3D equal? (pk (package-grafts %store p1)) (list (graf=
t (origin (package-derivation %store p0)) (origin-output "out") (replacemen=
t (package-derivation %store p0*)) (replacement-output "out")) (graft (orig=
in (package-derivation %store p0)) (origin-output "lib") (replacement (pack=
age-derivation %store p0*)) (replacement-output "lib"))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "replacement also grafted"
source-line: 1182
source-form: (test-assert "replacement also grafted" (let* ((p1r (dummy-p=
ackage "P1" (build-system trivial-build-system) (arguments (quasiquote (#:g=
uile (unquote %bootstrap-guile) #:builder (let ((out (assoc-ref %outputs "o=
ut"))) (mkdir out) (call-with-output-file (string-append out "/replacement"=
) (const #t)))))))) (p1 (package (inherit p1r) (name "p1") (replacement p1r=
) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (beg=
in (mkdir (assoc-ref %outputs "out")) #t)))))) (p2r (dummy-package "P2" (bu=
ild-system trivial-build-system) (inputs (list p1)) (arguments (quasiquote =
(#:guile (unquote %bootstrap-guile) #:builder (let ((out (assoc-ref %output=
s "out"))) (mkdir out) (chdir out) (symlink (assoc-ref %build-inputs "p1") =
"p1") (call-with-output-file (string-append out "/replacement") (const #t))=
)))))) (p2 (package (inherit p2r) (name "p2") (replacement p2r) (arguments =
(quasiquote (#:guile (unquote %bootstrap-guile) #:builder (let ((out (assoc=
-ref %outputs "out"))) (mkdir out) (chdir out) (symlink (assoc-ref %build-i=
nputs "p1") "p1") #t)))))) (p3 (dummy-package "p3" (build-system trivial-bu=
ild-system) (inputs (list p2)) (arguments (quasiquote (#:guile (unquote %bo=
otstrap-guile) #:builder (let ((out (assoc-ref %outputs "out"))) (mkdir out=
) (chdir out) (symlink (assoc-ref %build-inputs "p2") "p2") #t))))))) (lset=
=3D equal? (package-grafts %store p3) (list (graft (origin (package-derivat=
ion %store p1 #:graft? #f)) (replacement (package-derivation %store p1r))) =
(graft (origin (package-derivation %store p2 #:graft? #f)) (replacement (pa=
ckage-derivation %store p2r #:graft? #t)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package->bag"
source-line: 1279
source-form: (test-equal "package->bag" (parameterize ((%current-system "=
foo86-hurd")) (quasiquote ("foo86-hurd" #f ((unquote (package-source gnu-ma=
ke))) ((unquote (canonical-package glibc))) ((unquote (canonical-package co=
reutils)))))) (let ((bag (package->bag gnu-make "foo86-hurd"))) (list (bag-=
system bag) (bag-target bag) (assoc-ref (bag-build-inputs bag) "source") (a=
ssoc-ref (bag-build-inputs bag) "libc") (assoc-ref (bag-build-inputs bag) "=
coreutils"))))
Test end:
result-kind: pass
actual-value: ("foo86-hurd" #f (#<origin "mirror://gnu/make/make-4.4.1.ta=
r.gz" #<content-hash sha256:1cwgcmwdn7gqn5da2ia91gkyiqs9birr10sy5ykpkaxzcwf=
zn5nx> ("/home/herman/git/guix/gnu/packages/patches/make-impure-dirs.patch"=
) 7feecb10a000>) (#<package glibc@HIDDEN gnu/packages/commencement.scm:3103 7=
feec5502370>) (#<package coreutils@HIDDEN guix/build-system/gnu.scm:151 7feecb=
124210>))
expected-value: ("foo86-hurd" #f (#<origin "mirror://gnu/make/make-4.4.1.=
tar.gz" #<content-hash sha256:1cwgcmwdn7gqn5da2ia91gkyiqs9birr10sy5ykpkaxzc=
wfzn5nx> ("/home/herman/git/guix/gnu/packages/patches/make-impure-dirs.patc=
h") 7feecb10a000>) (#<package glibc@HIDDEN gnu/packages/commencement.scm:3103=
7feec5502370>) (#<package coreutils@HIDDEN guix/build-system/gnu.scm:151 7fee=
cb124210>))
Test begin:
test-name: "package->bag, sensitivity to %current-target-system"
source-line: 1289
source-form: (test-assert "package->bag, sensitivity to %current-target-s=
ystem" (let* ((lower (lambda* (name #:key system target inputs native-input=
s #:allow-other-keys) (and (not target) (bag (name name) (system system) (t=
arget target) (build-inputs native-inputs) (host-inputs inputs) (build (lam=
bda* (name inputs #:key system target #:allow-other-keys) (gexp->derivation=
"foo" (gexp (mkdir (ungexp output)))))))))) (bs (build-system (name (quote=
build-system-without-cross-compilation)) (description "Does not support cr=
oss compilation.") (lower lower))) (dep (dummy-package "dep" (build-system =
bs))) (pkg (dummy-package "example" (native-inputs (list dep)))) (do-not-bu=
ild (lambda (continue store lst . _) lst))) (equal? (with-build-handler do-=
not-build (parameterize ((%current-target-system "powerpc64le-linux-gnu") (=
%graft? #t)) (package-cross-derivation %store pkg (%current-target-system) =
#:graft? #t))) (with-build-handler do-not-build (package-cross-derivation %=
store (package (inherit pkg)) "powerpc64le-linux-gnu" #:graft? #t)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package->bag, cross-compilation"
source-line: 1322
source-form: (test-equal "package->bag, cross-compilation" (quasiquote ((=
unquote (%current-system)) "foo86-hurd" ((unquote (package-source gnu-make)=
)) ((unquote (canonical-package glibc))) ((unquote (canonical-package coreu=
tils))))) (let ((bag (package->bag gnu-make (%current-system) "foo86-hurd")=
)) (list (bag-system bag) (bag-target bag) (assoc-ref (bag-build-inputs bag=
) "source") (assoc-ref (bag-build-inputs bag) "libc") (assoc-ref (bag-build=
-inputs bag) "coreutils"))))
Test end:
result-kind: pass
actual-value: ("x86_64-linux" "foo86-hurd" (#<origin "mirror://gnu/make/m=
ake-4.4.1.tar.gz" #<content-hash sha256:1cwgcmwdn7gqn5da2ia91gkyiqs9birr10s=
y5ykpkaxzcwfzn5nx> ("/home/herman/git/guix/gnu/packages/patches/make-impure=
-dirs.patch") 7feecb10a000>) (#<package glibc@HIDDEN gnu/packages/commencemen=
t.scm:3103 7feecb126840>) (#<package coreutils@HIDDEN guix/build-system/gnu.sc=
m:151 7feecb124210>))
expected-value: ("x86_64-linux" "foo86-hurd" (#<origin "mirror://gnu/make=
/make-4.4.1.tar.gz" #<content-hash sha256:1cwgcmwdn7gqn5da2ia91gkyiqs9birr1=
0sy5ykpkaxzcwfzn5nx> ("/home/herman/git/guix/gnu/packages/patches/make-impu=
re-dirs.patch") 7feecb10a000>) (#<package glibc@HIDDEN gnu/packages/commencem=
ent.scm:3103 7feecb126840>) (#<package coreutils@HIDDEN guix/build-system/gnu.=
scm:151 7feecb124210>))
Test begin:
test-name: "package->bag, propagated inputs"
source-line: 1332
source-form: (test-assert "package->bag, propagated inputs" (let* ((dep (=
dummy-package "dep")) (prop (dummy-package "prop" (propagated-inputs (list =
dep)))) (dummy (dummy-package "dummy" (inputs (list prop)))) (inputs (bag-t=
ransitive-inputs (package->bag dummy #:graft? #f)))) (match (assoc "dep" in=
puts) (("dep" package) (eq? package dep)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package->bag, sensitivity to %current-system"
source-line: 1343
source-form: (test-assert "package->bag, sensitivity to %current-system" =
(let* ((dep (dummy-package "dep" (propagated-inputs (if (string=3D? (%curre=
nt-system) "i586-gnu") (quasiquote (("libxml2" (unquote libxml2)))) (quote =
()))))) (pkg (dummy-package "foo" (native-inputs (list dep)))) (bag (packag=
e->bag pkg (%current-system) "i586-gnu"))) (equal? (parameterize ((%current=
-system "x86_64-linux")) (bag-transitive-inputs bag)) (parameterize ((%curr=
ent-system "i586-gnu")) (bag-transitive-inputs bag)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package->bag, sensitivity to %current-target-system"
source-line: 1357
source-form: (test-assert "package->bag, sensitivity to %current-target-s=
ystem" (let* ((dep (dummy-package "dep" (propagated-inputs (if (%current-ta=
rget-system) (quasiquote (("libxml2" (unquote libxml2)))) (quote ()))))) (p=
kg (dummy-package "foo" (native-inputs (list dep)))) (bag (package->bag pkg=
(%current-system) "foo86-hurd"))) (equal? (parameterize ((%current-target-=
system "foo64-gnu")) (bag-transitive-inputs bag)) (parameterize ((%current-=
target-system #f)) (bag-transitive-inputs bag)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "bag->derivation"
source-line: 1370
source-form: (test-assert "bag->derivation" (let ((store (open-connection=
-for-tests))) (dynamic-wind (const #t) (lambda () (run-with-store store (pa=
rameterize ((%graft? #f)) (let ((bag (package->bag gnu-make)) (drv (package=
-derivation %store gnu-make))) (parameterize ((%current-system "foox86-hurd=
")) (mlet %store-monad ((bag-drv (bag->derivation bag))) (return (equal? dr=
v bag-drv)))))) #:guile-for-build (%guile-for-build))) (lambda () (close-co=
nnection store)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "bag->derivation, cross-compilation"
source-line: 1378
source-form: (test-assert "bag->derivation, cross-compilation" (parameter=
ize ((%graft? #f)) (let* ((target "mips64el-linux-gnu") (bag (package->bag =
gnu-make (%current-system) target)) (drv (package-cross-derivation %store g=
nu-make target))) (parameterize ((%current-system "foox86-hurd") (%current-=
target-system "foo64-linux-gnu")) (mlet %store-monad ((bag-drv (bag->deriva=
tion bag))) (return (equal? drv bag-drv)))))))
Test end:
result-kind: pass
actual-value: #<procedure 7feec8625680 at <unknown port>:1385:8 (state)>
Test begin:
test-name: "GNU Make, bootstrap"
source-line: 1390
source-form: (test-assert "GNU Make, bootstrap" (let ((gnu-make gnu-make-=
for-tests)) (and (package? gnu-make) (or (location? (package-location gnu-m=
ake)) (not (package-location gnu-make))) (let* ((drv (package-derivation %s=
tore gnu-make)) (out (derivation->output-path drv))) (and (build-derivation=
s %store (list drv)) (file-exists? (string-append out "/bin/make")))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-mapping"
source-line: 1402
source-form: (test-equal "package-mapping" 42 (let* ((dep (dummy-package =
"chbouib" (native-inputs (quasiquote (("x" (unquote grep))))))) (p0 (dummy-=
package "example" (source 77) (inputs (quasiquote (("foo" (unquote coreutil=
s)) ("bar" (unquote grep)) ("baz" (unquote dep))))))) (transform (lambda (p=
) (package (inherit p) (source 42)))) (rewrite (package-mapping transform))=
(p1 (rewrite p0)) (bag0 (package->bag p0)) (bag1 (package->bag p1))) (and =
(eq? p1 (rewrite p0)) (eqv? 42 (package-source p1)) (equal? (drop (bag-dire=
ct-inputs bag0) 4) (drop (bag-direct-inputs bag1) 4)) (match (package-input=
s p1) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) (and (eq? dep1 (rewrite cor=
eutils)) (eq? dep2 (rewrite grep)) (eq? dep3 (rewrite dep)) (eqv? 42 (packa=
ge-source dep1) (package-source dep2) (package-source dep3)) (match (packag=
e-native-inputs dep3) ((("x" dep)) (and (eq? dep (rewrite grep)) (package-s=
ource dep))))))))))
Test end:
result-kind: pass
actual-value: 42
expected-value: 42
Test begin:
test-name: "package-mapping, deep"
source-line: 1438
source-form: (test-equal "package-mapping, deep" (quote (42)) (let* ((p0 =
(dummy-package "example" (inputs (quasiquote (("foo" (unquote coreutils)) (=
"bar" (unquote grep))))))) (transform (lambda (p) (package (inherit p) (sou=
rce 42)))) (rewrite (package-mapping transform #:deep? #t)) (p1 (rewrite p0=
)) (bag (package->bag p1))) (and (eq? p1 (rewrite p0)) (match (bag-direct-i=
nputs bag) ((("source" 42) ("foo" dep1) ("bar" dep2) rest ..1) (and (eq? de=
p1 (rewrite coreutils)) (eq? dep2 (rewrite grep)) (=3D 42 (package-source d=
ep1)) (=3D 42 (package-source dep2)) (delete-duplicates (map (match-lambda =
((_ package . _) (package-source package))) rest))))))))
Test end:
result-kind: pass
actual-value: (42)
expected-value: (42)
Test begin:
test-name: "package-input-rewriting"
source-line: 1463
source-form: (test-assert "package-input-rewriting" (let* ((dep (dummy-pa=
ckage "chbouib" (native-inputs (quasiquote (("x" (unquote grep))))))) (p0 (=
dummy-package "example" (inputs (quasiquote (("foo" (unquote coreutils)) ("=
bar" (unquote grep)) ("baz" (unquote dep))))))) (rewrite (package-input-rew=
riting (quasiquote (((unquote coreutils) unquote sed) ((unquote grep) unquo=
te findutils))) (cut string-append "r-" <>) #:deep? #f)) (p1 (rewrite p0)) =
(p2 (rewrite p0))) (and (not (eq? p1 p0)) (eq? p1 p2) (string=3D? "r-exampl=
e" (package-name p1)) (match (package-inputs p1) ((("foo" dep1) ("bar" dep2=
) ("baz" dep3)) (and (eq? dep1 sed) (eq? dep2 findutils) (string=3D? (packa=
ge-name dep3) "r-chbouib") (eq? dep3 (rewrite dep)) (match (package-native-=
inputs dep3) ((("x" dep)) (eq? dep findutils)))))) (equal? (drop (bag-direc=
t-inputs (package->bag p1)) 3) (drop (bag-direct-inputs (package->bag p0)) =
3)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting, deep"
source-line: 1493
source-form: (test-eq "package-input-rewriting, deep" (derivation-file-na=
me (package-derivation %store sed)) (let* ((p0 (dummy-package "chbouib" (bu=
ild-system python-build-system) (arguments (quasiquote (#:python (unquote p=
ython)))))) (rewrite (package-input-rewriting (quasiquote (((unquote python=
) unquote sed))))) (p1 (rewrite p0))) (match (bag-direct-inputs (package->b=
ag p1)) ((("python" python) _ ...) (derivation-file-name (package-derivatio=
n %store python))))))
Test end:
result-kind: pass
actual-value: "/gnu/store/dvxkd0p86wqcyzvws7lcams6bbbq6gli-sed-4.8.drv"
expected-value: "/gnu/store/dvxkd0p86wqcyzvws7lcams6bbbq6gli-sed-4.8.drv"
Test begin:
test-name: "package-input-rewriting, recursive"
source-line: 1504
source-form: (test-assert "package-input-rewriting, recursive" (let* ((de=
p (dummy-package "dep" (native-inputs (list grep)))) (p0 (dummy-package "ex=
ample1" (inputs (list dep grep)))) (p1 (dummy-package "example2" (inputs (l=
ist dep grep)))) (replacements (quasiquote (((unquote grep) unquote finduti=
ls) ((unquote p0) unquote p1)))) (rewrite (package-input-rewriting replacem=
ents)) (rewrite/recursive (package-input-rewriting replacements #:recursive=
? #t)) (p2 (rewrite p0)) (p3 (rewrite/recursive p0))) (and (string=3D? (pac=
kage-name p2) "example2") (match (package-inputs p2) ((("dep" dep1) ("grep"=
dep2)) (and (match (package-native-inputs dep1) ((("grep" x)) (eq? x grep)=
)) (eq? dep2 grep)))) (string=3D? (package-name p3) "example2") (match (pac=
kage-inputs p3) ((("dep" dep1) ("grep" dep2)) (and (match (package-native-i=
nputs dep1) ((("grep" x)) (string=3D? (package-full-name x) (package-full-n=
ame findutils)))) (string=3D? (package-full-name dep2) (package-full-name f=
indutils))))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec"
source-line: 1534
source-form: (test-assert "package-input-rewriting/spec" (let* ((dep (dum=
my-package "chbouib" (native-inputs (quasiquote (("x" (unquote grep))))))) =
(p0 (dummy-package "example" (inputs (quasiquote (("foo" (unquote coreutils=
)) ("bar" (unquote grep)) ("baz" (unquote dep))))))) (rewrite (package-inpu=
t-rewriting/spec (quasiquote (("coreutils" unquote (const sed)) ("grep" unq=
uote (const findutils)))) #:deep? #f)) (p1 (rewrite p0)) (p2 (rewrite p0)))=
(and (not (eq? p1 p0)) (eq? p1 p2) (string=3D? "example" (package-name p1)=
) (match (package-inputs p1) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) (and=
(string=3D? (package-full-name dep1) (package-full-name sed)) (string=3D? =
(package-full-name dep2) (package-full-name findutils)) (string=3D? (packag=
e-name dep3) "chbouib") (eq? dep3 (rewrite dep)) (match (package-native-inp=
uts dep3) ((("x" dep)) (string=3D? (package-full-name dep) (package-full-na=
me findutils))))))) (equal? (drop (bag-direct-inputs (package->bag p1)) 3) =
(drop (bag-direct-inputs (package->bag p0)) 3)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, partial match"
source-line: 1567
source-form: (test-assert "package-input-rewriting/spec, partial match" (=
let* ((dep (dummy-package "chbouib" (version "1") (native-inputs (quasiquot=
e (("x" (unquote grep))))))) (p0 (dummy-package "example" (inputs (quasiquo=
te (("foo" (unquote coreutils)) ("bar" (unquote dep))))))) (rewrite (packag=
e-input-rewriting/spec (quasiquote (("chbouib@123" unquote (const sed)) ("g=
rep" unquote (const findutils)))) #:deep? #f)) (p1 (rewrite p0))) (and (not=
(eq? p1 p0)) (string=3D? "example" (package-name p1)) (match (package-inpu=
ts p1) ((("foo" dep1) ("bar" dep2)) (and (string=3D? (package-full-name dep=
1) (package-full-name coreutils)) (eq? dep2 (rewrite dep)) (match (package-=
native-inputs dep2) ((("x" dep)) (string=3D? (package-full-name dep) (packa=
ge-full-name findutils))))))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, deep"
source-line: 1591
source-form: (test-assert "package-input-rewriting/spec, deep" (let* ((de=
p (dummy-package "chbouib")) (p0 (dummy-package "example" (build-system gnu=
-build-system) (inputs (quasiquote (("dep" (unquote dep))))))) (rewrite (pa=
ckage-input-rewriting/spec (quasiquote (("tar" unquote (const sed)) ("gzip"=
unquote (const findutils)))))) (p1 (rewrite p0)) (p2 (rewrite p0))) (and (=
not (eq? p1 p0)) (eq? p1 p2) (string=3D? "example" (package-name p1)) (matc=
h (package-inputs p1) ((("dep" dep1)) (and (string=3D? (package-full-name d=
ep1) (package-full-name dep)) (eq? dep1 (rewrite dep))))) (match (bag-direc=
t-inputs (package->bag p1)) ((("dep" dep1) ("tar" tar) ("gzip" gzip) _ ...)=
(and (eq? dep1 (rewrite dep)) (string=3D? (package-full-name tar) (package=
-full-name sed)) (string=3D? (package-full-name gzip) (package-full-name fi=
ndutils))))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, no duplicates"
source-line: 1619
source-form: (test-assert "package-input-rewriting/spec, no duplicates" (=
let* ((dep0 (dummy-package "dep0" (build-system trivial-build-system) (prop=
agated-inputs (quasiquote (("python" (unquote python))))))) (p0 (dummy-pack=
age "chbouib" (build-system python-build-system) (arguments (quasiquote (#:=
python (unquote python)))) (inputs (quasiquote (("dep0" (unquote dep0))))))=
) (rewrite (package-input-rewriting/spec (quote ()) #:deep? #t)) (p1 (rewri=
te p0)) (bag1 (package->bag p1)) (pythons (filter-map (match-lambda (("pyth=
on" python) python) (_ #f)) (bag-transitive-inputs bag1)))) (match (delete-=
duplicates pythons eq?) ((p) (eq? p (rewrite python))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, hidden package"
source-line: 1643
source-form: (test-assert "package-input-rewriting/spec, hidden package" =
(let* ((python (hidden-package python)) (p0 (dummy-package "chbouib" (build=
-system trivial-build-system) (inputs (list python)))) (rewrite (package-in=
put-rewriting/spec (quasiquote (("python" unquote (const sed)))) #:deep? #t=
)) (p1 (rewrite p0)) (bag1 (package->bag p1)) (pythons (filter-map (match-l=
ambda (("python" python) python) (_ #f)) (bag-transitive-inputs bag1)))) (m=
atch (delete-duplicates pythons eq?) ((p) (eq? p python)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, replace hidden package"
source-line: 1661
source-form: (test-assert "package-input-rewriting/spec, replace hidden p=
ackage" (let* ((python (hidden-package python)) (p0 (dummy-package "chbouib=
" (build-system trivial-build-system) (inputs (list python)))) (rewrite (pa=
ckage-input-rewriting/spec (quasiquote (("python" unquote (const sed)))) #:=
replace-hidden? #t)) (p1 (rewrite p0))) (match (package-inputs p1) ((("pyth=
on" python)) (and (string=3D? (package-full-name python) (package-full-name=
sed)))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, graft"
source-line: 1676
source-form: (test-equal "package-input-rewriting/spec, graft" (derivatio=
n-file-name (package-derivation %store sed)) (let* ((dep0 (dummy-package "d=
ep" (version "1") (build-system trivial-build-system) (inputs (quasiquote (=
("coreutils" (unquote coreutils))))))) (dep1 (dummy-package "dep" (version =
"0") (build-system trivial-build-system) (replacement dep0))) (p0 (dummy-pa=
ckage "p" (build-system trivial-build-system) (inputs (quasiquote (("dep" (=
unquote dep1))))))) (rewrite (package-input-rewriting/spec (quasiquote (("c=
oreutils" unquote (const sed)))))) (p1 (rewrite p0))) (match (package-input=
s p1) ((("dep" dep)) (match (package-inputs (package-replacement dep)) ((("=
coreutils" coreutils)) (derivation-file-name (package-derivation %store cor=
eutils))))))))
Test end:
result-kind: pass
actual-value: "/gnu/store/dvxkd0p86wqcyzvws7lcams6bbbq6gli-sed-4.8.drv"
expected-value: "/gnu/store/dvxkd0p86wqcyzvws7lcams6bbbq6gli-sed-4.8.drv"
Test begin:
test-name: "package-with-c-toolchain"
source-line: 1703
source-form: (test-assert "package-with-c-toolchain" (let* ((dep (dummy-p=
ackage "chbouib" (build-system gnu-build-system) (native-inputs (quasiquote=
(("x" (unquote grep))))))) (p0 (dummy-package "thingie" (build-system gnu-=
build-system) (inputs (quasiquote (("foo" (unquote grep)) ("bar" (unquote d=
ep))))))) (tc (dummy-package "my-toolchain")) (p1 (package-with-c-toolchain=
p0 (quasiquote (("toolchain" (unquote tc))))))) (define toolchain-packages=
(quote ("gcc" "binutils" "glibc" "ld-wrapper"))) (match (bag-build-inputs =
(package->bag p1)) ((("foo" foo) ("bar" bar) (_ (=3D package-name packages)=
. _) ...) (and (not (any (cut member <> packages) toolchain-packages)) (me=
mber "my-toolchain" packages) (eq? foo grep) (eq? bar dep))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting/spec, identity"
source-line: 1723
source-form: (test-assert "package-input-rewriting/spec, identity" (let* =
((libffi (dummy-package "libffi" (build-system trivial-build-system))) (gli=
b (dummy-package "glib" (build-system trivial-build-system) (propagated-inp=
uts (list libffi)))) (gobject (dummy-package "gobject-introspection" (build=
-system trivial-build-system) (inputs (list glib)) (propagated-inputs (list=
libffi)))) (rewrite (package-input-rewriting/spec (quasiquote (("glib" unq=
uote identity)))))) (and (=3D (length (package-transitive-inputs gobject)) =
(length (package-transitive-inputs (rewrite gobject)))) (string=3D? (deriva=
tion-file-name (package-derivation %store (rewrite gobject))) (derivation-f=
ile-name (package-derivation %store gobject))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-input-rewriting, identity"
source-line: 1746
source-form: (test-assert "package-input-rewriting, identity" (let* ((lib=
ffi (dummy-package "libffi" (build-system trivial-build-system))) (glib (du=
mmy-package "glib" (build-system trivial-build-system) (propagated-inputs (=
list libffi)))) (gobject (dummy-package "gobject-introspection" (build-syst=
em trivial-build-system) (inputs (list glib)) (propagated-inputs (list libf=
fi)))) (rewrite (package-input-rewriting (quasiquote (((unquote glib) unquo=
te glib)))))) (and (=3D (length (package-transitive-inputs gobject)) (lengt=
h (package-transitive-inputs (rewrite gobject)))) (string=3D? (derivation-f=
ile-name (package-derivation %store (rewrite gobject))) (derivation-file-na=
me (package-derivation %store gobject))))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "package-patched-vulnerabilities"
source-line: 1766
source-form: (test-equal "package-patched-vulnerabilities" (quote (("CVE-=
2015-1234") ("CVE-2016-1234" "CVE-2018-4567") ())) (let ((p1 (dummy-package=
"pi" (source (dummy-origin (patches (list "/a/b/pi-CVE-2015-1234.patch")))=
))) (p2 (dummy-package "pi" (source (dummy-origin (patches (list "/a/b/pi-C=
VE-2016-1234-CVE-2018-4567.patch")))))) (p3 (dummy-package "pi" (source (du=
mmy-origin))))) (map package-patched-vulnerabilities (list p1 p2 p3))))
Test end:
result-kind: pass
actual-value: (("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") ())
expected-value: (("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") ())
Test begin:
test-name: "fold-packages"
source-line: 1781
source-form: (test-eq "fold-packages" hello (fold-packages (lambda (p r) =
(if (string=3D? (package-name p) "hello") p r)) #f))
Test end:
result-kind: pass
actual-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10e7=
90>
expected-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10=
e790>
Test begin:
test-name: "fold-packages, hidden package"
source-line: 1788
source-form: (test-assert "fold-packages, hidden package" (match (fold-pa=
ckages (lambda (p r) (if (and (string=3D? (package-name p) "guile") (string=
-prefix? "2.0" (package-version p))) (cons p r) r)) (quote ())) ((one) (eq?=
one guile-2.0))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "fold-available-packages with/without cache"
source-line: 1802
source-form: (test-assert "fold-available-packages with/without cache" (l=
et () (define no-cache (fold-available-packages (lambda* (name version resu=
lt #:rest rest) (cons (cons* name version rest) result)) (quote ()))) (defi=
ne from-cache (call-with-temporary-directory (lambda (cache) (generate-pack=
age-cache cache) (mock ((guix describe) current-profile (const cache)) (moc=
k ((gnu packages) cache-is-authoritative? (const #t)) (fold-available-packa=
ges (lambda* (name version result #:rest rest) (cons (cons* name version re=
st) result)) (quote ()))))))) (define (list->set* lst) (let loop ((lst lst)=
(duplicates (quote ())) (seen (set))) (match lst (() (values seen duplicat=
es)) ((head . tail) (if (set-contains? seen head) (loop tail (cons head dup=
licates) seen) (loop tail duplicates (set-insert head seen))))))) (let ((se=
t1 duplicates1 (list->set* from-cache)) (set2 duplicates2 (list->set* no-ca=
che))) (pk (quote from-cache-duplicates:) duplicates1) (pk (quote no-cache-=
duplicates:) duplicates2) (and (null? duplicates1) (null? duplicates2) (eve=
ry (cut set-contains? set1 <>) no-cache) (every (cut set-contains? set2 <>)=
from-cache)))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "find-packages-by-name"
source-line: 1847
source-form: (test-assert "find-packages-by-name" (match (find-packages-b=
y-name "hello") (((? (cut eq? hello <>))) #t) (wrong (pk (quote find-packag=
es-by-name) wrong #f))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "find-packages-by-name with version"
source-line: 1852
source-form: (test-assert "find-packages-by-name with version" (match (fi=
nd-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>=
))) #t) (wrong (pk (quote find-packages-by-name) wrong #f))))
Test end:
result-kind: pass
actual-value: #t
Test begin:
test-name: "find-packages-by-name with cache"
source-line: 1857
source-form: (test-equal "find-packages-by-name with cache" (find-package=
s-by-name "guile") (call-with-temporary-directory (lambda (cache) (generate=
-package-cache cache) (mock ((guix describe) current-profile (const cache))=
(mock ((gnu packages) cache-is-authoritative? (const #t)) (find-packages-b=
y-name "guile"))))))
Test end:
result-kind: pass
actual-value: (#<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f8a=
840> #<package guile@HIDDEN gnu/packages/guile.scm:287 7feed5f8a9a0> #<packa=
ge guile@HIDDEN gnu/packages/guile.scm:338 7feed5f8a8f0> #<package guile@HIDDEN=
=2E14 gnu/packages/guile.scm:160 7feed5f8aa50> #<package guile@HIDDEN gnu/pa=
ckages/guile.scm:77 7feed5f8ab00>)
expected-value: (#<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f=
8a840> #<package guile@HIDDEN gnu/packages/guile.scm:287 7feed5f8a9a0> #<pac=
kage guile@HIDDEN gnu/packages/guile.scm:338 7feed5f8a8f0> #<package guile@2=
=2E0.14 gnu/packages/guile.scm:160 7feed5f8aa50> #<package guile@HIDDEN gnu/=
packages/guile.scm:77 7feed5f8ab00>)
Test begin:
test-name: "find-packages-by-name + version, with cache"
source-line: 1866
source-form: (test-equal "find-packages-by-name + version, with cache" (f=
ind-packages-by-name "guile" "2") (call-with-temporary-directory (lambda (c=
ache) (generate-package-cache cache) (mock ((guix describe) current-profile=
(const cache)) (mock ((gnu packages) cache-is-authoritative? (const #t)) (=
find-packages-by-name "guile" "2"))))))
Test end:
result-kind: pass
actual-value: (#<package guile@HIDDEN gnu/packages/guile.scm:287 7feed5f8a=
9a0> #<package guile@HIDDEN gnu/packages/guile.scm:338 7feed5f8a8f0> #<packa=
ge guile@HIDDEN gnu/packages/guile.scm:160 7feed5f8aa50>)
expected-value: (#<package guile@HIDDEN gnu/packages/guile.scm:287 7feed5f=
8a9a0> #<package guile@HIDDEN gnu/packages/guile.scm:338 7feed5f8a8f0> #<pac=
kage guile@HIDDEN gnu/packages/guile.scm:160 7feed5f8aa50>)
Test begin:
test-name: "--search-paths with pattern"
source-line: 1875
source-form: (test-assert "--search-paths with pattern" (let* ((p1 (packa=
ge (name "foo") (version "0") (source #f) (build-system trivial-build-syste=
m) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:modules ((g=
uix build utils)) #:builder (begin (use-modules (guix build utils)) (let ((=
out (assoc-ref %outputs "out"))) (mkdir-p (string-append out "/xml/bar/baz"=
)) (call-with-output-file (string-append out "/xml/bar/baz/catalog.xml") (l=
ambda (port) (display "xml? wat?!" port))) #t))))) (synopsis #f) (descripti=
on #f) (home-page #f) (license #f))) (p2 (package (name "libxml2") (version=
"0.0.0") (source #f) (build-system trivial-build-system) (arguments (quasi=
quote (#:guile (unquote %bootstrap-guile) #:builder (begin (mkdir (assoc-re=
f %outputs "out")) #t)))) (native-search-paths (package-native-search-paths=
libxml2)) (synopsis #f) (description #f) (home-page #f) (license #f))) (pr=
of (run-with-store %store (profile-derivation (manifest (map package->manif=
est-entry (list p1 p2))) #:hooks (quote ()) #:locales? #f) #:guile-for-buil=
d (%guile-for-build)))) (build-derivations %store (list prof)) (string-matc=
h (format #f "^export XML_CATALOG_FILES=3D\"~a/xml/+bar/baz/catalog\\.xml\"=
\n" (regexp-quote (derivation->output-path prof))) (with-output-to-string (=
lambda () (guix-package "-p" (derivation->output-path prof) "--search-paths=
"))))))
Test end:
result-kind: pass
actual-value: #("export XML_CATALOG_FILES=3D\"/gnu/store/0ravyqivkx4iyxl0=
glwa3lnfars68gg3-profile/xml/bar/baz/catalog.xml\"\n" (0 . 103))
Test begin:
test-name: "--search-paths with single-item search path"
source-line: 1926
source-form: (test-assert "--search-paths with single-item search path" (=
let* ((p1 (dummy-package "foo" (build-system trivial-build-system) (argumen=
ts (quasiquote (#:guile (unquote %bootstrap-guile) #:modules ((guix build u=
tils)) #:builder (begin (use-modules (guix build utils)) (let ((out (assoc-=
ref %outputs "out"))) (mkdir-p (string-append out "/etc/ssl/certs")) (call-=
with-output-file (string-append out "/etc/ssl/certs/ca-certificates.crt") (=
const #t))))))))) (p2 (package (inherit p1) (name "bar"))) (p3 (dummy-packa=
ge "git" (build-system trivial-build-system) (arguments (quasiquote (#:guil=
e (unquote %bootstrap-guile) #:builder (begin (mkdir (assoc-ref %outputs "o=
ut")) #t)))) (native-search-paths (package-native-search-paths git)))) (pro=
f1 (run-with-store %store (profile-derivation (packages->manifest (list p1 =
p3)) #:hooks (quote ()) #:locales? #f) #:guile-for-build (%guile-for-build)=
)) (prof2 (run-with-store %store (profile-derivation (packages->manifest (l=
ist p2 p3)) #:hooks (quote ()) #:locales? #f) #:guile-for-build (%guile-for=
-build)))) (build-derivations %store (list prof1 prof2)) (string-match (for=
mat #f "^export GIT_SSL_CAINFO=3D\"~a/etc/ssl/certs/ca-certificates.crt" (r=
egexp-quote (derivation->output-path prof1))) (with-output-to-string (lambd=
a () (guix-package "-p" (derivation->output-path prof1) "-p" (derivation->o=
utput-path prof2) "--search-paths"))))))
Test end:
result-kind: pass
actual-value: #("export GIT_SSL_CAINFO=3D\"/gnu/store/lw9p4a0vaah1q2bxwzb=
dw8cm1g5dx2lq-profile/etc/ssl/certs/ca-certificates.crt\"\n" (0 . 108))
Test begin:
test-name: "specification->package when not found"
source-line: 1974
source-form: (test-equal "specification->package when not found" (quote q=
uit) (catch (quote quit) (lambda () (specification->package "this-package-d=
oes-not-exist")) (lambda (key . args) key)))
Test end:
result-kind: pass
actual-value: quit
expected-value: quit
Test begin:
test-name: "specification->package+output"
source-line: 1983
source-form: (test-equal "specification->package+output" (quasiquote (((u=
nquote coreutils) "out") ((unquote coreutils) "debug"))) (list (call-with-v=
alues (lambda () (specification->package+output "coreutils")) list) (call-w=
ith-values (lambda () (specification->package+output "coreutils:debug")) li=
st)))
Test end:
result-kind: pass
actual-value: ((#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb1=
0e160> "out") (#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb10e1=
60> "debug"))
expected-value: ((#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feec=
b10e160> "out") (#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb10=
e160> "debug"))
Test begin:
test-name: "specification->package+output invalid output"
source-line: 1992
source-form: (test-equal "specification->package+output invalid output" (=
quote error) (catch (quote quit) (lambda () (specification->package+output =
"coreutils:does-not-exist")) (lambda _ (quote error))))
Test end:
result-kind: pass
actual-value: error
expected-value: error
Test begin:
test-name: "specification->package+output no default output"
source-line: 2000
source-form: (test-equal "specification->package+output no default output=
" (quasiquote ((unquote coreutils) #f)) (call-with-values (lambda () (speci=
fication->package+output "coreutils" #f)) list))
Test end:
result-kind: pass
actual-value: (#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb10=
e160> #f)
expected-value: (#<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb=
10e160> #f)
Test begin:
test-name: "specification->package+output invalid output, no default"
source-line: 2007
source-form: (test-equal "specification->package+output invalid output, n=
o default" (quote error) (catch (quote quit) (lambda () (specification->pac=
kage+output "coreutils:does-not-exist" #f)) (lambda _ (quote error))))
Test end:
result-kind: pass
actual-value: error
expected-value: error
Test begin:
test-name: "find-package-locations"
source-line: 2015
source-form: (test-equal "find-package-locations" (map (lambda (package) =
(cons (package-version package) (package-location package))) (find-packages=
-by-name "guile")) (find-package-locations "guile"))
Test end:
result-kind: pass
actual-value: (("3.0.9" . #<<location> file: "gnu/packages/guile.scm" lin=
e: 351 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" l=
ine: 287 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm"=
line: 338 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.s=
cm" line: 160 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile=
=2Escm" line: 77 column: 2>))
expected-value: (("3.0.9" . #<<location> file: "gnu/packages/guile.scm" l=
ine: 351 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm"=
line: 287 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.sc=
m" line: 338 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile=
=2Escm" line: 160 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/g=
uile.scm" line: 77 column: 2>))
Test begin:
test-name: "find-package-locations with cache"
source-line: 2022
source-form: (test-equal "find-package-locations with cache" (map (lambda=
(package) (cons (package-version package) (package-location package))) (fi=
nd-packages-by-name "guile")) (call-with-temporary-directory (lambda (cache=
) (generate-package-cache cache) (mock ((guix describe) current-profile (co=
nst cache)) (mock ((gnu packages) cache-is-authoritative? (const #t)) (find=
-package-locations "guile"))))))
Test end:
result-kind: pass
actual-value: (("3.0.9" . #<<location> file: "gnu/packages/guile.scm" lin=
e: 351 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" l=
ine: 287 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm"=
line: 338 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.s=
cm" line: 160 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile=
=2Escm" line: 77 column: 2>))
expected-value: (("3.0.9" . #<<location> file: "gnu/packages/guile.scm" l=
ine: 351 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm"=
line: 287 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.sc=
m" line: 338 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile=
=2Escm" line: 160 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/g=
uile.scm" line: 77 column: 2>))
Test begin:
test-name: "specification->location"
source-line: 2034
source-form: (test-equal "specification->location" (package-location (spe=
cification->package "guile@2")) (specification->location "guile@2"))
Test end:
result-kind: pass
actual-value: #<<location> file: "gnu/packages/guile.scm" line: 287 colum=
n: 2>
expected-value: #<<location> file: "gnu/packages/guile.scm" line: 287 col=
umn: 2>
Test begin:
test-name: "package-unique-version-prefix, gcc@8"
source-line: 2038
source-form: (test-equal "package-unique-version-prefix, gcc@8" "8" (let =
((gcc (specification->package "gcc-toolchain@8"))) (package-unique-version-=
prefix (package-name gcc) (package-version gcc))))
Test end:
result-kind: pass
actual-value: "8"
expected-value: "8"
Test begin:
test-name: "package-unique-version-prefix, grep"
source-line: 2044
source-form: (test-equal "package-unique-version-prefix, grep" "" (let ((=
grep (specification->package "grep"))) (package-unique-version-prefix (pack=
age-name grep) (package-version grep))))
Test end:
result-kind: pass
actual-value: ""
expected-value: ""
Test begin:
test-name: "this-package-input, exists"
source-line: 2051
source-form: (test-eq "this-package-input, exists" hello (package-argumen=
ts (dummy-package "a" (inputs (quasiquote (("hello" (unquote hello))))) (ar=
guments (this-package-input "hello")))))
Test end:
result-kind: pass
actual-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10e7=
90>
expected-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10=
e790>
Test begin:
test-name: "this-package-input, exists in propagated-inputs"
source-line: 2058
source-form: (test-eq "this-package-input, exists in propagated-inputs" h=
ello (package-arguments (dummy-package "a" (propagated-inputs (quasiquote (=
("hello" (unquote hello))))) (arguments (this-package-input "hello")))))
Test end:
result-kind: pass
actual-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10e7=
90>
expected-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10=
e790>
Test begin:
test-name: "this-package-input, does not exist"
source-line: 2065
source-form: (test-eq "this-package-input, does not exist" #f (package-ar=
guments (dummy-package "a" (arguments (this-package-input "hello")))))
Test end:
result-kind: pass
actual-value: #f
expected-value: #f
Test begin:
test-name: "this-package-native-input, exists"
source-line: 2071
source-form: (test-eq "this-package-native-input, exists" hello (package-=
arguments (dummy-package "a" (native-inputs (quasiquote (("hello" (unquote =
hello))))) (arguments (this-package-native-input "hello")))))
Test end:
result-kind: pass
actual-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10e7=
90>
expected-value: #<package hello@HIDDEN gnu/packages/base.scm:100 7feecb10=
e790>
Test begin:
test-name: "this-package-native-input, does not exists"
source-line: 2078
source-form: (test-eq "this-package-native-input, does not exists" #f (pa=
ckage-arguments (dummy-package "a" (arguments (this-package-native-input "h=
ello")))))
Test end:
result-kind: pass
actual-value: #f
expected-value: #f
Test begin:
test-name: "this-package-input, origin"
source-line: 2084
source-form: (test-equal "this-package-input, origin" "http://example.org=
/foo.tar.gz" (origin-uri (package-arguments (dummy-package "a" (inputs (lis=
t (dummy-origin (uri "http://example.org/foo.tar.gz")))) (arguments (this-p=
ackage-input "foo.tar.gz"))))))
Test end:
result-kind: pass
actual-value: "http://example.org/foo.tar.gz"
expected-value: "http://example.org/foo.tar.gz"
Test begin:
test-name: "modify-inputs, replace"
source-line: 2092
source-form: (test-eq "modify-inputs, replace" coreutils (let* ((p1 (dumm=
y-package "p" (inputs (list hello)))) (p2 (package (inherit p1) (version "1=
") (inputs (modify-inputs (package-inputs p1) (replace "hello" coreutils)))=
))) (lookup-package-input p2 "hello")))
Test end:
result-kind: pass
actual-value: #<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb10e=
160>
expected-value: #<package coreutils@HIDDEN gnu/packages/base.scm:474 7feecb1=
0e160>
Test begin:
test-name: "modify-inputs, replace, change output"
source-line: 2104
source-form: (test-eq "modify-inputs, replace, change output" guile-3.0 (=
let* ((p1 (dummy-package "p" (inputs (list (quasiquote ((unquote coreutils)=
"debug")))))) (p2 (package (inherit p1) (version "1") (inputs (modify-inpu=
ts (package-inputs p1) (replace "coreutils" (quasiquote ((unquote guile-3.0=
) "out")))))))) (match (package-inputs p2) ((("coreutils" input "out")) inp=
ut))))
Test end:
result-kind: pass
actual-value: #<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f8a8=
40>
expected-value: #<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f8=
a840>
Test begin:
test-name: "modify-inputs, replace, extra output"
source-line: 2118
source-form: (test-eq "modify-inputs, replace, extra output" guile-3.0 (l=
et* ((p1 (dummy-package "p" (inputs (list (quasiquote ((unquote coreutils) =
"debug")))))) (p2 (package (inherit p1) (version "1") (inputs (modify-input=
s (package-inputs p1) (replace "coreutils" guile-3.0)))))) (match (package-=
inputs p2) ((("coreutils" input "debug")) input))))
Test end:
result-kind: pass
actual-value: #<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f8a8=
40>
expected-value: #<package guile@HIDDEN gnu/packages/guile.scm:351 7feed5f8=
a840>
Group end: packages
# of expected passes 122
# of unexpected failures 3
--scw34k2xpbd75e33--
guix-patches@HIDDEN:bug#75302; Package guix-patches.
Full text available.Received: (at 75302) by debbugs.gnu.org; 4 Jan 2025 20:59:30 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Sat Jan 04 15:59:30 2025 Received: from localhost ([127.0.0.1]:57634 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1tUBF4-0004ad-96 for submit <at> debbugs.gnu.org; Sat, 04 Jan 2025 15:59:30 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:60008) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tUBF1-0004aQ-TZ for 75302 <at> debbugs.gnu.org; Sat, 04 Jan 2025 15:59:28 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from <ludo@HIDDEN>) id 1tUBEt-0004u3-JJ; Sat, 04 Jan 2025 15:59:19 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To: From; bh=gznYBvyFMMmtzI8biTucCTCcpt7xtalX1AiqIowCGmk=; b=BCmnrO6aEYBwW143sq64 ABdWEbLHjR1BQYOaTBArSv3AVZqYGohr3Sx/2p2Sc8sQbMrId/7WogXZ8ikw55Vyeh6Ph2d39b6i/ vcKPjQfLby1lJvspIj4pVWcjTmcSNSexVYKR7LRPTZjCKoqqGB9HYojkxReVSFm8IgIN9nqws58+C 7YM3lVmUpkO+rM4qL1EZwPrfhmEnsxXEcWpYcGd1VlPhisOtudjCEcfzv3sjnJ8CchLJP8XvJIYev d+GSvPrp/K8hNGMTKW9XxkGtkPos4oFCVxynGGL6chyMV4EVy1g/qF1fQOCSVIFG3w88BShdD6FCr HeLLeMASxTGiQw==; From: =?utf-8?Q?Ludovic_Court=C3=A8s?= <ludo@HIDDEN> To: Herman Rimm <herman@HIDDEN> Subject: Re: [bug#75302] [PATCH] packages: Match renamed origin fields. In-Reply-To: <18c0be606434165893e9566caa34aff0f3776a0e.1735851535.git.herman@HIDDEN> (Herman Rimm's message of "Thu, 2 Jan 2025 22:03:30 +0100") References: <18c0be606434165893e9566caa34aff0f3776a0e.1735851535.git.herman@HIDDEN> Date: Sat, 04 Jan 2025 21:59:13 +0100 Message-ID: <87h66epa72.fsf@HIDDEN> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 75302 Cc: Josselin Poiret <dev@HIDDEN>, 75302 <at> debbugs.gnu.org, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN> X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -3.3 (---) Hi, Herman Rimm <herman@HIDDEN> skribis: > * guix/packages.scm (print-origin, origin->derivation): Use > match-record. > > Change-Id: Ia554dd3264f51e549df51f767c754040b3dc7611 The patch LGTM but, (1) fields haven=E2=80=99t been renamed recently, and= =E2=80=A6 > Three tests in (tests packages) fail as before: > "package-source-derivation, local-file" > "package-source-derivation, origin, sha512" > "package-source-derivation, origin, sha3-512" =E2=80=A6 (2) I don=E2=80=99t see these failures as of b8858d8b1344525d0d7ac78d8fb9dc1a577b85d3. Could you provide more details about these? Thanks, Ludo=E2=80=99.
guix-patches@HIDDEN:bug#75302; Package guix-patches.
Full text available.
Received: (at submit) by debbugs.gnu.org; 2 Jan 2025 21:04:35 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Thu Jan 02 16:04:34 2025
Received: from localhost ([127.0.0.1]:46936 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1tTSMs-0000Kd-CT
for submit <at> debbugs.gnu.org; Thu, 02 Jan 2025 16:04:34 -0500
Received: from lists.gnu.org ([2001:470:142::17]:39800)
by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.84_2) (envelope-from <herman@HIDDEN>) id 1tTSMq-0000KG-HR
for submit <at> debbugs.gnu.org; Thu, 02 Jan 2025 16:04:33 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <herman@HIDDEN>) id 1tTSMj-0000G3-W9
for guix-patches@HIDDEN; Thu, 02 Jan 2025 16:04:26 -0500
Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]
helo=email.rimm.ee)
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_CHACHA20_POLY1305:256)
(Exim 4.90_1) (envelope-from <herman@HIDDEN>) id 1tTSMi-0008O0-1m
for guix-patches@HIDDEN; Thu, 02 Jan 2025 16:04:25 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman;
t=1735851854;
h=from:from:reply-to:subject:subject:date:date:message-id:message-id:
to:to:cc:mime-version:mime-version:content-type:content-type:
content-transfer-encoding:content-transfer-encoding;
bh=jpQS70OFVIGuC8+bJ72hAEd/0CPrwbhQ9XeZ1ISfVrA=;
b=ontfzeMo3pX/Rn2FbgMxTBLRVZ5HOn1NDTdhP5FqkvcgCw1bR3zGGyJeUCPYPuhDYLt5wN
uQGNqqdAG8ciK972GOUSjOlUNUDApBT7YI1O2pG/QeXKZ6HNKlJfOh81ehI0mAWvOId2mi
FVbNklULbR8pcfBapsgnMN4GMkj83zx6oCE/HPAzGMydezmqjZPGJ0AG5f3ZkFA5yKe7Lt
WS2hqrNhNYBFnOYwb/TRW9R/07eckZJEJX2+vM3P/jUxbNtJqRZatycu6PeoIsgbVV9Hcn
2J8U6c7UTmPoXQxFZa4Qa0z62TANvnU1+TPP8g3ThzUT1wSgBM0gQSN+4/Pl3w==
Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 2074d839
(TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO)
for <guix-patches@HIDDEN>; Thu, 2 Jan 2025 21:04:14 +0000 (UTC)
From: Herman Rimm <herman@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH] packages: Match renamed origin fields.
Date: Thu, 2 Jan 2025 22:03:30 +0100
Message-ID: <18c0be606434165893e9566caa34aff0f3776a0e.1735851535.git.herman@HIDDEN>
X-Mailer: git-send-email 2.45.2
MIME-Version: 1.0
X-Debbugs-Cc: Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic Courtès <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Received-SPF: pass client-ip=81.205.150.117; envelope-from=herman@HIDDEN;
helo=email.rimm.ee
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1,
RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001,
SPF_HELO_NONE=0.001, SPF_PASS=-0.001,
TVD_RCVD_IP=0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: 0.9 (/)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.1 (/)
* guix/packages.scm (print-origin, origin->derivation): Use
match-record.
Change-Id: Ia554dd3264f51e549df51f767c754040b3dc7611
---
Hello,
Three tests in (tests packages) fail as before:
"package-source-derivation, local-file"
"package-source-derivation, origin, sha512"
"package-source-derivation, origin, sha3-512"
Cheers,
Herman
guix/packages.scm | 59 ++++++++++++++++++++++-------------------------
1 file changed, 28 insertions(+), 31 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index ff9fbd84709..6088457b20b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -11,6 +11,7 @@
;;; Copyright © 2022 jgart <jgart@HIDDEN>
;;; Copyright © 2023 Simon Tournier <zimon.toutoune@HIDDEN>
;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@HIDDEN>
+;;; Copyright © 2025 Herman Rimm <herman@HIDDEN>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -359,12 +360,10 @@ (define-syntax-rule (origin fields ...)
(define (print-origin origin port)
"Write a concise representation of ORIGIN to PORT."
- (match origin
- (($ <origin> uri method hash file-name patches)
- (simple-format port "#<origin ~s ~a ~s ~a>"
- uri hash
- (force patches)
- (number->string (object-address origin) 16)))))
+ (match-record origin <origin> (uri method hash file-name patches)
+ (simple-format port "#<origin ~s ~a ~s ~a>"
+ uri hash patches
+ (number->string (object-address origin) 16))))
(set-record-type-printer! <origin> print-origin)
@@ -2151,31 +2150,29 @@ (define-gexp-compiler (package-compiler (package <package>) system target)
(define* (origin->derivation origin
#:optional (system (%current-system)))
"Return the derivation corresponding to ORIGIN."
- (match origin
- (($ <origin> uri method hash name (= force ()) #f)
- ;; No patches, no snippet: this is a fixed-output derivation.
- (method uri
- (content-hash-algorithm hash)
- (content-hash-value hash)
- name #:system system))
- (($ <origin> uri method hash name (= force (patches ...)) snippet
- flags inputs (modules ...) guile-for-build)
- ;; Patches and/or a snippet.
- (mlet %store-monad ((source (method uri
- (content-hash-algorithm hash)
- (content-hash-value hash)
- name #:system system))
- (guile (package->derivation (or guile-for-build
- (default-guile))
- system
- #:graft? #f)))
- (patch-and-repack source patches
- #:inputs inputs
- #:snippet snippet
- #:flags flags
- #:system system
- #:modules modules
- #:guile-for-build guile)))))
+ (match-record origin <origin>
+ (uri method hash file-name patches patch-flags patch-inputs
+ patch-guile snippet modules)
+ (let* ((hash-algo (content-hash-algorithm hash))
+ (hash (content-hash-value hash))
+ (source (method uri hash-algo hash file-name
+ #:system system)))
+ (if (or snippet (pair? patches))
+ (mlet %store-monad
+ ((guile (package->derivation (or patch-guile
+ (default-guile))
+ system
+ #:graft? #f))
+ (source source))
+ (patch-and-repack source patches
+ #:inputs patch-inputs
+ #:snippet snippet
+ #:flags patch-flags
+ #:system system
+ #:modules modules
+ #:guile-for-build guile))
+ ;; This is a fixed-output derivation.
+ source))))
(define-gexp-compiler (origin-compiler (origin <origin>) system target)
;; Compile ORIGIN to a derivation for SYSTEM. This is used when referring
base-commit: 5d7455bb580eed41a4fa7c20b71eaccad9f49e73
--
2.45.2
Herman Rimm <herman@HIDDEN>:guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN.
Full text available.guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN:bug#75302; Package guix-patches.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.