summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/channels.scm47
-rw-r--r--tests/cran.scm9
-rw-r--r--tests/derivations.scm14
-rw-r--r--tests/egg.scm2
-rw-r--r--tests/elpa.scm12
-rw-r--r--tests/gexp.scm58
-rw-r--r--tests/git.scm28
-rw-r--r--tests/go.scm6
-rw-r--r--tests/graph.scm21
-rw-r--r--tests/guix-build.sh10
-rw-r--r--tests/guix-environment-container.sh8
-rw-r--r--tests/guix-environment.sh7
-rw-r--r--tests/guix-hash.sh26
-rw-r--r--tests/guix-home.sh131
-rw-r--r--tests/guix-shell.sh116
-rw-r--r--tests/hackage.scm20
-rw-r--r--tests/home-import.scm188
-rw-r--r--tests/import-git.scm245
-rw-r--r--tests/lint.scm49
-rw-r--r--tests/minetest.scm169
-rw-r--r--tests/nar.scm7
-rw-r--r--tests/opam.scm81
-rw-r--r--tests/packages.scm36
-rw-r--r--tests/print.scm84
-rw-r--r--tests/profiles.scm7
-rw-r--r--tests/pypi.scm113
-rw-r--r--tests/store-deduplication.scm41
-rw-r--r--tests/store.scm110
-rw-r--r--tests/syscalls.scm35
-rw-r--r--tests/texlive.scm221
30 files changed, 1706 insertions, 195 deletions
diff --git a/tests/channels.scm b/tests/channels.scm
index 0264369d9e..3e82315b0c 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -408,6 +408,53 @@
'(#f "tag-for-first-news-entry")))))))
(unless (which (git-command)) (test-skip 1))
+(test-assert "channel-news, annotated tag"
+ (with-temporary-git-repository directory
+ `((add ".guix-channel"
+ ,(object->string
+ '(channel (version 0)
+ (news-file "news.scm"))))
+ (add "src/a.txt" "A")
+ (commit "first commit")
+ (tag "tag-for-first-news-entry"
+ "This is an annotated tag.")
+ (add "news.scm"
+ ,(lambda (repository)
+ (let ((previous
+ (reference-name->oid repository "HEAD")))
+ (object->string
+ `(channel-news
+ (version 0)
+ (entry (tag "tag-for-first-news-entry")
+ (title (en "New file!"))
+ (body (en "Yeah, a.txt."))))))))
+ (commit "second commit"))
+ (with-repository directory repository
+ (define (find-commit* message)
+ (oid->string (commit-id (find-commit repository message))))
+
+ (let ((channel (channel (url (string-append "file://" directory))
+ (name 'foo)))
+ (commit1 (find-commit* "first commit"))
+ (commit2 (find-commit* "second commit")))
+ (and (null? (channel-news-for-commit channel commit1))
+ (lset= equal?
+ (map channel-news-entry-title
+ (channel-news-for-commit channel commit2))
+ '((("en" . "New file!"))))
+ (lset= string=?
+ (map channel-news-entry-tag
+ (channel-news-for-commit channel commit2))
+ (list "tag-for-first-news-entry"))
+ ;; This is an annotated tag, but 'channel-news-entry-commit'
+ ;; should give us the commit ID, not the ID of the annotated tag
+ ;; object.
+ (lset= string=?
+ (map channel-news-entry-commit
+ (channel-news-for-commit channel commit2))
+ (list commit1)))))))
+
+(unless (which (git-command)) (test-skip 1))
(test-assert "latest-channel-instances, missing introduction for 'guix'"
(with-temporary-git-repository directory
'((add "a.txt" "A")
diff --git a/tests/cran.scm b/tests/cran.scm
index e59b7daef7..5c820b1ab3 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -36,7 +36,7 @@ Author: Ricardo Wurmus
Maintainer: Guix Schmeeks <guix@gnu.org>
URL: http://gnu.org/s/my-example
Description: This is a long description
-spanning multiple lines: and it could confuse the parser that
+spanning multiple lines: and it could confuse the parser that this line is very long or perhaps the fact that
there is a colon : on the lines.
And: this line continues the description.
biocViews: 0
@@ -123,9 +123,10 @@ Date/Publication: 2015-07-14 14:15:16
('home-page "http://gnu.org/s/my-example")
('synopsis "Example package")
('description
- "This is a long description spanning multiple lines: \
-and it could confuse the parser that there is a colon : on the \
-lines. And: this line continues the description.")
+ "\
+This is a long description spanning multiple lines: and it could confuse the
+parser that this line is very long or perhaps the fact that there is a colon :
+on the lines. And: this line continues the description.")
('license 'gpl3+))
#t)
(x
diff --git a/tests/derivations.scm b/tests/derivations.scm
index cd165d1be6..0775719ea3 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -170,11 +170,15 @@
#f))))
(test-assert "identical files are deduplicated"
- (let* ((build1 (add-text-to-store %store "one.sh"
- "echo hello, world > \"$out\"\n"
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((data (make-string 9000 #\a))
+ (build1 (add-text-to-store %store "one.sh"
+ (string-append "echo -n " data
+ " > \"$out\"\n")
'()))
(build2 (add-text-to-store %store "two.sh"
- "# Hey!\necho hello, world > \"$out\"\n"
+ (string-append "# Hey!\necho -n "
+ data " > \"$out\"\n")
'()))
(drv1 (derivation %store "foo"
%bash `(,build1)
@@ -187,7 +191,7 @@
(file2 (derivation->output-path drv2)))
(and (valid-path? %store file1) (valid-path? %store file2)
(string=? (call-with-input-file file1 get-string-all)
- "hello, world\n")
+ data)
(= (stat:ino (lstat file1))
(stat:ino (lstat file2))))))))
diff --git a/tests/egg.scm b/tests/egg.scm
index 9e45a42443..a7d3378dd7 100644
--- a/tests/egg.scm
+++ b/tests/egg.scm
@@ -73,7 +73,7 @@
(call-with-output-file egg-file
(lambda (port)
(write egg-test port)))
- (matcher (egg->guix-package egg-name
+ (matcher (egg->guix-package egg-name #f
#:file egg-file
#:source (plain-file
(string-append egg-name "-egg")
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 01ef948b2e..1efdf2457f 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +21,7 @@
(define-module (test-elpa)
#:use-module (guix import elpa)
+ #:use-module (guix tests)
#:use-module (guix tests http)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
@@ -71,6 +73,16 @@
(test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex"))
+(test-equal "guix-package->elpa-name: without 'upstream-name' property"
+ "auctex"
+ (guix-package->elpa-name (dummy-package "emacs-auctex")))
+
+(test-equal "guix-package->elpa-name: with 'upstream-name' property"
+ "project"
+ (guix-package->elpa-name
+ (dummy-package "emacs-fake-name"
+ (properties '((upstream-name . "project"))))))
+
(test-end "elpa")
;; Local Variables:
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 709a198e1e..ad8e1d57b8 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
@@ -441,6 +441,17 @@
'(system-binding)))
(x x)))))
+(test-assert "let-system in file-append"
+ (let ((mixed (file-append (let-system (system target)
+ (if (not target) grep sed))
+ "/bin"))
+ (grep (file-append grep "/bin"))
+ (sed (file-append sed "/bin")))
+ (and (equal? (gexp->sexp* #~(list #$mixed))
+ (gexp->sexp* #~(list #$grep)))
+ (equal? (gexp->sexp* #~(list #$mixed) "powerpc64le-linux-gnu")
+ (gexp->sexp* #~(list #$sed) "powerpc64le-linux-gnu")))))
+
(test-assert "ungexp + ungexp-native"
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
(ungexp coreutils)
@@ -834,19 +845,14 @@
(files -> `(("a/b/c" . ,q-scm)
("p/q" . ,plain)))
(drv (imported-files files)))
- (define (file=? file1 file2)
- ;; Assume deduplication is in place.
- (= (stat:ino (stat file1))
- (stat:ino (stat file2))))
-
(mbegin %store-monad
(built-derivations (list (pk 'drv drv)))
(mlet %store-monad ((dir -> (derivation->output-path drv))
(plain* (text-file "foo" "bar!"))
(q-scm* (interned-file q-scm "c")))
(return
- (and (file=? (string-append dir "/a/b/c") q-scm*)
- (file=? (string-append dir "/p/q") plain*)))))))
+ (and (file=? (string-append dir "/a/b/c") q-scm* stat)
+ (file=? (string-append dir "/p/q") plain* stat)))))))
(test-equal "gexp-modules & ungexp"
'((bar) (foo))
@@ -1475,6 +1481,42 @@ importing.* \\(guix config\\) from the host"
(string=? (readlink (string-append comp "/text"))
text)))))))
+(test-assert "lower-object, computed-file + grafts"
+ ;; The reference graph should refer to grafted packages when grafts are
+ ;; enabled. See <https://issues.guix.gnu.org/50676>.
+ (let* ((base (package
+ (inherit (dummy-package "trivial"))
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder (mkdir %output)))))
+ (pkg (package
+ (inherit base)
+ (version "1.1")
+ (replacement (package
+ (inherit base)
+ (version "9.9")))))
+ (exp #~(begin
+ (use-modules (ice-9 rdelim))
+ (let ((item (call-with-input-file "graph" read-line)))
+ (call-with-output-file #$output
+ (lambda (port)
+ (display item port))))))
+ (computed (computed-file "computed" exp
+ #:options
+ `(#:references-graphs (("graph" ,pkg)))))
+ (drv0 (package-derivation %store pkg #:graft? #t))
+ (drv1 (parameterize ((%graft? #t))
+ (run-with-store %store
+ (lower-object computed)))))
+ (build-derivations %store (list drv1))
+
+ ;; The graph obtained in COMPUTED should refer to the grafted version of
+ ;; PKG, not to PKG itself.
+ (string=? (call-with-input-file (derivation->output-path drv1)
+ get-string-all)
+ (derivation->output-path drv0))))
+
(test-equal "lower-object, computed-file, #:system"
'("mips64el-linux")
(run-with-store %store
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62..d0646bbc85 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
;;;
;;; This file is part of GNU Guix.
;;;
@@ -161,4 +162,31 @@
(commit-relation master1 merge)
(commit-relation merge master1))))))
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs"
+ '("refs/heads/develop" "refs/heads/master"
+ "refs/tags/v1.0" "refs/tags/v1.1")
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "v1.0" "release-1.0")
+ (branch "develop")
+ (checkout "develop")
+ (add "b.txt" "B")
+ (commit "Second commit")
+ (tag "v1.1" "release-1.1"))
+ (remote-refs directory)))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs: only tags"
+ '("refs/tags/v1.0" "refs/tags/v1.1")
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "v1.0" "Release 1.0")
+ (add "b.txt" "B")
+ (commit "Second commit")
+ (tag "v1.1" "Release 1.1"))
+ (remote-refs directory #:tags? #t)))
+
(test-end "git")
diff --git a/tests/go.scm b/tests/go.scm
index 9e7223ff7c..a70a0ddbf5 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -99,7 +99,7 @@ replace (
")
-(define fixture-go-mod-unparseable
+(define fixture-go-mod-unparsable
"module my/thing
go 1.12 // avoid feature X
require other/thing v1.0.2
@@ -263,7 +263,7 @@ require github.com/kr/pretty v0.2.1
(with (module-path "good/thing") (version "v1.4.5"))))
(parse-go.mod fixture-go-mod-simple))
-(test-equal "parse-go.mod: comments and unparseable lines"
+(test-equal "parse-go.mod: comments and unparsable lines"
`((module (module-path "my/thing"))
(go (version "1.12") (comment "avoid feature X"))
(require (module-path "other/thing") (version "v1.0.2"))
@@ -274,7 +274,7 @@ require github.com/kr/pretty v0.2.1
(with (module-path "good/thing") (version "v1.4.5")))
(comment "Unparseable")
(unknown "bad/thing [v1.4.5, v1.9.7] => good/thing v2.0.0"))
- (parse-go.mod fixture-go-mod-unparseable))
+ (parse-go.mod fixture-go-mod-unparsable))
(test-equal "parse-go.mod: retract"
`((retract (version "v0.9.1"))
diff --git a/tests/graph.scm b/tests/graph.scm
index e374dad1a5..fadac265f9 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -94,6 +94,25 @@ edges."
(list p3 p3 p2)
(list p2 p1 p1))))))))
+(test-assert "package DAG, limited depth"
+ (let-values (((backend nodes+edges) (make-recording-backend)))
+ (let* ((p1 (dummy-package "p1"))
+ (p2 (dummy-package "p2" (inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3" (inputs `(("p1" ,p1)))))
+ (p4 (dummy-package "p4" (inputs `(("p2" ,p2) ("p3" ,p3))))))
+ (run-with-store %store
+ (export-graph (list p4) 'port
+ #:max-depth 1
+ #:node-type %package-node-type
+ #:backend backend))
+ ;; We should see nothing more than these 3 packages.
+ (let-values (((nodes edges) (nodes+edges)))
+ (and (equal? nodes (map package->tuple (list p4 p2 p3)))
+ (equal? edges
+ (map edge->tuple
+ (list p4 p4)
+ (list p2 p3))))))))
+
(test-assert "reverse package DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 3d2de092b1..86e41e2927 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -77,6 +77,16 @@ module_dir="t-guix-build-$$"
mkdir "$module_dir"
trap "rm -rf $module_dir" EXIT
+# Check error reporting for '-f'.
+cat > "$module_dir/foo.scm" <<EOF
+(use-modules (guix))
+) ;extra closing paren
+EOF
+! guix build -f "$module_dir/foo.scm" 2> "$module_dir/stderr"
+grep "read error" "$module_dir/stderr"
+rm "$module_dir/stderr" "$module_dir/foo.scm"
+
+# Check 'GUIX_PACKAGE_PATH' & co.
cat > "$module_dir/foo.scm"<<EOF
(define-module (foo)
#:use-module (guix tests)
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index f2d15c8d0c..2e238c501d 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -44,6 +44,14 @@ else
test $? = 42
fi
+# Try '--root' and '--profile'.
+root="$tmpdir/root"
+guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
+guix environment -C -p "$root" --bootstrap -- guile --version
+path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
+path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap -- guile -c '(display (getenv "PATH"))')
+test "$path1" = "$path2"
+
# Make sure "localhost" resolves.
guix environment --container --ad-hoc --bootstrap guile-bootstrap \
-- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index fe2430b658..95fe95b437 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -119,6 +119,13 @@ test `readlink "$gcroot"` = "$expected"
guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
-- guile -c 1
test `readlink "$gcroot"` = "$expected"
+
+# Make sure '-p' works as expected.
+test $(guix environment -p "$gcroot" -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT') = "$expected"
+paths1="$(guix environment -p "$gcroot" --search-paths)"
+paths2="$(guix environment --bootstrap --ad-hoc guile-bootstrap --search-paths)"
+test "$paths1" = "$paths2"
+
rm "$gcroot"
# Try '-r' with a relative file name.
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index c4461fa955..854c493514 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -34,6 +34,15 @@ test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfes
test `guix hash -H sha512 -f hex /dev/null` = cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e
test `guix hash -H sha1 -f base64 /dev/null` = "2jmj7l5rSw0yVb/vlWAYkK/YBwk="
+# Several files.
+test "`guix hash /dev/null "$abs_top_srcdir/README"`" = "`guix hash /dev/null ; guix hash "$abs_top_srcdir/README"`"
+
+# Zero files.
+! guix hash
+
+# idem as `cat /dev/null | git hash-object --stdin`
+test `guix hash -S git -H sha1 -f hex /dev/null` = e69de29bb2d1d6434b8b29ae775ad8c2e48c5391
+
! guix hash -H abcd1234 /dev/null
mkdir "$tmpdir"
@@ -42,25 +51,32 @@ chmod +x "$tmpdir/exe"
( cd "$tmpdir" ; ln -s exe symlink )
mkdir "$tmpdir/subdir"
-test `guix hash -r "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
-test `guix hash -r "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
+test `guix hash -S nar "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+test `guix hash -S nar "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
+test `guix hash -S git "$tmpdir" -H sha512` = 158b10d1bsdk4pm8ym9cg9ckfak1b0cgpw7365cl6s341ir380mh2f4ylicyh8khyrfnwq5cn9766d7m8fbfwwl94ndkv456v6a8knr
+
+# Deprecated --recursive option
+test `guix hash -r "$tmpdir" 2>/dev/null` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+test `guix hash -r "$tmpdir" -H sha512 2>/dev/null` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
# Without '-r', this should fail.
! guix hash "$tmpdir"
# This should fail because /dev/null is a character device, which
# the archive format doesn't support.
-! guix hash -r /dev/null
+! guix hash -S nar /dev/null
# Adding a .git directory
mkdir "$tmpdir/.git"
touch "$tmpdir/.git/foo"
# ...changes the hash
-test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
+test `guix hash -S nar $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59
+test `guix hash -S git $tmpdir` = 0ghlpca9xaswa1ay1g55dknwd9q899mi3ahfr43pq083v8wisjc7
# ...but remains the same when using `-x'
-test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+test `guix hash -S nar $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
+test `guix hash -S git $tmpdir -x` = 0ghlpca9xaswa1ay1g55dknwd9q899mi3ahfr43pq083v8wisjc7
# Without '-r', this should fail.
! guix hash "$tmpdir"
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
new file mode 100644
index 0000000000..e578559c97
--- /dev/null
+++ b/tests/guix-home.sh
@@ -0,0 +1,131 @@
+
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2021 Andrew Tropin <andrew@trop.in>
+# Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix home' using the external store, if any.
+#
+
+set -e
+
+guix home --version
+
+NIX_STORE_DIR="$(guile -c '(use-modules (guix config))(display %storedir)')"
+localstatedir="$(guile -c '(use-modules (guix config))(display %localstatedir)')"
+GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
+export NIX_STORE_DIR GUIX_DAEMON_SOCKET
+
+# Run tests only when a "real" daemon is available.
+if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
+then
+ exit 77
+fi
+
+STORE_PARENT="$(dirname "$NIX_STORE_DIR")"
+export STORE_PARENT
+if test "$STORE_PARENT" = "/"; then exit 77; fi
+
+test_directory="$(mktemp -d)"
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+(
+ cd "$test_directory" || exit 77
+
+ HOME="$test_directory"
+ export HOME
+
+ #
+ # Test 'guix home reconfigure'.
+ #
+
+ printf "# dot-bashrc test file for guix home" > "dot-bashrc"
+
+ cat > "home.scm" <<'EOF'
+(use-modules (guix gexp)
+ (gnu home)
+ (gnu home services)
+ (gnu home services shells)
+ (gnu services))
+
+(home-environment
+ (services
+ (list
+ (simple-service 'test-config
+ home-files-service-type
+ (list `("config/test.conf"
+ ,(plain-file
+ "tmp-file.txt"
+ "the content of ~/.config/test.conf"))))
+
+ (service home-bash-service-type
+ (home-bash-configuration
+ (guix-defaults? #t)
+ (bashrc
+ (list
+ (local-file (string-append (dirname (current-filename))
+ "/dot-bashrc"))))))
+
+ (simple-service 'home-bash-service-extension-test
+ home-bash-service-type
+ (home-bash-extension
+ (bashrc
+ (list
+ (plain-file
+ "bashrc-test-config.sh"
+ "# the content of bashrc-test-config.sh"))))))))
+EOF
+
+ guix home reconfigure "${test_directory}/home.scm"
+ test -d "${HOME}/.guix-home"
+ test -h "${HOME}/.bash_profile"
+ test -h "${HOME}/.bashrc"
+ test "$(tail -n 2 "${HOME}/.bashrc")" == "\
+# dot-bashrc test file for guix home
+# the content of bashrc-test-config.sh"
+ grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf"
+
+ #
+ # Test 'guix home describe'.
+ #
+
+ configuration_file()
+ {
+ guix home describe \
+ | grep 'configuration file:' \
+ | cut -d : -f 2 \
+ | xargs echo
+ }
+ test "$(cat "$(configuration_file)")" == "$(cat home.scm)"
+
+ canonical_file_name()
+ {
+ guix home describe \
+ | grep 'canonical file name:' \
+ | cut -d : -f 2 \
+ | xargs echo
+ }
+ test "$(canonical_file_name)" == "$(readlink "${HOME}/.guix-home")"
+
+ #
+ # Test 'guix home search'.
+ #
+
+ guix home search mcron | grep "^name: home-mcron"
+ guix home search job manager | grep "^name: home-mcron"
+)
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
new file mode 100644
index 0000000000..23ff1c5bcf
--- /dev/null
+++ b/tests/guix-shell.sh
@@ -0,0 +1,116 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix shell' alias.
+#
+
+guix shell --version
+
+configdir="t-guix-shell-config-$$"
+tmpdir="t-guix-shell-$$"
+trap 'rm -r "$tmpdir" "$configdir"' EXIT
+mkdir "$tmpdir" "$configdir" "$configdir/guix"
+
+XDG_CONFIG_HOME="$(realpath $configdir)"
+export XDG_CONFIG_HOME
+
+guix shell --bootstrap --pure guile-bootstrap -- guile --version
+
+# '--ad-hoc' is a thing of the past.
+! guix shell --ad-hoc guile-bootstrap
+
+# Ignoring unauthorized files.
+cat > "$tmpdir/guix.scm" <<EOF
+This is a broken guix.scm file.
+EOF
+! (cd "$tmpdir"; SHELL="$(type -P true)" guix shell --bootstrap 2> "stderr")
+grep "not authorized" "$tmpdir/stderr"
+rm "$tmpdir/stderr"
+
+# Authorize the directory.
+echo "$(realpath "$tmpdir")" > "$configdir/guix/shell-authorized-directories"
+
+# Ignoring 'manifest.scm' and 'guix.scm' in non-interactive use.
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+mv "$tmpdir/guix.scm" "$tmpdir/manifest.scm"
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+rm "$tmpdir/manifest.scm"
+
+# Honoring the local 'manifest.scm' file.
+cat > "$tmpdir/manifest.scm" <<EOF
+(specifications->manifest '("guile-bootstrap"))
+EOF
+cat > "$tmpdir/fake-shell.sh" <<EOF
+#!$SHELL
+# This fake shell allows us to test interactive use.
+exec echo "\$GUIX_ENVIRONMENT"
+EOF
+chmod +x "$tmpdir/fake-shell.sh"
+profile1="$(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap)"
+profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT')"
+test -n "$profile1"
+test "$profile1" = "$profile2"
+rm "$tmpdir/manifest.scm"
+
+# Do not read manifest when passed '-q'.
+echo "Broken manifest." > "$tmpdir/manifest.scm"
+(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap -q)
+rm "$tmpdir/manifest.scm"
+
+# Make sure '-D' affects only the immediately following '-f', and not packages
+# that appear later: <https://issues.guix.gnu.org/52093>.
+cat > "$tmpdir/empty-package.scm" <<EOF
+(use-modules (guix) (guix tests)
+ (guix build-system trivial))
+
+(dummy-package "empty-package"
+ (build-system trivial-build-system)) ;zero inputs
+EOF
+
+guix shell --bootstrap --pure -D -f "$tmpdir/empty-package.scm" \
+ guile-bootstrap -- guile --version
+rm "$tmpdir/empty-package.scm"
+
+if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+then
+ # Compute the build environment for the initial GNU Make.
+ guix shell --bootstrap --no-substitutes --search-paths --pure \
+ -D -e '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/a"
+
+ # Make sure bootstrap binaries are in the profile.
+ profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
+
+ # Make sure the bootstrap binaries are all listed where they belong.
+ grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a"
+ grep -E "^export C_INCLUDE_PATH=\"$profile/include\"" "$tmpdir/a"
+ grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+ for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
+ do
+ guix gc --references "$profile" | grep "$dep"
+ done
+
+ # 'make-boot0' itself must not be listed.
+ ! guix gc --references "$profile" | grep make-boot0
+
+ # Honoring the local 'guix.scm' file.
+ echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
+ (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+ cmp "$tmpdir/a" "$tmpdir/b"
+ rm "$tmpdir/guix.scm"
+fi
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 9919d54f47..189b9af173 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -171,10 +171,7 @@ library
('source
('origin
('method 'url-fetch)
- ('uri ('string-append
- "https://hackage.haskell.org/package/foo/foo-"
- 'version
- ".tar.gz"))
+ ('uri ('hackage-uri "foo" 'version))
('sha256
('base32
(? string? hash)))))
@@ -214,10 +211,7 @@ library
('source
('origin
('method 'url-fetch)
- ('uri ('string-append
- "https://hackage.haskell.org/package/foo/foo-"
- 'version
- ".tar.gz"))
+ ('uri ('hackage-uri "foo" 'version))
('sha256
('base32
(? string? hash)))))
@@ -337,10 +331,7 @@ executable cabal
('source
('origin
('method 'url-fetch)
- ('uri ('string-append
- "https://hackage.haskell.org/package/foo/foo-"
- 'version
- ".tar.gz"))
+ ('uri ('hackage-uri "foo" 'version))
('sha256
('base32
(? string? hash)))))
@@ -401,10 +392,7 @@ executable cabal
('source
('origin
('method 'url-fetch)
- ('uri ('string-append
- "https://hackage.haskell.org/package/foo/foo-"
- 'version
- ".tar.gz"))
+ ('uri ('hackage-uri "foo" 'version))
('sha256
('base32
(? string? hash)))))
diff --git a/tests/home-import.scm b/tests/home-import.scm
new file mode 100644
index 0000000000..0bcdf8a469
--- /dev/null
+++ b/tests/home-import.scm
@@ -0,0 +1,188 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-home-import)
+ #:use-module (guix scripts home import)
+ #:use-module (guix utils)
+ #:use-module (guix build utils)
+ #:use-module (guix packages)
+ #:use-module (ice-9 match)
+ #:use-module ((guix profiles) #:hide (manifest->code))
+ #:use-module ((guix build syscalls) #:select (mkdtemp!))
+ #:use-module ((guix scripts package)
+ #:select (manifest-entry-version-prefix))
+ #:use-module (gnu packages)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix scripts home import) tools.
+
+(test-begin "home-import")
+
+;; Example manifest entries.
+
+(define guile-2.0.9
+ (manifest-entry
+ (name "guile")
+ (version "2.0.9")
+ (item "/gnu/store/...")))
+
+(define glibc
+ (manifest-entry
+ (name "glibc")
+ (version "2.19")
+ (item "/gnu/store/...")))
+
+(define gcc
+ (manifest-entry
+ (name "gcc")
+ (version "10.3.0")
+ (item "/gnu/store/...")))
+
+;; Helpers for checking and generating home environments.
+
+(define %destination-directory "/tmp/guix-config")
+(mkdir-p %destination-directory)
+
+(define %temporary-home-directory (mkdtemp! "/tmp/guix-home-import.XXXXXX"))
+
+(define-syntax-rule (define-home-environment-matcher name pattern)
+ (define (name obj)
+ (match obj
+ (pattern #t)
+ (x (pk 'fail x #f)))))
+
+(define (create-temporary-home files-alist)
+ "Create a temporary home directory in '%temporary-home-directory'.
+FILES-ALIST is an association list of files and the content of the
+corresponding file."
+ (define (create-file file content)
+ (let ((absolute-path (string-append %temporary-home-directory "/" file)))
+ (unless (file-exists? absolute-path)
+ (mkdir-p (dirname absolute-path)))
+ (call-with-output-file absolute-path
+ (cut display content <>))))
+
+ (for-each (match-lambda
+ ((file . content) (create-file file content)))
+ files-alist))
+
+(define (eval-test-with-home-environment files-alist manifest matcher)
+ (create-temporary-home files-alist)
+ (setenv "HOME" %temporary-home-directory)
+ (mkdir-p %temporary-home-directory)
+ (let* ((home-environment (manifest+configuration-files->code
+ manifest %destination-directory))
+ (result (matcher home-environment)))
+ (delete-file-recursively %temporary-home-directory)
+ result))
+
+(define-home-environment-matcher match-home-environment-no-services
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list "guile@2.0.9" "gcc" "glibc@2.19")))
+ ('services
+ ('list)))))
+
+(define-home-environment-matcher match-home-environment-transformations
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services)
+ ('guix 'transformations))
+
+ ('define transform ('options->transformation _))
+ ('home-environment
+ ('packages
+ ('list (transform ('specification->package "guile@2.0.9"))
+ ('specification->package "gcc")
+ ('specification->package "glibc@2.19")))
+ ('services ('list)))))
+
+(define-home-environment-matcher match-home-environment-no-services-nor-packages
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list)))
+ ('services
+ ('list)))))
+
+(define-home-environment-matcher match-home-environment-bash-service
+ ('begin
+ ('use-modules
+ ('gnu 'home)
+ ('gnu 'packages)
+ ('gnu 'services)
+ ('guix 'gexp)
+ ('gnu 'home 'services 'shells))
+ ('home-environment
+ ('packages
+ ('map 'specification->package
+ ('list)))
+ ('services
+ ('list ('service
+ 'home-bash-service-type
+ ('home-bash-configuration
+ ('aliases ('quote ()))
+ ('bashrc
+ ('list ('local-file "/tmp/guix-config/.bashrc"
+ "bashrc"))))))))))
+
+
+(test-assert "manifest->code: No services"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest (list guile-2.0.9 gcc glibc))
+ match-home-environment-no-services))
+
+(test-assert "manifest->code: No services, package transformations"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest (list (manifest-entry
+ (inherit guile-2.0.9)
+ (properties `((transformations
+ . ((foo . "bar"))))))
+ gcc glibc))
+ match-home-environment-transformations))
+
+(test-assert "manifest->code: No packages nor services"
+ (eval-test-with-home-environment
+ '()
+ (make-manifest '())
+ match-home-environment-no-services-nor-packages))
+
+(test-assert "manifest->code: Bash service"
+ (eval-test-with-home-environment
+ '((".bashrc" . "echo 'hello guix'"))
+ (make-manifest '())
+ match-home-environment-bash-service))
+
+(test-end "home-import")
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 0000000000..f1bce154bb
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,245 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-import-git)
+ #:use-module (git)
+ #:use-module (guix git)
+ #:use-module (guix tests)
+ #:use-module (guix packages)
+ #:use-module (guix import git)
+ #:use-module (guix git-download)
+ #:use-module (guix tests git)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix import git) tools.
+
+(test-begin "git")
+
+(define* (make-package directory version #:optional (properties '()))
+ (dummy-package "test-package"
+ (version version)
+ (properties properties)
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url (string-append "file://" directory))
+ (commit version)))
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "1.0.1" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix-1.0.1" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "prefix-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "1.0.1-suffix-123" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-suffix . "-suffix-[0-9]*")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
+ "2021.09.07"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2021-09-07" "Release 2021-09-07"))
+ (let ((package (make-package directory "2021-09-06"
+ '((release-tag-version-delimiter . "-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
+ "20210907"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "20210907" "Release 20210907"))
+ (let ((package (make-package directory "20210906"
+ '((release-tag-version-delimiter . "")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
+ "2.0.0"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "Release-")
+ (release-tag-suffix . "suffix-[0-9]")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
+ "2.0.0"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "Release-")
+ (release-tag-suffix . "suffix-[0-9]")
+ (release-tag-version-delimiter . "_")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: only pre-releases available"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "version-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-suffix . "-suffix")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, delimiter conflicts with pre-release part"
+ "2.0.0_alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2_0_0_alpha" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-version-delimiter . "_")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
+ "2.0.0-alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
+ "2.0.0-alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2-0-0-alpha-suffix" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")
+ (release-tag-version-delimiter . "-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, no delimiter, and custom suffix, prefix"
+ "2alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2alpha-suffix" "Alpha release for version 2"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")
+ (release-tag-version-delimiter . "")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no tags found"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no valid tags found"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Test" "Test tag"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(test-end "git")
diff --git a/tests/lint.scm b/tests/lint.scm
index dfb45ef60d..76c2a70b3a 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -107,7 +107,7 @@
"Texinfo markup in description is invalid"
(single-lint-warning-message
(check-description-style
- (dummy-package "x" (description "f{oo}b@r")))))
+ (dummy-package "x" (description (identity "f{oo}b@r"))))))
(test-equal "description: does not start with an upper-case letter"
"description should start with an upper-case letter or digit"
@@ -177,6 +177,20 @@
(description "Whitespace. "))))
(check-description-style pkg))))
+(test-equal "description: pluralized 'This package'"
+ "description contains typo 'This packages', should be 'This package'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (description "This packages is a typo."))))
+ (check-description-style pkg))))
+
+(test-equal "description: grammar 'allows to'"
+ "description contains typo 'allows to'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (description "This package allows to do stuff."))))
+ (check-description-style pkg))))
+
(test-equal "synopsis: not a string"
"invalid synopsis: #f"
(single-lint-warning-message
@@ -195,7 +209,7 @@
"Texinfo markup in synopsis is invalid"
(single-lint-warning-message
(check-synopsis-style
- (dummy-package "x" (synopsis "Bad $@ texinfo")))))
+ (dummy-package "x" (synopsis (identity "Bad $@ texinfo"))))))
(test-equal "synopsis: does not start with an upper-case letter"
"synopsis should start with an upper-case letter or digit"
@@ -506,17 +520,17 @@
(file-name "x.patch")))))))))
(check-patch-file-names pkg)))
-(test-equal "patches: file name too long"
+(test-equal "patches: file name too long, which may break 'make dist'"
(string-append "x-"
- (make-string 100 #\a)
- ".patch: file name is too long")
+ (make-string 152 #\a)
+ ".patch: file name is too long, which may break 'make dist'")
(single-lint-warning-message
(let ((pkg (dummy-package
"x"
(source
(dummy-origin
(patches (list (string-append "x-"
- (make-string 100 #\a)
+ (make-string 152 #\a)
".patch"))))))))
(check-patch-file-names pkg))))
@@ -1331,29 +1345,34 @@
(test-assert "haskell-stackage"
(let* ((stackage (string-append "{ \"packages\": [{"
- " \"name\":\"x\","
- " \"version\":\"1.0\" }]}"))
+ " \"name\":\"pandoc\","
+ " \"synopsis\":\"synopsis\","
+ " \"version\":\"1.0\" }],"
+ " \"snapshot\": {"
+ " \"ghc\": \"8.6.5\","
+ " \"name\": \"lts-14.27\""
+ " }}"))
(packages (map (lambda (version)
(dummy-package
- (string-append "ghc-x")
+ "ghc-pandoc"
(version version)
(source
(dummy-origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/"
- "x-" version "/x-" version ".tar.gz"))))))
- '("0.9" "1.0" "2.0")))
+ "pandoc-" version "/pandoc-" version ".tar.gz"))))))
+ '("0.9" "1.0" "100.0")))
(warnings (pk (with-http-server `((200 ,stackage) ; memoized
- (200 "name: x\nversion: 1.0\n")
- (200 "name: x\nversion: 1.0\n")
- (200 "name: x\nversion: 1.0\n"))
+ (200 "name: pandoc\nversion: 1.0\n")
+ (200 "name: pandoc\nversion: 1.0\n")
+ (200 "name: pandoc\nversion: 1.0\n"))
(parameterize ((%hackage-url (%local-url))
(%stackage-url (%local-url)))
(append-map check-haskell-stackage packages))))))
(match warnings
(((? lint-warning? warning))
- (and (string=? (package-version (lint-warning-package warning)) "2.0")
+ (and (string=? (package-version (lint-warning-package warning)) "100.0")
(string-contains (lint-warning-message warning)
"ahead of Stackage LTS version"))))))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 6ae476fe5f..77b9aa928f 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -17,10 +17,18 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-minetest)
+ #:use-module (guix build-system minetest)
+ #:use-module (guix upstream)
#:use-module (guix memoization)
#:use-module (guix import minetest)
#:use-module (guix import utils)
#:use-module (guix tests)
+ #:use-module (guix packages)
+ #:use-module (guix git-download)
+ #:use-module ((gnu packages minetest)
+ #:select (minetest minetest-technic))
+ #:use-module ((gnu packages base)
+ #:select (hello))
#:use-module (json)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -33,6 +41,10 @@
(define* (make-package-sexp #:key
(guix-name "minetest-foo")
+ ;; This is not a proper version number but
+ ;; ContentDB often does not include version
+ ;; numbers.
+ (version "2021-07-25")
(home-page "https://example.org/foo")
(repo "https://example.org/foo.git")
(synopsis "synopsis")
@@ -44,9 +56,7 @@
#:allow-other-keys)
`(package
(name ,guix-name)
- ;; This is not a proper version number but ContentDB does not include
- ;; version numbers.
- (version "2021-07-25")
+ (version ,version)
(source
(origin
(method git-fetch)
@@ -106,14 +116,14 @@
author "/" name "/download/"))
("website" . ,website)))
-(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys)
+(define* (make-releases-json #:key (commit #f) (title "2021-07-25") #:allow-other-keys)
`#((("commit" . ,commit)
("downloads" . 469)
("id" . 8614)
("max_minetest_version" . null)
("min_minetest_version" . null)
("release_date" . "2021-07-25T01:10:23.207584")
- ("title" . "2021-07-25"))))
+ ("title" . ,title))))
(define* (make-dependencies-json #:key (author "Author")
(name "foo")
@@ -247,14 +257,14 @@ during a dynamic extent where that package is available on ContentDB."
#:guix-name "minetest-foo-bar"
#:upstream-name "Author/foo_bar")
-(test-equal "elaborate names, unambigious"
+(test-equal "elaborate names, unambiguous"
"Jeija/mesecons"
(call-with-packages
(cut elaborate-contentdb-name "mesecons")
'(#:name "mesecons" #:author "Jeija")
'(#:name "something" #:author "else")))
-(test-equal "elaborate name, ambigious (highest score)"
+(test-equal "elaborate name, ambiguous (highest score)"
"Jeija/mesecons"
(call-with-packages
;; #:sort "score" is the default
@@ -264,7 +274,7 @@ during a dynamic extent where that package is available on ContentDB."
'(#:name "mesecons" #:author "Jeija" #:score 999)))
-(test-equal "elaborate name, ambigious (most downloads)"
+(test-equal "elaborate name, ambiguous (most downloads)"
"Jeija/mesecons"
(call-with-packages
(cut elaborate-contentdb-name "mesecons" #:sort "downloads")
@@ -293,9 +303,20 @@ during a dynamic extent where that package is available on ContentDB."
#:repo 'null)
+;; Determining the version number
+
+(test-package "conventional version number" #:version "1.2.3" #:title "1.2.3")
+;; See e.g. orwell/basic_trains
+(test-package "v-prefixed version number" #:version "1.2.3" #:title "v1.2.3")
+;; Many mods on ContentDB use dates as release titles. In that case, the date
+;; will have to do.
+(test-package "dates as version number"
+ #:version "2021-01-01" #:title "2021-01-01")
+
+
;; Dependencies
-(test-package* "minetest->guix-package, unambigious dependency"
+(test-package* "minetest->guix-package, unambiguous dependency"
(list #:requirements '(("mesecons" #f
("Jeija/mesecons"
"some-modpack/containing-mese")))
@@ -303,7 +324,7 @@ during a dynamic extent where that package is available on ContentDB."
(list #:author "Jeija" #:name "mesecons")
(list #:author "some-modpack" #:name "containing-mese" #:type "modpack"))
-(test-package* "minetest->guix-package, ambigious dependency (highest score)"
+(test-package* "minetest->guix-package, ambiguous dependency (highest score)"
(list #:name "frobnicate"
#:guix-name "minetest-frobnicate"
#:upstream-name "Author/frobnicate"
@@ -314,7 +335,7 @@ during a dynamic extent where that package is available on ContentDB."
(list #:author "Author" #:name "foo" #:score 0)
(list #:author "Author" #:name "bar" #:score 9999))
-(test-package* "minetest->guix-package, ambigious dependency (most downloads)"
+(test-package* "minetest->guix-package, ambiguous dependency (most downloads)"
(list #:name "frobnicate"
#:guix-name "minetest-frobnicate"
#:upstream-name "Author/frobnicate"
@@ -331,6 +352,16 @@ during a dynamic extent where that package is available on ContentDB."
"some-modpack/containing-mese")))
#:inputs '())
+;; See e.g. 'orwell/basic_trains'
+(test-package* "minetest->guix-package, multiple dependencies implemented by one mod"
+ (list #:name "frobnicate"
+ #:guix-name "minetest-frobnicate"
+ #:upstream-name "Author/frobnicate"
+ #:requirements '(("frob" #f ("Author/frob"))
+ ("frob_x" #f ("Author/frob")))
+ #:inputs '("minetest-frob"))
+ (list #:author "Author" #:name "frob"))
+
;; License
(test-package "minetest->guix-package, identical licenses"
@@ -352,4 +383,120 @@ during a dynamic extent where that package is available on ContentDB."
(list z y x)
(sort-packages (list x y z))))
+
+
+;; Update detection
+(define (upstream-source->sexp upstream-source)
+ (define urls (upstream-source-urls upstream-source))
+ (unless (= 1 (length urls))
+ (error "only a single URL is expected"))
+ (define url (first urls))
+ `(,(upstream-source-package upstream-source)
+ ,(upstream-source-version upstream-source)
+ ,(git-reference-url url)
+ ,(git-reference-commit url)))
+
+(define* (expected-sexp #:key
+ (repo "https://example.org/foo.git")
+ (guix-name "minetest-foo")
+ (new-version "0.8")
+ (commit "44941798d222901b8f381b3210957d880b90a2fc")
+ #:allow-other-keys)
+ `(,guix-name ,new-version ,repo ,commit))
+
+(define* (example-package #:key
+ (source 'auto)
+ (repo "https://example.org/foo.git")
+ (old-version "0.8")
+ (commit "44941798d222901b8f381b3210957d880b90a2fc")
+ #:allow-other-keys)
+ (package
+ (name "minetest-foo")
+ (version old-version)
+ (source
+ (if (eq? source 'auto)
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url repo)
+ (commit commit #;"808f9ffbd3106da4c92d2367b118b98196c9e81e")))
+ (sha256 #f) ; not important for the following tests
+ (file-name (git-file-name name version)))
+ source))
+ (build-system minetest-mod-build-system)
+ (license #f)
+ (synopsis #f)
+ (description #f)
+ (home-page #f)
+ (properties '((upstream-name . "Author/foo")))))
+
+(define-syntax-rule (test-release test-case . arguments)
+ (test-equal test-case
+ (expected-sexp . arguments)
+ (and=>
+ (call-with-packages
+ (cut latest-minetest-release (example-package . arguments))
+ (list . arguments))
+ upstream-source->sexp)))
+
+(define-syntax-rule (test-no-release test-case . arguments)
+ (test-equal test-case
+ #f
+ (call-with-packages
+ (cut latest-minetest-release (example-package . arguments))
+ (list . arguments))))
+
+(test-release "same version"
+ #:old-version "0.8" #:title "0.8" #:new-version "0.8"
+ #:commit "44941798d222901b8f381b3210957d880b90a2fc")
+
+(test-release "new version (dotted)"
+ #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (date)"
+ #:old-version "2014-11-17" #:title "2015-11-04"
+ #:new-version "2015-11-04"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (git -> dotted)"
+ #:old-version
+ (git-version "0.8" "1" "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+ #:title "0.9.0" #:new-version "0.9.0"
+ #:commit "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+
+;; There might actually be a new release, but guix cannot compare dates
+;; with regular version numbers.
+(test-no-release "dotted -> date"
+ #:old-version "0.8" #:title "2015-11-04"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-no-release "date -> dotted"
+ #:old-version "2014-11-07" #:title "0.8"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+;; Don't let "guix refresh -t minetest" tell there are new versions
+;; if Guix has insufficient information to actually perform the update,
+;; when using --with-latest or "guix refresh -u".
+(test-no-release "no commit information, no new release"
+ #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+ #:commit #false)
+
+(test-assert "minetest is not a minetest mod"
+ (not (minetest-package? minetest)))
+(test-assert "GNU hello is not a minetest mod"
+ (not (minetest-package? hello)))
+(test-assert "technic is a minetest mod"
+ (minetest-package? minetest-technic))
+(test-assert "upstream-name is required"
+ (not (minetest-package?
+ (package (inherit minetest-technic)
+ (properties '())))))
+
(test-end "minetest")
+
+;;; Local Variables:
+;;; eval: (put 'test-package* 'scheme-indent-function 1)
+;;; eval: (put 'test-release 'scheme-indent-function 1)
+;;; eval: (put 'test-no-release 'scheme-indent-function 1)
+;;; End:
diff --git a/tests/nar.scm b/tests/nar.scm
index ba4881caaa..98752f2088 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -486,8 +486,9 @@
;; their mtime and permissions were not reset. Ensure that this bug is
;; gone.
(with-store store
- (let* ((text1 (random-text))
- (text2 (random-text))
+ ;; Note: TEXT1 and TEXT2 must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((text1 (string-concatenate (make-list 200 (random-text))))
+ (text2 (string-concatenate (make-list 200 (random-text))))
(tree `("tree" directory
("a" regular (data ,text1))
("b" directory
diff --git a/tests/opam.scm b/tests/opam.scm
index f2e9a7103c..b5f02f809b 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -72,45 +72,48 @@ url {
(test-begin "opam")
(test-assert "opam->guix-package"
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.org/foo-1.0.0.tar.gz"
- (begin
- (mkdir-p "foo-1.0.0")
- (system* "tar" "czvf" file-name "foo-1.0.0/")
- (delete-file-recursively "foo-1.0.0")
- (set! test-source-hash
- (call-with-input-file file-name port-sha256))))
- (_ (error "Unexpected URL: " url)))))
- (let ((my-package (string-append test-repo
- "/packages/foo/foo.1.0.0")))
- (mkdir-p my-package)
- (with-output-to-file (string-append my-package "/opam")
- (lambda _
- (format #t "~a" test-opam-file))))
- (match (opam->guix-package "foo" #:repo (list test-repo))
- (('package
- ('name "ocaml-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri "https://example.org/foo-1.0.0.tar.gz")
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'ocaml-build-system)
- ('propagated-inputs ('list 'ocaml-zarith))
- ('native-inputs ('list 'ocaml-alcotest 'ocamlbuild))
- ('home-page "https://example.org/")
- ('synopsis "Some example package")
- ('description "This package is just an example.")
- ('license 'license:bsd-3))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f)))))
+ (mock ((guix import opam) get-opam-repository
+ (const test-repo))
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.org/foo-1.0.0.tar.gz"
+ (begin
+ (mkdir-p "foo-1.0.0")
+ (system* "tar" "czvf" file-name "foo-1.0.0/")
+ (delete-file-recursively "foo-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ (_ (error "Unexpected URL: " url)))))
+ (let ((my-package (string-append test-repo
+ "/packages/foo/foo.1.0.0")))
+ (mkdir-p my-package)
+ (with-output-to-file (string-append my-package "/opam")
+ (lambda _
+ (format #t "~a" test-opam-file))))
+ (match (opam->guix-package "foo" #:repo (list test-repo))
+ (('package
+ ('name "ocaml-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri "https://example.org/foo-1.0.0.tar.gz")
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'ocaml-build-system)
+ ('propagated-inputs ('list 'ocaml-zarith))
+ ('native-inputs
+ ('list 'ocaml-alcotest 'ocamlbuild))
+ ('home-page "https://example.org/")
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license 'license:bsd-3))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
diff --git a/tests/packages.scm b/tests/packages.scm
index 46f4da1494..3506f94f91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -358,6 +358,20 @@
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
+(test-assert "package-development-inputs"
+ ;; Note: Due to propagated inputs, 'package-development-inputs' returns a
+ ;; couple more inputs, such as 'linux-libre-headers'.
+ (lset<= equal?
+ `(("source" ,(package-source hello)) ,@(standard-packages))
+ (package-development-inputs hello)))
+
+(test-assert "package-development-inputs, cross-compilation"
+ (lset<= equal?
+ `(("source" ,(package-source hello))
+ ,@(standard-cross-packages "mips64el-linux-gnu" 'host)
+ ,@(standard-cross-packages "mips64el-linux-gnu" 'target))
+ (package-development-inputs hello #:target "mips64el-linux-gnu")))
+
(test-assert "package-closure"
(let-syntax ((dummy-package/no-implicit
(syntax-rules ()
@@ -882,6 +896,28 @@
(build-derivations %store (list d))
#f)))
+(test-assert "trivial with #:allowed-references + grafts"
+ (let* ((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
+ `(#:guile ,g
+ #:allowed-references (,g)
+ #:builder (mkdir %output)))))
+ (d0 (package-derivation %store p #:graft? #f))
+ (d1 (parameterize ((%graft? #t))
+ (package-derivation %store p #:graft? #t))))
+ ;; D1 should be equal to D2 because there's nothing to graft. In
+ ;; particular, its #:disallowed-references should be lowered in the same
+ ;; way (ungrafted) whether or not #:graft? is true.
+ (string=? (derivation-file-name d1) (derivation-file-name d0))))
+
(test-assert "search paths"
(let* ((p (make-prompt-tag "return-search-paths"))
(t (make-parameter "guile-0"))
diff --git a/tests/print.scm b/tests/print.scm
index 1b24e12f2e..d9710d1ed3 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -22,6 +22,7 @@
#:use-module (guix download)
#:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:)
+ #:use-module ((gnu packages) #:select (search-patches))
#:use-module (srfi srfi-64))
(define-syntax-rule (define-with-source object source expr)
@@ -67,6 +68,77 @@
(description "This is a dummy package.")
(license license:gpl3+)))
+(define-with-source pkg-with-origin-input pkg-with-origin-input-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (list (string-append "file:///tmp/test-"
+ version ".tar.gz")
+ (string-append "http://example.org/test-"
+ version ".tar.gz")))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches (search-patches "guile-linux-syscalls.patch"
+ "guile-relocatable.patch"))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (inputs
+ `(("o" ,(origin
+ (method url-fetch)
+ (uri "http://example.org/somefile.txt")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
+(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+ (patches
+ (list (origin
+ (method url-fetch)
+ (uri "http://example.org/x.patch")
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000")))))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
+(define-with-source pkg-with-arguments pkg-with-arguments-source
+ (package
+ (name "test")
+ (version "1.2.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "file:///tmp/test-"
+ version ".tar.gz"))
+ (sha256
+ (base32
+ "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+ (build-system (@ (guix build-system gnu) gnu-build-system))
+ (arguments
+ `(#:disallowed-references (,(@ (gnu packages base) coreutils))))
+ (home-page "http://gnu.org")
+ (synopsis "Dummy")
+ (description "This is a dummy package.")
+ (license license:gpl3+)))
+
(test-equal "simple package"
`(define-public test ,pkg-source)
(package->code pkg))
@@ -75,4 +147,16 @@
`(define-public test ,pkg-with-inputs-source)
(package->code pkg-with-inputs))
+(test-equal "package with origin input"
+ `(define-public test ,pkg-with-origin-input-source)
+ (package->code pkg-with-origin-input))
+
+(test-equal "package with origin patch"
+ `(define-public test ,pkg-with-origin-patch-source)
+ (package->code pkg-with-origin-patch))
+
+(test-equal "package with arguments"
+ `(define-public test ,pkg-with-arguments-source)
+ (package->code pkg-with-arguments))
+
(test-end "print")
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 06a0387221..cac5b73347 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -265,6 +265,13 @@
(manifest-transaction-removal-candidate? guile-2.0.9 t)
(null? install) (null? downgrade) (null? upgrade)))))
+(test-assert "package->development-manifest"
+ (let ((manifest (package->development-manifest packages:hello)))
+ (every (lambda (name)
+ (manifest-installed? manifest
+ (manifest-pattern (name name))))
+ '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
+
(test-assertm "profile-derivation"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index bb81e91839..1ea5f02643 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,7 @@
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
-(define test-json
+(define test-json-1
"{
\"info\": {
\"version\": \"1.0.0\",
@@ -57,6 +58,34 @@
}
}")
+(define test-json-2
+ "{
+ \"info\": {
+ \"version\": \"1.0.0\",
+ \"name\": \"foo-99\",
+ \"license\": \"GNU LGPL\",
+ \"summary\": \"summary\",
+ \"home_page\": \"http://example.com\",
+ \"classifiers\": [],
+ \"download_url\": \"\"
+ },
+ \"urls\": [],
+ \"releases\": {
+ \"1.0.0\": [
+ {
+ \"url\": \"https://example.com/foo-99-1.0.0.egg\",
+ \"packagetype\": \"bdist_egg\"
+ }, {
+ \"url\": \"https://example.com/foo-99-1.0.0.tar.gz\",
+ \"packagetype\": \"sdist\"
+ }, {
+ \"url\": \"https://example.com/foo-99-1.0.0-py2.py3-none-any.whl\",
+ \"packagetype\": \"bdist_wheel\"
+ }
+ ]
+ }
+}")
+
(define test-source-hash
"")
@@ -147,6 +176,13 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(uri (list "https://bitheap.org/cram/cram-0.7.tar.gz"
(pypi-uri "cram" "0.7"))))))))
+(test-equal "guix-package->pypi-name, honor 'upstream-name'"
+ "bar-3"
+ (guix-package->pypi-name
+ (dummy-package "foo"
+ (properties
+ '((upstream-name . "bar-3"))))))
+
(test-equal "specification->requirement-name"
'("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip")
(map specification->requirement-name test-specifications))
@@ -198,8 +234,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
(match (pypi->guix-package "foo")
@@ -219,9 +255,15 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('synopsis "summary")
('description "summary")
('license 'license:lgpl2.0))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
+ (and (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash)
+ (equal? (pypi->guix-package "foo" #:version "1.0.0")
+ (pypi->guix-package "foo"))
+ (catch 'quit
+ (lambda ()
+ (pypi->guix-package "foo" #:version "42"))
+ (const #t))))
(x
(pk 'fail x #f))))))
@@ -259,8 +301,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
;; Not clearing the memoization cache here would mean returning the value
@@ -307,8 +349,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
;; Not clearing the memoization cache here would mean returning the value
@@ -335,4 +377,55 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(x
(pk 'fail x #f))))))
+(test-assert "pypi->guix-package, package name contains \"-\" followed by digits"
+ ;; Replace network resources with sample data.
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.com/foo-99-1.0.0.tar.gz"
+ (begin
+ ;; Unusual requires.txt location should still be found.
+ (mkdir-p "foo-99-1.0.0/src/bizarre.egg-info")
+ (with-output-to-file "foo-99-1.0.0/src/bizarre.egg-info/requires.txt"
+ (lambda ()
+ (display test-requires.txt)))
+ (parameterize ((current-output-port (%make-void-port "rw+")))
+ (system* "tar" "czvf" file-name "foo-99-1.0.0/"))
+ (delete-file-recursively "foo-99-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f)
+ (_ (error "Unexpected URL: " url)))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://pypi.org/pypi/foo-99/json"
+ (values (open-input-string test-json-2)
+ (string-length test-json-2)))
+ ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f)
+ (_ (error "Unexpected URL: " url)))))
+ (match (pypi->guix-package "foo-99")
+ (('package
+ ('name "python-foo-99")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri ('pypi-uri "foo-99" 'version))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('properties ('quote (("upstream-name" . "foo-99"))))
+ ('build-system 'python-build-system)
+ ('propagated-inputs ('list 'python-bar 'python-foo))
+ ('native-inputs ('list 'python-pytest))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license 'license:lgpl2.0))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
+
(test-end "pypi")
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index b1c2d93bbd..2950fbc1a3 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -30,13 +30,40 @@
(test-begin "store-deduplication")
+(test-equal "deduplicate, below %deduplication-minimum-size"
+ (list #t (make-list 5 1))
+
+ (call-with-temporary-directory
+ (lambda (store)
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let ((data "Hello, world!")
+ (identical (map (lambda (n)
+ (string-append store "/" (number->string n)
+ "/a/b/c"))
+ (iota 5))))
+ (for-each (lambda (file)
+ (mkdir-p (dirname file))
+ (call-with-output-file file
+ (lambda (port)
+ (put-bytevector port (string->utf8 data)))))
+ identical)
+
+ (deduplicate store (nar-sha256 store) #:store store)
+
+ ;; (system (string-append "ls -lRia " store))
+ (list (= (length (delete-duplicates
+ (map (compose stat:ino stat) identical)))
+ (length identical))
+ (map (compose stat:nlink stat) identical))))))
+
(test-equal "deduplicate"
(cons* #t #f ;inode comparisons
2 (make-list 5 6)) ;'nlink' values
(call-with-temporary-directory
(lambda (store)
- (let ((data (string->utf8 "Hello, world!"))
+ ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let ((data (string-concatenate (make-list 1000 "Hello, world!")))
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
@@ -46,7 +73,7 @@
(mkdir-p (dirname file))
(call-with-output-file file
(lambda (port)
- (put-bytevector port data))))
+ (put-bytevector port (string->utf8 data)))))
identical)
;; Make the parent of IDENTICAL read-only. This should not prevent
;; deduplication from inserting its hard link.
@@ -54,7 +81,7 @@
(call-with-output-file unique
(lambda (port)
- (put-bytevector port (string->utf8 "This is unique."))))
+ (put-bytevector port (string->utf8 (string-reverse data)))))
(deduplicate store (nar-sha256 store) #:store store)
@@ -77,8 +104,10 @@
(lambda (store)
(let ((true-link link)
(links 0)
- (data1 (string->utf8 "Hello, world!"))
- (data2 (string->utf8 "Hi, world!"))
+ (data1 (string->utf8
+ (string-concatenate (make-list 1000 "Hello, world!"))))
+ (data2 (string->utf8
+ (string-concatenate (make-list 1000 "Hi, world!"))))
(identical (map (lambda (n)
(string-append store "/" (number->string n)
"/a/b/c"))
diff --git a/tests/store.scm b/tests/store.scm
index d895a328a4..5df28adf0d 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -490,6 +490,34 @@
(equal? (map derivation-file-name (drop d 16)) batch3)
lst)))))
+(test-equal "map/accumulate-builds and different store"
+ '(d2) ;see <https://issues.guix.gnu.org/46756>
+ (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+ (s (add-to-store %store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (d1 (derivation %store "first"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text)))
+ #:sources (list b s)))
+ (d2 (derivation %store "second"
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text))
+ ("bar" . "baz"))
+ #:sources (list b s))))
+ (with-store alternate-store
+ (with-build-handler (lambda (continue store things mode)
+ ;; If this handler is called, it means that
+ ;; 'map/accumulate-builds' triggered a build,
+ ;; which it shouldn't since the inner
+ ;; 'build-derivations' call is for another store.
+ 'failed)
+ (map/accumulate-builds %store
+ (lambda (drv)
+ (build-derivations alternate-store (list d2))
+ 'd2)
+ (list d1))))))
+
(test-assert "mapm/accumulate-builds"
(let* ((d1 (run-with-store %store
(gexp->derivation "foo" #~(mkdir #$output))))
@@ -732,7 +760,9 @@
(test-assert "substitute, deduplication"
(with-store s
- (let* ((c (random-text)) ; contents of the output
+ ;; Note: C must be longer than %DEDUPLICATION-MINIMUM-SIZE.
+ (let* ((c (string-concatenate
+ (make-list 200 (random-text)))) ; contents of the output
(g (package-derivation s %bootstrap-guile))
(d1 (build-expression->derivation s "substitute-me"
`(begin ,c (exit 1))
@@ -913,6 +943,84 @@
(build-derivations s (list d))
#f))))))
+(test-equal "substitute query and large size"
+ (+ 100 (expt 2 63)) ;<https://issues.guix.gnu.org/51983>
+ (with-store s
+ (let* ((size (+ 100 (expt 2 63))) ;does not fit in signed 'long long'
+ (item (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size")))
+ ;; Create fake substituter data, to be read by 'guix substitute'.
+ (call-with-output-file (string-append (%substitute-directory)
+ "/" (store-path-hash-part item)
+ ".narinfo")
+ (lambda (port)
+ (format port "StorePath: ~a
+URL: http://example.org
+Compression: none
+NarSize: ~a
+NarHash: sha256:0fj9vhblff2997pi7qjj7lhmy7wzhnjwmkm2hmq6gr4fzmg10s0w
+References:
+System: x86_64-linux~%"
+ item size)))
+
+ ;; Remove entry from the local cache.
+ (false-if-exception
+ (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
+ "/guix/substitute")))
+
+ ;; Make sure 'guix substitute' correctly communicates the above
+ ;; data.
+ (set-build-options s #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+ (match (pk 'spi (substitutable-path-info s (list item)))
+ (((? substitutable? s))
+ (and (equal? (substitutable-path s) item)
+ (substitutable-nar-size s)))))))
+
+(test-equal "substitute and large size"
+ (+ 100 (expt 2 31)) ;<https://issues.guix.gnu.org/46212>
+ (with-store s
+ (let* ((size (+ 100 (expt 2 31))) ;does not fit in signed 'int'
+ (item (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bad-size-"
+ (random-text)))
+ (nar (string-append (%substitute-directory) "/nar")))
+ ;; Create a dummy nar to allow for substitution.
+ (call-with-output-file nar
+ (lambda (port)
+ (write-file-tree (store-path-package-name item) port
+ #:file-type+size (lambda _
+ (values 'regular 12))
+ #:file-port (lambda _
+ (open-input-string "Hello world.")))))
+
+ ;; Create fake substituter data, to be read by 'guix substitute'.
+ (call-with-output-file (string-append (%substitute-directory)
+ "/" (store-path-hash-part item)
+ ".narinfo")
+ (lambda (port)
+ (format port "StorePath: ~a
+URL: file://~a
+Compression: none
+NarSize: ~a
+NarHash: sha256:~a
+References:
+System: x86_64-linux~%"
+ item nar size
+ (bytevector->nix-base32-string (gcrypt:file-sha256 nar)))))
+
+ ;; Remove entry from the local cache.
+ (false-if-exception
+ (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME")
+ "/guix/substitute")))
+
+ ;; Make sure 'guix substitute' correctly communicates the above
+ ;; data.
+ (set-build-options s #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+ (ensure-path s item)
+ (path-info-nar-size (query-path-info s item)))))
+
(test-assert "export/import several paths"
(let* ((texts (unfold (cut >= <> 10)
(lambda _ (random-text))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 706dd4177f..c9e011f453 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -26,6 +26,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
+ #:use-module (srfi srfi-71)
#:use-module (system foreign)
#:use-module ((ice-9 ftw) #:select (scandir))
#:use-module (ice-9 match))
@@ -582,6 +583,40 @@
(test-assert "terminal-rows"
(> (terminal-rows) 0))
+(test-assert "openpty"
+ (let ((head inferior (openpty)))
+ (and (integer? head) (integer? inferior)
+ (let ((port (fdopen inferior "r+0")))
+ (and (isatty? port)
+ (begin
+ (close-port port)
+ (close-fdes head)
+ #t))))))
+
+(test-equal "openpty + login-tty"
+ '(hello world)
+ (let ((head inferior (openpty)))
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setvbuf (current-input-port) 'none)
+ (close-fdes head)
+ (login-tty inferior)
+ (write (read))
+ (read)) ;this gets EIO when HEAD is closed
+ (lambda ()
+ (primitive-_exit 42))))
+ (pid
+ (close-fdes inferior)
+ (let ((head (fdopen head "r+0")))
+ (write '(hello world) head)
+ (let ((result (read head)))
+ (close-port head)
+ (waitpid pid)
+ result))))))
+
(test-assert "utmpx-entries"
(match (utmpx-entries)
(((? utmpx? entries) ...)
diff --git a/tests/texlive.scm b/tests/texlive.scm
index a6f08046a8..368e36e31a 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -30,87 +30,174 @@
(test-begin "texlive")
-(define xml
- "\
-<entry id=\"foo\">
- <name>foo</name>
- <caption>Foomatic frobnication in LuaLaTeX</caption>
- <authorref id=\"rekado\"/>
- <license type=\"lppl1.3\"/>
- <version number=\"2.6a\"/>
- <description>
- <p>
- Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals
- in a foomatic way with the LuaTeX engine.
- </p>
- <p>
- The package requires the bar and golly
- bundles for extremely special specialties.
- </p>
- </description>
- <ctan path=\"/macros/latex/contrib/foo\" file=\"true\"/>
- <texlive location=\"foo\"/>
- <keyval key=\"topic\" value=\"tests\"/>
- null
-</entry>")
+(define %fake-tlpdb
+ '(("stricttex"
+ . ((name
+ . "stricttex")
+ (shortdesc
+ . "Strictly balanced brackets and numbers in command names")
+ (longdesc
+ . "This is a small, LuaLaTeX-only package providing you with three,
+sometimes useful features: It allows you to make brackets [...] \"strict\",
+meaning that each [ must be balanced by a ]. It allows you to use numbers in
+command names, so that you can do stuff like \\newcommand\\pi12{\\pi_{12}}. It
+allows you to use numbers and primes in command names, so that you can do
+stuff like \\newcommand\\pi'12{\\pi '_{12}}.")
+ (docfiles
+ . ("texmf-dist/doc/lualatex/stricttex/README.md"
+ "texmf-dist/doc/lualatex/stricttex/stricttex.pdf"))
+ (runfiles
+ . ("texmf-dist/tex/lualatex/stricttex/stricttex.lua"
+ "texmf-dist/tex/lualatex/stricttex/stricttex.sty"))
+ (catalogue-license . "lppl1.3c")))
+ ("texsis"
+ . ((name
+ . "texsis")
+ (shortdesc
+ . "Plain TeX macros for Physicists")
+ (longdesc
+ . "TeXsis is a TeX macro package which provides useful features for
+typesetting research papers and related documents. For example, it includes
+support specifically for: Automatic numbering of equations, figures, tables
+and references; Simplified control of type sizes, line spacing, footnotes,
+running headlines and footlines, and tables of contents, figures and tables;
+Specialized document formats for research papers, preprints and \"e-prints\",
+conference proceedings, theses, books, referee reports, letters, and
+memoranda; Simplified means of constructing an index for a book or thesis;
+Easy to use double column formatting; Specialized environments for lists,
+theorems and proofs, centered or non-justified text, and listing computer
+code; Specialized macros for easily constructing ruled tables. TeXsis was
+originally developed for physicists, but others may also find it useful. It is
+completely compatible with Plain TeX.")
+ (depend . ("cm" "hyphen-base" "knuth-lib" "plain" "tex"))
+ (docfiles
+ . ("texmf-dist/doc/man/man1/texsis.1"
+ "texmf-dist/doc/man/man1/texsis.man1.pdf"
+ "texmf-dist/doc/otherformats/texsis/base/COPYING"
+ "texmf-dist/doc/otherformats/texsis/base/Example.tex"
+ "texmf-dist/doc/otherformats/texsis/base/Fonts.tex"
+ "texmf-dist/doc/otherformats/texsis/base/INSTALL"
+ "texmf-dist/doc/otherformats/texsis/base/Install.tex"
+ "texmf-dist/doc/otherformats/texsis/base/MANIFEST"
+ "texmf-dist/doc/otherformats/texsis/base/Manual.fgl"
+ "texmf-dist/doc/otherformats/texsis/base/Manual.ref"
+ "texmf-dist/doc/otherformats/texsis/base/Manual.tbl"
+ "texmf-dist/doc/otherformats/texsis/base/Manual.tex"
+ "texmf-dist/doc/otherformats/texsis/base/NEWS"
+ "texmf-dist/doc/otherformats/texsis/base/README"
+ "texmf-dist/doc/otherformats/texsis/base/TXSapxF.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXScover.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSdcol.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSdoc.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSdoc0.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSdocM.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSend.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSenvmt.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSeqns.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSfigs.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSfmts.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSfonts.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSinstl.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSintro.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSletr.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSmisc.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSprns.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSrefs.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSrevs.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSruled.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSsects.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXSsite.000"
+ "texmf-dist/doc/otherformats/texsis/base/TXSsymb.doc"
+ "texmf-dist/doc/otherformats/texsis/base/TXStags.doc"
+ "texmf-dist/doc/otherformats/texsis/base/index.tex"
+ "texmf-dist/doc/otherformats/texsis/base/letr"
+ "texmf-dist/doc/otherformats/texsis/base/penguin.eps"
+ "texmf-dist/doc/otherformats/texsis/base/penguin2.eps"
+ "texmf-dist/doc/otherformats/texsis/base/texsis.el"
+ "texmf-dist/doc/otherformats/texsis/base/texsis.lsm"))
+ (runfiles
+ . ("texmf-dist/bibtex/bst/texsis/texsis.bst"
+ "texmf-dist/tex/texsis/base/AIP.txs"
+ "texmf-dist/tex/texsis/base/CVformat.txs"
+ "texmf-dist/tex/texsis/base/Elsevier.txs"
+ "texmf-dist/tex/texsis/base/Exam.txs"
+ "texmf-dist/tex/texsis/base/Formletr.txs"
+ "texmf-dist/tex/texsis/base/IEEE.txs"
+ "texmf-dist/tex/texsis/base/PhysRev.txs"
+ "texmf-dist/tex/texsis/base/Spanish.txs"
+ "texmf-dist/tex/texsis/base/Swedish.txs"
+ "texmf-dist/tex/texsis/base/TXSconts.tex"
+ "texmf-dist/tex/texsis/base/TXSdcol.tex"
+ "texmf-dist/tex/texsis/base/TXSenvmt.tex"
+ "texmf-dist/tex/texsis/base/TXSeqns.tex"
+ "texmf-dist/tex/texsis/base/TXSfigs.tex"
+ "texmf-dist/tex/texsis/base/TXSfmts.tex"
+ "texmf-dist/tex/texsis/base/TXSfonts.tex"
+ "texmf-dist/tex/texsis/base/TXShead.tex"
+ "texmf-dist/tex/texsis/base/TXSinit.tex"
+ "texmf-dist/tex/texsis/base/TXSletr.tex"
+ "texmf-dist/tex/texsis/base/TXSmacs.tex"
+ "texmf-dist/tex/texsis/base/TXSmemo.tex"
+ "texmf-dist/tex/texsis/base/TXSprns.tex"
+ "texmf-dist/tex/texsis/base/TXSrefs.tex"
+ "texmf-dist/tex/texsis/base/TXSruled.tex"
+ "texmf-dist/tex/texsis/base/TXSsects.tex"
+ "texmf-dist/tex/texsis/base/TXSsite.tex"
+ "texmf-dist/tex/texsis/base/TXSsymb.tex"
+ "texmf-dist/tex/texsis/base/TXStags.tex"
+ "texmf-dist/tex/texsis/base/TXStitle.tex"
+ "texmf-dist/tex/texsis/base/Tablebod.txs"
+ "texmf-dist/tex/texsis/base/WorldSci.txs"
+ "texmf-dist/tex/texsis/base/color.txs"
+ "texmf-dist/tex/texsis/base/nuclproc.txs"
+ "texmf-dist/tex/texsis/base/printfont.txs"
+ "texmf-dist/tex/texsis/base/spine.txs"
+ "texmf-dist/tex/texsis/base/texsis.tex"
+ "texmf-dist/tex/texsis/base/thesis.txs"
+ "texmf-dist/tex/texsis/base/twin.txs"
+ "texmf-dist/tex/texsis/config/texsis.ini"))
+ (catalogue-license . "lppl")))))
-(define sxml
- '(*TOP* (entry (@ (id "foo"))
- (name "foo")
- (caption "Foomatic frobnication in LuaLaTeX")
- (authorref (@ (id "rekado")))
- (license (@ (type "lppl1.3")))
- (version (@ (number "2.6a")))
- (description
- (p "\n Foo is a package for LuaLaTeX. It provides an interface to frobnicate gimbals\n in a foomatic way with the LuaTeX engine.\n ")
- (p "\n The package requires the bar and golly\n bundles for extremely special specialties.\n "))
- (ctan (@ (path "/macros/latex/contrib/foo") (file "true")))
- (texlive (@ (location "foo")))
- (keyval (@ (value "tests") (key "topic")))
- "\n null\n")))
-
-(test-equal "fetch-sxml: returns SXML for valid XML"
- sxml
- (with-http-server `((200 ,xml))
- (parameterize ((current-http-proxy (%local-url)))
- (fetch-sxml "foo"))))
-
-;; TODO:
-(test-assert "sxml->package"
+(test-assert "texlive->guix-package"
;; Replace network resources with sample data.
(mock ((guix build svn) svn-fetch
(lambda* (url revision directory
#:key (svn-command "svn")
(user-name #f)
- (password #f))
+ (password #f)
+ (recursive? #t))
(mkdir-p directory)
(with-output-to-file (string-append directory "/foo")
(lambda ()
(display "source")))))
- (let ((result (sxml->package sxml)))
+ (let ((result (texlive->guix-package "texsis"
+ #:package-database
+ (lambda _ %fake-tlpdb))))
(match result
(('package
- ('name "texlive-latex-foo")
- ('version "2.6a")
- ('source ('origin
- ('method 'svn-fetch)
- ('uri ('texlive-ref "latex" "foo"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'texlive-build-system)
- ('arguments ('quote (#:tex-directory "latex/foo")))
- ('home-page "http://www.ctan.org/pkg/foo")
- ('synopsis "Foomatic frobnication in LuaLaTeX")
- ('description
- "Foo is a package for LuaLaTeX. It provides an interface to \
-frobnicate gimbals in a foomatic way with the LuaTeX engine. The package \
-requires the bar and golly bundles for extremely special specialties.")
- ('license 'lppl1.3+))
- #t)
+ ('inherit ('simple-texlive-package
+ "texlive-texsis"
+ ('list "doc/man/man1/"
+ "doc/otherformats/texsis/base/"
+ "bibtex/bst/texsis/"
+ "tex/texsis/base/"
+ "tex/texsis/config/")
+ ('base32 (? string? hash))
+ #:trivial? #t))
+ ('propagated-inputs
+ (("texlive-cm" ',texlive-cm)
+ ("texlive-hyphen-base" ',texlive-hyphen-base)
+ ("texlive-knuth-lib" ',texlive-knuth-lib)
+ ("texlive-plain" ',texlive-plain)
+ ("texlive-tex" ',texlive-tex)))
+ ('home-page "https://www.tug.org/texlive/")
+ ('synopsis "Plain TeX macros for Physicists")
+ ('description (? string? description))
+ ('license 'lppl))
+ #true)
(_
(begin
- (format #t "~s\n" result)
+ (format #t "~s~%" result)
(pk 'fail result #f)))))))
(test-end "texlive")
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-05 09:03:02 +0000