summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm49
-rw-r--r--tests/builders.scm132
-rw-r--r--tests/cran.scm10
-rw-r--r--tests/egg.scm27
-rw-r--r--tests/gem.scm15
-rw-r--r--tests/gexp.scm54
-rw-r--r--tests/gremlin.scm88
-rw-r--r--tests/guix-build.sh2
-rw-r--r--tests/guix-environment.sh8
-rw-r--r--tests/guix-shell.sh6
-rw-r--r--tests/hackage.scm22
-rw-r--r--tests/lint.scm16
-rw-r--r--tests/opam.scm9
-rw-r--r--tests/pack.scm4
-rw-r--r--tests/packages.scm292
-rw-r--r--tests/print.scm4
-rw-r--r--tests/pypi.scm27
-rw-r--r--tests/store.scm3
-rw-r--r--tests/style.scm366
-rw-r--r--tests/utils.scm17
20 files changed, 980 insertions, 171 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 654b480ed9..6b131c0af8 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -1,6 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,7 +20,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (test-build-utils)
+(define-module (test build-utils)
#:use-module (guix tests)
#:use-module (guix build utils)
#:use-module ((guix utils)
@@ -241,4 +243,49 @@ print('hello world')"))
"/some/other/path")))
#f)))))
+(test-equal "substitute*, text contains a NUL byte, UTF-8"
+ "c\0d"
+ (with-fluids ((%default-port-encoding "UTF-8")
+ (%default-port-conversion-strategy 'error))
+ ;; The GNU libc is locale sensitive. Depending on the value of LANG, the
+ ;; test could fail with "string contains #\\nul character: ~S" or "cannot
+ ;; convert wide string to output locale".
+ (setlocale LC_ALL "en_US.UTF-8")
+ (call-with-temporary-output-file
+ (lambda (file port)
+ (format port "a\0b")
+ (flush-output-port port)
+
+ (substitute* file
+ (("a") "c")
+ (("b") "d"))
+
+ (with-input-from-file file
+ (lambda _
+ (get-string-all (current-input-port))))))))
+
+(test-equal "search-input-file: exception if not found"
+ `((path)
+ (file . "does-not-exist"))
+ (guard (e ((search-error? e)
+ `((path . ,(search-error-path e))
+ (file . ,(search-error-file e)))))
+ (search-input-file '() "does-not-exist")))
+
+(test-equal "search-input-file: can find if existent"
+ (which "guile")
+ (search-input-file
+ `(("guile/bin" . ,(dirname (which "guile"))))
+ "guile"))
+
+(test-equal "search-input-file: can search in multiple directories"
+ (which "guile")
+ (call-with-temporary-directory
+ (lambda (directory)
+ (search-input-file
+ `(("irrelevant" . ,directory)
+ ("guile/bin" . ,(dirname (which "guile"))))
+ "guile"))))
+
+
(test-end)
diff --git a/tests/builders.scm b/tests/builders.scm
index fdcf38ded3..2853227465 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,22 +18,28 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (test-builders)
+(define-module (tests builders)
#:use-module (guix download)
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
+ #:use-module (guix build gnu-build-system)
+ #:use-module (guix build utils)
+ #:use-module (guix build-system python)
+ #:use-module (guix grafts)
#:use-module (guix store)
+ #:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix base32)
#:use-module (guix derivations)
#:use-module (gcrypt hash)
#:use-module (guix tests)
- #:use-module ((guix packages)
- #:select (package?
- package-derivation package-native-search-paths))
+ #:use-module (guix packages)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
+ #:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64))
;; Test the higher-level builders.
@@ -43,6 +50,9 @@
(define url-fetch*
(store-lower url-fetch))
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
+
(test-begin "builders")
@@ -78,4 +88,116 @@
(test-assert "gnu-build-system"
(build-system? gnu-build-system))
+(define unpack (assoc-ref %standard-phases 'unpack))
+
+(define compressors '(("gzip" . "gz")
+ ("xz" . "xz")
+ ("bzip2" . "bz2")
+ (#f . #f)))
+
+(for-each
+ (match-lambda
+ ((comp . ext)
+
+ (unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries
+ (test-equal (string-append "gnu-build-system unpack phase, "
+ "single file (compression: "
+ (if comp comp "None") ")")
+ "expected text"
+ (let*-values
+ (((name) "test")
+ ((compressed-name) (if ext
+ (string-append name "." ext)
+ name))
+ ((file hash) (test-file %store compressed-name "expected text")))
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-directory-excursion dir
+ (unpack #:source file)
+ (call-with-input-file name get-string-all))))))))
+ compressors)
+
+
+;;;
+;;; Test the sanity-check phase of the Python build system.
+;;;
+
+(define* (make-python-dummy name #:key (setup-py-extra "")
+ (init-py "") (use-setuptools? #t))
+ (dummy-package (string-append "python-dummy-" name)
+ (version "0.1")
+ (build-system python-build-system)
+ (arguments
+ `(#:tests? #f
+ #:use-setuptools? ,use-setuptools?
+ #:phases
+ (modify-phases %standard-phases
+ (replace 'unpack
+ (lambda _
+ (mkdir-p "dummy")
+ (with-output-to-file "dummy/__init__.py"
+ (lambda _
+ (display ,init-py)))
+ (with-output-to-file "setup.py"
+ (lambda _
+ (format #t "\
+~a
+setup(
+ name='dummy-~a',
+ version='0.1',
+ packages=['dummy'],
+ ~a
+ )"
+ (if ,use-setuptools?
+ "from setuptools import setup"
+ "from distutils.core import setup")
+ ,name ,setup-py-extra))))))))))
+
+(define python-dummy-ok
+ (make-python-dummy "ok"))
+
+;; distutil won't install any metadata, so make sure our script does not fail
+;; on a otherwise fine package.
+(define python-dummy-no-setuptools
+ (make-python-dummy
+ "no-setuptools" #:use-setuptools? #f))
+
+(define python-dummy-fail-requirements
+ (make-python-dummy "fail-requirements"
+ #:setup-py-extra "install_requires=['nonexistent'],"))
+
+(define python-dummy-fail-import
+ (make-python-dummy "fail-import" #:init-py "import nonexistent"))
+
+(define python-dummy-fail-console-script
+ (make-python-dummy "fail-console-script"
+ #:setup-py-extra (string-append "entry_points={'console_scripts': "
+ "['broken = dummy:nonexistent']},")))
+
+(define (check-build-success store p)
+ (unless store (test-skip 1))
+ (test-assert (string-append "python-build-system: " (package-name p))
+ (let* ((drv (package-derivation store p)))
+ (build-derivations store (list drv)))))
+
+(define (check-build-failure store p)
+ (unless store (test-skip 1))
+ (test-assert (string-append "python-build-system: " (package-name p))
+ (let ((drv (package-derivation store p)))
+ (guard (c ((store-protocol-error? c)
+ (pk 'failure c #t))) ;good!
+ (build-derivations store (list drv))
+ #f)))) ;bad: it should have failed
+
+(with-external-store store
+ (for-each (lambda (p) (check-build-success store p))
+ (list
+ python-dummy-ok
+ python-dummy-no-setuptools))
+ (for-each (lambda (p) (check-build-failure store p))
+ (list
+ python-dummy-fail-requirements
+ python-dummy-fail-import
+ python-dummy-fail-console-script)))
+
(test-end "builders")
diff --git a/tests/cran.scm b/tests/cran.scm
index 70d2277198..e59b7daef7 100644
--- a/tests/cran.scm
+++ b/tests/cran.scm
@@ -117,15 +117,9 @@ Date/Publication: 2015-07-14 14:15:16
(? string? hash)))))
('properties ('quasiquote (('upstream-name . "My-Example"))))
('build-system 'r-build-system)
- ('inputs
- ('quasiquote
- (("cairo" ('unquote 'cairo)))))
+ ('inputs ('list 'cairo))
('propagated-inputs
- ('quasiquote
- (("r-bh" ('unquote 'r-bh))
- ("r-proto" ('unquote 'r-proto))
- ("r-rcpp" ('unquote 'r-rcpp))
- ("r-scales" ('unquote 'r-scales)))))
+ ('list 'r-bh 'r-proto 'r-rcpp 'r-scales))
('home-page "http://gnu.org/s/my-example")
('synopsis "Example package")
('description
diff --git a/tests/egg.scm b/tests/egg.scm
index 99dd0a3fc7..a7d3378dd7 100644
--- a/tests/egg.scm
+++ b/tests/egg.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -86,16 +87,9 @@
('build-system 'chicken-build-system)
('arguments ('quasiquote ('#:egg-name "foo")))
('native-inputs
- ('quasiquote
- (("chicken-test" ('unquote chicken-test))
- ("chicken-srfi-1" ('unquote chicken-srfi-1))
- ("chicken-begin-syntax" ('unquote chicken-begin-syntax)))))
- ('inputs
- ('quasiquote
- (("libgit2" ('unquote libgit2)))))
- ('propagated-inputs
- ('quasiquote
- (("chicken-datatype" ('unquote chicken-datatype)))))
+ ('list 'chicken-test 'chicken-srfi-1 'chicken-begin-syntax))
+ ('inputs ('list 'libgit2))
+ ('propagated-inputs ('list 'chicken-datatype))
('home-page "https://wiki.call-cc.org/egg/foo")
('synopsis "Example egg")
('description #f)
@@ -108,16 +102,9 @@
('source (? file-like? source))
('build-system 'chicken-build-system)
('arguments ('quasiquote ('#:egg-name "bar")))
- ('native-inputs
- ('quasiquote
- (("chicken-test" ('unquote chicken-test))
- ("chicken-begin-syntax" ('unquote chicken-begin-syntax)))))
- ('inputs
- ('quasiquote
- (("libgit2" ('unquote libgit2)))))
- ('propagated-inputs
- ('quasiquote
- (("chicken-datatype" ('unquote chicken-datatype)))))
+ ('native-inputs ('list 'chicken-test 'chicken-begin-syntax))
+ ('inputs ('list 'libgit2))
+ ('propagated-inputs ('list 'chicken-datatype))
('home-page "https://wiki.call-cc.org/egg/bar")
('synopsis "Example egg")
('description #f)
diff --git a/tests/gem.scm b/tests/gem.scm
index 751bba656f..c8fe15398e 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -93,10 +94,7 @@
('base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system)
- ('propagated-inputs
- ('quasiquote
- (("bundler" ('unquote 'bundler))
- ("ruby-bar" ('unquote 'ruby-bar)))))
+ ('propagated-inputs ('list 'bundler 'ruby-bar))
('synopsis "A cool gem")
('description "This package provides a cool gem")
('home-page "https://example.com")
@@ -132,9 +130,7 @@
('base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system)
- ('propagated-inputs
- ('quasiquote
- (('"bundler" ('unquote 'bundler)))))
+ ('propagated-inputs ('list 'bundler))
('synopsis "Another cool gem")
('description "Another cool gem")
('home-page "https://example.com")
@@ -165,10 +161,7 @@
('base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system)
- ('propagated-inputs
- ('quasiquote
- (("bundler" ('unquote 'bundler))
- ("ruby-bar" ('unquote 'ruby-bar)))))
+ ('propagated-inputs ('list 'bundler 'ruby-bar))
('synopsis "A cool gem")
('description "This package provides a cool gem")
('home-page "https://example.com")
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 0758a49f5f..ad8e1d57b8 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -127,6 +127,13 @@
(null? (gexp-inputs exp))
(gexp->sexp* exp))))
+(test-equal "sexp->gexp"
+ '(a b (c d) e)
+ (let ((exp (sexp->gexp '(a b (c d) e))))
+ (and (gexp? exp)
+ (null? (gexp-inputs exp))
+ (gexp->sexp* exp))))
+
(test-equal "unquote"
'(display `(foo ,(+ 2 3)))
(let ((exp (gexp (display `(foo ,(+ 2 3))))))
@@ -434,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)
@@ -1463,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/gremlin.scm b/tests/gremlin.scm
index b0bb7a8e49..9af899c89a 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,9 +23,12 @@
#:use-module (guix build gremlin)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
#:use-module (rnrs io ports)
#:use-module (ice-9 popen)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
#:use-module (ice-9 match))
(define %guile-executable
@@ -57,6 +60,44 @@
(string-take lib (string-contains lib ".so")))
(elf-dynamic-info-needed dyninfo))))))
+(unless (and %guile-executable (not (getenv "LD_LIBRARY_PATH"))
+ (file-needed %guile-executable) ;statically linked?
+ ;; When Guix has been built on a foreign distro, using a
+ ;; toolchain and libraries from that foreign distro, it is not
+ ;; unusual for the runpath to be empty.
+ (pair? (file-runpath %guile-executable)))
+ (test-skip 1))
+(test-assert "file-needed/recursive"
+ (let* ((needed (file-needed/recursive %guile-executable))
+ (pipe (dynamic-wind
+ (lambda ()
+ ;; Tell ld.so to list loaded objects, like 'ldd' does.
+ (setenv "LD_TRACE_LOADED_OBJECTS" "yup"))
+ (lambda ()
+ (open-pipe* OPEN_READ %guile-executable))
+ (lambda ()
+ (unsetenv "LD_TRACE_LOADED_OBJECTS")))))
+ (define ldd-rx
+ (make-regexp "^[[:blank:]]+([[:graph:]]+ => )?([[:graph:]]+) .*$"))
+
+ (define (read-ldd-output port)
+ ;; Read from PORT output in GNU ldd format.
+ (let loop ((result '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (reverse result))
+ ((= (cut regexp-exec ldd-rx <>) m)
+ (if m
+ (loop (cons (match:substring m 2) result))
+ (loop result))))))
+
+ (define ground-truth
+ (remove (cut string-prefix? "linux-vdso.so" <>)
+ (read-ldd-output pipe)))
+
+ (and (zero? (close-pipe pipe))
+ (lset= string=? (pk 'truth ground-truth) (pk 'needed needed)))))
+
(test-equal "expand-origin"
'("OOO/../lib"
"OOO"
@@ -96,4 +137,49 @@
(close-pipe pipe)
str)))))))
+(unless c-compiler
+ (test-skip 1))
+(test-equal "set-file-runpath + file-runpath"
+ "hello\n"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (with-directory-excursion directory
+ (call-with-output-file "t.c"
+ (lambda (port)
+ (display "int main () { puts(\"hello\"); }" port)))
+
+ (invoke c-compiler "t.c"
+ "-Wl,--enable-new-dtags" "-Wl,-rpath=/xxxxxxxxx")
+
+ (let ((original-runpath (file-runpath "a.out")))
+ (and (member "/xxxxxxxxx" original-runpath)
+ (guard (c ((runpath-too-long-error? c)
+ (string=? "a.out" (runpath-too-long-error-file c))))
+ (set-file-runpath "a.out" (list (make-string 777 #\y))))
+ (let ((runpath (delete "/xxxxxxxxx" original-runpath)))
+ (set-file-runpath "a.out" runpath)
+ (equal? runpath (file-runpath "a.out")))
+ (let* ((pipe (open-input-pipe "./a.out"))
+ (str (get-string-all pipe)))
+ (close-pipe pipe)
+ str)))))))
+
+(unless c-compiler
+ (test-skip 1))
+(test-equal "elf-dynamic-info-soname"
+ "libfoo.so.2"
+ (call-with-temporary-directory
+ (lambda (directory)
+ (with-directory-excursion directory
+ (call-with-output-file "t.c"
+ (lambda (port)
+ (display "// empty file" port)))
+ (invoke c-compiler "t.c"
+ "-shared" "-Wl,-soname,libfoo.so.2")
+ (let* ((dyninfo (elf-dynamic-info
+ (parse-elf (call-with-input-file "a.out"
+ get-bytevector-all))))
+ (soname (elf-dynamic-info-soname dyninfo)))
+ soname)))))
+
(test-end "gremlin")
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 46c8afc901..86e41e2927 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -288,7 +288,7 @@ guix build --target=arm-linux-gnueabihf --dry-run \
-e '(@ (gnu packages base) coreutils)'
# Replacements.
-drv1=`guix build guix --with-input=guile@2.0=guile@2.2 -d`
+drv1=`guix build guix --with-input=guile-zstd=idutils -d`
drv2=`guix build guix -d`
test "$drv1" != "$drv2"
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index f4fc2e39ed..95fe95b437 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -199,7 +199,7 @@ then
# Make sure the bootstrap binaries are all listed where they belong.
grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a"
- grep -E "^export CPATH=\"$profile/include\"" "$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
@@ -213,8 +213,8 @@ then
# as returned by '--search-paths'.
guix environment --bootstrap --no-substitutes --pure \
-e '(@ (guix tests) gnu-make-for-tests)' \
- -- /bin/sh -c 'echo $PATH $CPATH $LIBRARY_PATH' > "$tmpdir/b"
- ( . "$tmpdir/a" ; echo $PATH $CPATH $LIBRARY_PATH ) > "$tmpdir/c"
+ -- /bin/sh -c 'echo $PATH $C_INCLUDE_PATH $LIBRARY_PATH' > "$tmpdir/b"
+ ( . "$tmpdir/a" ; echo $PATH $C_INCLUDE_PATH $LIBRARY_PATH ) > "$tmpdir/c"
cmp "$tmpdir/b" "$tmpdir/c"
rm "$tmpdir"/*
@@ -235,7 +235,7 @@ then
# Make sure the bootstrap binaries are all listed where they belong.
grep -E "^export PATH=\"$profile/bin\"" "$tmpdir/a"
- grep -E "^export CPATH=\"$profile/include\"" "$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 \
guile-bootstrap
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
index 3bdf625189..7c42fd67ed 100644
--- a/tests/guix-shell.sh
+++ b/tests/guix-shell.sh
@@ -83,9 +83,9 @@ then
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 CPATH=\"$profile/include\"" "$tmpdir/a"
- grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+ 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"
diff --git a/tests/hackage.scm b/tests/hackage.scm
index ba694661f3..189b9af173 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -175,9 +176,7 @@ library
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
- ('inputs
- ('quasiquote
- (("ghc-http" ('unquote 'ghc-http)))))
+ ('inputs ('list 'ghc-http))
('home-page "http://test.org")
('synopsis (? string?))
('description (? string?))
@@ -217,13 +216,8 @@ library
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
- ('inputs
- ('quasiquote
- (("ghc-b" ('unquote 'ghc-b))
- ("ghc-http" ('unquote 'ghc-http)))))
- ('native-inputs
- ('quasiquote
- (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi)))))
+ ('inputs ('list 'ghc-b 'ghc-http))
+ ('native-inputs ('list 'ghc-haskell-gi))
('home-page "http://test.org")
('synopsis (? string?))
('description (? string?))
@@ -342,9 +336,7 @@ executable cabal
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
- ('inputs
- ('quasiquote
- (("ghc-http" ('unquote 'ghc-http)))))
+ ('inputs ('list 'ghc-http))
('arguments
('quasiquote
('#:cabal-revision
@@ -405,9 +397,7 @@ executable cabal
('base32
(? string? hash)))))
('build-system 'haskell-build-system)
- ('inputs
- ('quasiquote
- (("ghc-http" ('unquote 'ghc-http)))))
+ ('inputs ('list 'ghc-http))
('home-page "http://test.org")
('synopsis (? string?))
('description (? string?))
diff --git a/tests/lint.scm b/tests/lint.scm
index 9a91dd5426..e9663e69f9 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -380,6 +380,20 @@
`(("python-setuptools" ,python-setuptools))))))
(check-inputs-should-not-be-an-input-at-all pkg))))
+(test-assert "input labels: no warnings"
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkg-config" ,pkg-config))))))
+ (null? (check-input-labels pkg))))
+
+(test-equal "input labels: one warning"
+ "label 'pkgkonfig' does not match package name 'pkg-config'"
+ (single-lint-warning-message
+ (let ((pkg (dummy-package "x"
+ (inputs `(("glib" ,glib)
+ ("pkgkonfig" ,pkg-config))))))
+ (check-input-labels pkg))))
+
(test-equal "explicit #:sh argument to 'wrap-program' is acceptable"
'()
(let* ((phases
@@ -586,7 +600,7 @@
(single-lint-warning-message (check-patch-headers pkg)))))
(test-equal "derivation: invalid arguments"
- "failed to create x86_64-linux derivation: (wrong-type-arg \"map\" \"Wrong type argument: ~S\" (invalid-module) ())"
+ "failed to create x86_64-linux derivation: (match-error \"match\" \"no matching pattern\" invalid-module)"
(match (let ((pkg (dummy-package "x"
(arguments
'(#:imported-modules (invalid-module))))))
diff --git a/tests/opam.scm b/tests/opam.scm
index 31b4ea41ff..b5f02f809b 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -101,13 +102,9 @@ url {
('base32
(? string? hash)))))
('build-system 'ocaml-build-system)
- ('propagated-inputs
- ('quasiquote
- (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('propagated-inputs ('list 'ocaml-zarith))
('native-inputs
- ('quasiquote
- (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
- ("ocamlbuild" ('unquote 'ocamlbuild)))))
+ ('list 'ocaml-alcotest 'ocamlbuild))
('home-page "https://example.org/")
('synopsis "Some example package")
('description "This package is just an example.")
diff --git a/tests/pack.scm b/tests/pack.scm
index e9b4c36e0e..98bfedf21c 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
@@ -54,7 +54,7 @@
;; Compressor that uses the bootstrap 'gzip'.
((@ (guix scripts pack) compressor) "gzip"
".gz"
- #~(#+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n")))
+ #~(list #+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n")))
(define %tar-bootstrap %bootstrap-coreutils&co)
diff --git a/tests/packages.scm b/tests/packages.scm
index 266b5aeb7a..3506f94f91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,6 +1,8 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,13 +19,14 @@
;;; 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-packages)
+(define-module (tests packages)
#:use-module (guix tests)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix grafts)
- #:use-module ((guix gexp) #:select (local-file local-file-file))
+ #:use-module (guix gexp)
#:use-module (guix utils)
+ #:use-module ((guix build utils) #:select (tarball?))
#:use-module ((guix diagnostics)
;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package.
@@ -32,6 +35,7 @@
(else name))))
#:use-module ((gcrypt hash) #:prefix gcrypt:)
#:use-module (guix derivations)
+ #:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix grafts)
#:use-module (guix search-paths)
@@ -51,6 +55,7 @@
#:use-module (gnu packages version-control)
#:use-module (gnu packages xml)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -133,7 +138,7 @@
;; inputs. See <https://bugs.gnu.org/35872>.
(let* ((dep (dummy-package "dep" (version "2")))
(old (dummy-package "foo" (version "1")
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(drv (package-derivation %store old))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list old)))
@@ -221,7 +226,7 @@
(bar (dummy-package "bar" (version "0")
(replacement old)))
(new (dummy-package "foo" (version "1")
- (inputs `(("bar" ,bar)))))
+ (inputs (list bar))))
(tx (mock ((gnu packages) find-best-packages-by-name
(const (list new)))
(transaction-upgrade-entry
@@ -282,13 +287,13 @@
(test-assert "package-transitive-inputs"
(let* ((a (dummy-package "a"))
(b (dummy-package "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package "d"
(propagated-inputs `(("x" "something.drv")))))
(e (dummy-package "e"
- (inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
+ (inputs (list b c d)))))
(and (null? (package-transitive-inputs a))
(equal? `(("a" ,a)) (package-transitive-inputs b))
(equal? `(("a" ,a)) (package-transitive-inputs c))
@@ -334,19 +339,19 @@
(b (dummy-package "b"
(build-system trivial-build-system)
(supported-systems '("x" "y"))
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(c (dummy-package "c"
(build-system trivial-build-system)
(supported-systems '("y" "z"))
- (inputs `(("b" ,b)))))
+ (inputs (list b))))
(d (dummy-package "d"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("b" ,b) ("c" ,c)))))
+ (inputs (list b c))))
(e (dummy-package "e"
(build-system trivial-build-system)
(supported-systems '("x" "y" "z"))
- (inputs `(("d" ,d))))))
+ (inputs (list d)))))
(list (package-transitive-supported-systems a)
(package-transitive-supported-systems b)
(package-transitive-supported-systems c)
@@ -376,13 +381,13 @@
(build-system trivial-build-system))))))
(let* ((a (dummy-package/no-implicit "a"))
(b (dummy-package/no-implicit "b"
- (propagated-inputs `(("a" ,a)))))
+ (propagated-inputs (list a))))
(c (dummy-package/no-implicit "c"
- (inputs `(("a" ,a)))))
+ (inputs (list a))))
(d (dummy-package/no-implicit "d"
- (native-inputs `(("b" ,b)))))
+ (native-inputs (list b))))
(e (dummy-package/no-implicit "e"
- (inputs `(("c" ,c) ("d" ,d))))))
+ (inputs (list c d)))))
(lset= eq?
(list a b c d e)
(package-closure (list e))
@@ -405,12 +410,11 @@
(u (dummy-origin))
(i (dummy-origin))
(a (dummy-package "a"))
- (b (dummy-package "b"
- (inputs `(("a" ,a) ("i" ,i)))))
+ (b (dummy-package "b" (inputs (list a i))))
(c (package (inherit b) (source o)))
(d (dummy-package "d"
(build-system trivial-build-system)
- (source u) (inputs `(("c" ,c))))))
+ (source u) (inputs (list c)))))
(test-assert "package-direct-sources, no source"
(null? (package-direct-sources a)))
(test-equal "package-direct-sources, #f source"
@@ -478,7 +482,7 @@
(supported-systems '("x86_64-linux"))))
(p (dummy-package "foo"
(build-system gnu-build-system)
- (inputs `(("d" ,d)))
+ (inputs (list d))
(supported-systems '("x86_64-linux" "armhf-linux")))))
(and (supported-package? p "x86_64-linux")
(not (supported-package? p "i686-linux"))
@@ -603,6 +607,11 @@
(build-derivations %store (list drv))
(call-with-input-file output get-string-all)))
+
+;;;
+;;; Source derivation with snippets.
+;;;
+
(unless (network-reachable?) (test-skip 1))
(test-equal "package-source-derivation, snippet"
"OK"
@@ -658,11 +667,96 @@
(and (build-derivations %store (list (pk 'snippet-drv drv)))
(call-with-input-file out get-string-all))))
+;; Note: lzip is not part of bootstrap-coreutils&co, so is not included to
+;; avoid having to rebuild the world.
+(define compressors '(("gzip" . "gz")
+ ("xz" . "xz")
+ ("bzip2" . "bz2")
+ (#f . #f)))
+
+(for-each
+ (match-lambda
+ ((comp . ext)
+ (unless (network-reachable?) (test-skip 1))
+ (test-equal (string-append "origin->derivation, single file with snippet "
+ "(compression: " (if comp comp "None") ")")
+ "2 + 2 = 4"
+ (let*-values
+ (((name) "maths")
+ ((compressed-name) (if comp
+ (string-append name "." ext)
+ name))
+ ((file hash) (test-file %store compressed-name "2 + 2 = 5"))
+ ;; Create an origin using the above computed file and its hash.
+ ((source) (origin
+ (method url-fetch)
+ (uri (string-append "file://" file))
+ (file-name compressed-name)
+ (patch-inputs `(("tar" ,%bootstrap-coreutils&co)
+ ("xz" ,%bootstrap-coreutils&co)
+ ("bzip2" ,%bootstrap-coreutils&co)
+ ("gzip" ,%bootstrap-coreutils&co)))
+ (patch-guile %bootstrap-guile)
+ (modules '((guix build utils)))
+ (snippet `(substitute* ,name
+ (("5") "4")))
+ (hash (content-hash hash))))
+ ;; Build origin.
+ ((drv) (run-with-store %store (origin->derivation source)))
+ ((out) (derivation->output-path drv)))
+ ;; Decompress the resulting tar.xz and return its content.
+ (and (build-derivations %store (list drv))
+ (if (tarball? out)
+ (let* ((bin #~(string-append #+%bootstrap-coreutils&co
+ "/bin"))
+ (f (computed-file
+ name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (setenv "PATH" #+bin)
+ (invoke "tar" "xvf" #+out)
+ (copy-file #+name #$output)))))
+ (drv (run-with-store %store (lower-object f)))
+ (_ (build-derivations %store (list drv))))
+ (call-with-input-file (derivation->output-path drv)
+ get-string-all))
+ (call-with-input-file out get-string-all)))))))
+ compressors)
+
(test-assert "return value"
(let ((drv (package-derivation %store (dummy-package "p"))))
(and (derivation? drv)
(file-exists? (derivation-file-name drv)))))
+(test-assert "package-derivation, inputs deduplicated"
+ (let* ((dep (dummy-package "dep"))
+ (p0 (dummy-package "p" (inputs (list dep))))
+ (p1 (package (inherit p0)
+ (inputs `(("dep" ,(package (inherit dep)))
+ ,@(package-inputs p0))))))
+ ;; Here P1 ends up with two non-eq? copies of DEP, under the same label.
+ ;; They should be deduplicated so that P0 and P1 lead to the same
+ ;; derivation rather than P1 ending up with duplicate entries in its
+ ;; '%build-inputs' variable.
+ (string=? (derivation-file-name (package-derivation %store p0))
+ (derivation-file-name (package-derivation %store p1)))))
+
+(test-assert "package-derivation, different system"
+ ;; Make sure the 'system' argument of 'package-derivation' is respected.
+ (let* ((system (if (string=? (%current-system) "x86_64-linux")
+ "aarch64-linux"
+ "x86_64-linux"))
+ (drv (package-derivation %store (dummy-package "p")
+ system #:graft? #f)))
+ (define right-system?
+ (mlambdaq (drv)
+ (and (string=? (derivation-system drv) system)
+ (every (compose right-system? derivation-input-derivation)
+ (derivation-inputs drv)))))
+
+ (right-system? drv)))
+
(test-assert "package-output"
(let* ((package (dummy-package "p"))
(drv (package-derivation %store package)))
@@ -690,7 +784,7 @@
(let ((dummy (dummy-package "foo" (inputs `(("x" ,(current-module)))))))
(test-equal "&package-input-error"
- (list dummy (current-module))
+ (list dummy `("x" ,(current-module)))
(guard (c ((package-input-error? c)
(list (package-error-package c)
(package-error-invalid-input c))))
@@ -701,7 +795,7 @@
(parameterize ((%graft? #f))
(let* ((dep (dummy-package "dep"))
(p (dummy-package "p"
- (inputs `(("dep" ,dep "non-existent"))))))
+ (inputs (list `(,dep "non-existent"))))))
(guard (c ((derivation-missing-output-error? c)
(and (string=? (derivation-missing-output c) "non-existent")
(equal? (package-derivation %store dep)
@@ -802,21 +896,47 @@
(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"))
(s (build-system
- (name '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
- (lambda* (store name inputs
+ (name '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
+ (lambda* (name inputs
#:key outputs system search-paths)
- search-paths)))))))
+ (if (string=? name (t))
+ (abort-to-prompt p search-paths)
+ (gexp->derivation name
+ #~(mkdir #$output))))))))))
(x (list (search-path-specification
(variable "GUILE_LOAD_PATH")
(files '("share/guile/site/2.0")))
@@ -841,8 +961,10 @@
(lambda (k search-paths)
search-paths))))))
(and (null? (collect (package-derivation %store a)))
- (equal? x (collect (package-derivation %store b)))
- (equal? x (collect (package-derivation %store c)))))))
+ (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-assert "package-transitive-native-search-paths"
(let* ((sp (lambda (name)
@@ -853,12 +975,12 @@
(p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
(p2 (dummy-package "p2"
(native-search-paths (sp "PATH2"))
- (inputs `(("p0" ,p0)))
- (propagated-inputs `(("p1" ,p1)))))
+ (inputs (list p0))
+ (propagated-inputs (list p1))))
(p3 (dummy-package "p3"
(native-search-paths (sp "PATH3"))
- (native-inputs `(("p0" ,p0)))
- (propagated-inputs `(("p2" ,p2))))))
+ (native-inputs (list p0))
+ (propagated-inputs (list p2)))))
(lset= string=?
'("PATH1" "PATH2" "PATH3")
(map search-path-specification-variable
@@ -912,7 +1034,7 @@
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep*))))))
+ (inputs (list dep*)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -944,11 +1066,11 @@
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(prop (dummy-package "propagated"
- (propagated-inputs `(("dep" ,dep*)))
+ (propagated-inputs (list dep*))
(arguments '(#:implicit-inputs? #f))))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("prop" ,prop))))))
+ (inputs (list prop)))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
@@ -961,16 +1083,16 @@
(dep (package (inherit new) (version "0") (replacement new)))
(p1 (dummy-package "intermediate1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("dep" ,dep)))))
+ (inputs (list dep))))
(p2 (dummy-package "intermediate2"
(arguments '(#:implicit-inputs? #f))
;; Here we copy DEP to have an equivalent package that is not
;; 'eq?' to DEP. This is similar to what happens with
;; 'package-with-explicit-inputs' & co.
- (inputs `(("dep" ,(package (inherit dep)))))))
+ (inputs (list (package (inherit dep))))))
(p3 (dummy-package "final"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p1" ,p1) ("p2" ,p2))))))
+ (inputs (list p1 p2)))))
(equal? (package-grafts %store p3)
(list (graft
(origin (package-derivation %store
@@ -988,8 +1110,7 @@
(p0* (package (inherit p0) (version "1.1")))
(p1 (dummy-package "p1"
(arguments '(#:implicit-inputs? #f))
- (inputs `(("p0" ,p0)
- ("p0:lib" ,p0 "lib"))))))
+ (inputs (list p0 `(,p0 "lib"))))))
(lset= equal? (pk (package-grafts %store p1))
(list (graft
(origin (package-derivation %store p0))
@@ -1037,7 +1158,7 @@
#t)))))
(p2r (dummy-package "P2"
(build-system trivial-build-system)
- (inputs `(("p1" ,p1)))
+ (inputs (list p1))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1058,7 +1179,7 @@
#t)))))
(p3 (dummy-package "p3"
(build-system trivial-build-system)
- (inputs `(("p2" ,p2)))
+ (inputs (list p2))
(arguments
`(#:guile ,%bootstrap-guile
#:builder (let ((out (assoc-ref %outputs "out")))
@@ -1116,18 +1237,18 @@
(bag (name name) (system system) (target target)
(build-inputs native-inputs)
(host-inputs inputs)
- (build (lambda* (store name inputs
- #:key system target
- #:allow-other-keys)
- (build-expression->derivation
- store "foo" '(mkdir %output))))))))
+ (build (lambda* (name inputs
+ #:key system target
+ #:allow-other-keys)
+ (gexp->derivation "foo"
+ #~(mkdir #$output))))))))
(bs (build-system
(name 'build-system-without-cross-compilation)
(description "Does not support cross compilation.")
(lower lower)))
(dep (dummy-package "dep" (build-system bs)))
(pkg (dummy-package "example"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(do-not-build (lambda (continue store lst . _) lst)))
(equal? (with-build-handler do-not-build
(parameterize ((%current-target-system "powerpc64le-linux-gnu")
@@ -1154,9 +1275,9 @@
(test-assert "package->bag, propagated inputs"
(let* ((dep (dummy-package "dep"))
(prop (dummy-package "prop"
- (propagated-inputs `(("dep" ,dep)))))
+ (propagated-inputs (list dep))))
(dummy (dummy-package "dummy"
- (inputs `(("prop" ,prop)))))
+ (inputs (list prop))))
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
(match (assoc "dep" inputs)
(("dep" package)
@@ -1169,7 +1290,7 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (native-inputs (list dep))))
(bag (package->bag pkg (%current-system) "i586-gnu")))
(equal? (parameterize ((%current-system "x86_64-linux"))
(bag-transitive-inputs bag))
@@ -1182,19 +1303,20 @@
`(("libxml2" ,libxml2))
'()))))
(pkg (dummy-package "foo"
- (native-inputs `(("dep" ,dep)))))
+ (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-assert "bag->derivation"
+(test-assertm "bag->derivation"
(parameterize ((%graft? #f))
(let ((bag (package->bag gnu-make))
(drv (package-derivation %store gnu-make)))
(parameterize ((%current-system "foox86-hurd")) ;should have no effect
- (equal? drv (bag->derivation %store bag))))))
+ (mlet %store-monad ((bag-drv (bag->derivation bag)))
+ (return (equal? drv bag-drv)))))))
(test-assert "bag->derivation, cross-compilation"
(parameterize ((%graft? #f))
@@ -1203,7 +1325,8 @@
(drv (package-cross-derivation %store gnu-make target)))
(parameterize ((%current-system "foox86-hurd") ;should have no effect
(%current-target-system "foo64-linux-gnu"))
- (equal? drv (bag->derivation %store bag))))))
+ (mlet %store-monad ((bag-drv (bag->derivation bag)))
+ (return (equal? drv bag-drv)))))))
(when (or (not (network-reachable?)) (shebang-too-long?))
(test-skip 1))
@@ -1486,11 +1609,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting/spec
`(("glib" . ,identity)))))
(and (= (length (package-transitive-inputs gobject))
@@ -1507,11 +1630,11 @@
(build-system trivial-build-system)))
(glib (dummy-package "glib"
(build-system trivial-build-system)
- (propagated-inputs `(("libffi" ,libffi)))))
+ (propagated-inputs (list libffi))))
(gobject (dummy-package "gobject-introspection"
(build-system trivial-build-system)
- (inputs `(("glib" ,glib)))
- (propagated-inputs `(("libffi" ,libffi)))))
+ (inputs (list glib))
+ (propagated-inputs (list libffi))))
(rewrite (package-input-rewriting `((,glib . ,glib)))))
(and (= (length (package-transitive-inputs gobject))
(length (package-transitive-inputs (rewrite gobject))))
@@ -1789,6 +1912,39 @@
(package-location (specification->package "guile@2"))
(specification->location "guile@2"))
+(test-eq "this-package-input, exists"
+ hello
+ (package-arguments
+ (dummy-package "a"
+ (inputs `(("hello" ,hello)))
+ (arguments (this-package-input "hello")))))
+
+(test-eq "this-package-input, exists in propagated-inputs"
+ hello
+ (package-arguments
+ (dummy-package "a"
+ (propagated-inputs `(("hello" ,hello)))
+ (arguments (this-package-input "hello")))))
+
+(test-eq "this-package-input, does not exist"
+ #f
+ (package-arguments
+ (dummy-package "a"
+ (arguments (this-package-input "hello")))))
+
+(test-eq "this-package-native-input, exists"
+ hello
+ (package-arguments
+ (dummy-package "a"
+ (native-inputs `(("hello" ,hello)))
+ (arguments (this-package-native-input "hello")))))
+
+(test-eq "this-package-native-input, does not exists"
+ #f
+ (package-arguments
+ (dummy-package "a"
+ (arguments (this-package-native-input "hello")))))
+
(test-end "packages")
;;; Local Variables:
diff --git a/tests/print.scm b/tests/print.scm
index 1527251b01..d9710d1ed3 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -61,8 +61,8 @@
(base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
- (inputs `(("coreutils" ,(@ (gnu packages base) coreutils))
- ("glibc" ,(@ (gnu packages base) glibc) "debug")))
+ (inputs (list (@ (gnu packages base) coreutils)
+ `(,(@ (gnu packages base) glibc) "debug")))
(home-page "http://gnu.org")
(synopsis "Dummy")
(description "This is a dummy package.")
diff --git a/tests/pypi.scm b/tests/pypi.scm
index ad869ac31f..1ea5f02643 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -249,13 +249,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('base32
(? string? hash)))))
('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-foo" ('unquote 'python-foo)))))
- ('native-inputs
- ('quasiquote
- (("python-pytest" ('unquote 'python-pytest)))))
+ ('propagated-inputs ('list 'python-bar 'python-foo))
+ ('native-inputs ('list 'python-pytest))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
@@ -324,13 +319,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
('base32
(? string? hash)))))
('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-baz" ('unquote 'python-baz)))))
- ('native-inputs
- ('quasiquote
- (("python-pytest" ('unquote 'python-pytest)))))
+ ('propagated-inputs ('list 'python-bar 'python-baz))
+ ('native-inputs ('list 'python-pytest))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
@@ -426,13 +416,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(? string? hash)))))
('properties ('quote (("upstream-name" . "foo-99"))))
('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-foo" ('unquote 'python-foo)))))
- ('native-inputs
- ('quasiquote
- (("python-pytest" ('unquote 'python-pytest)))))
+ ('propagated-inputs ('list 'python-bar 'python-foo))
+ ('native-inputs ('list 'python-pytest))
('home-page "http://example.com")
('synopsis "summary")
('description "summary")
diff --git a/tests/store.scm b/tests/store.scm
index de12f6831e..5df28adf0d 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -598,7 +598,8 @@
(d (build-expression->derivation
%store "foo" `(display ,s)
#:guile-for-build
- (package-derivation s %bootstrap-guile (%current-system)))))
+ (package-derivation %store %bootstrap-guile
+ (%current-system)))))
(guard (c ((store-protocol-error? c) #t))
(build-derivations %store (list d))))))))
"Here’s a Greek letter: λ."))
diff --git a/tests/style.scm b/tests/style.scm
new file mode 100644
index 0000000000..ada9197fc1
--- /dev/null
+++ b/tests/style.scm
@@ -0,0 +1,366 @@
+;;; 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/>.
+
+(define-module (tests-style)
+ #:use-module (guix packages)
+ #:use-module (guix scripts style)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((guix build utils) #:select (substitute*))
+ #:use-module (guix diagnostics)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 pretty-print))
+
+(define (call-with-test-package inputs proc)
+ (call-with-temporary-directory
+ (lambda (directory)
+ (call-with-output-file (string-append directory "/my-packages.scm")
+ (lambda (port)
+ (pretty-print
+ `(begin
+ (define-module (my-packages)
+ #:use-module (guix)
+ #:use-module (guix licenses)
+ #:use-module (gnu packages acl)
+ #:use-module (gnu packages base)
+ #:use-module (gnu packages multiprecision)
+ #:use-module (srfi srfi-1))
+
+ (define base
+ (package
+ (inherit coreutils)
+ (inputs '())
+ (native-inputs '())
+ (propagated-inputs '())))
+
+ (define (sdl-union . lst)
+ (package
+ (inherit base)
+ (name "sdl-union")))
+
+ (define-public my-coreutils
+ (package
+ (inherit base)
+ ,@inputs
+ (name "my-coreutils"))))
+ port)))
+
+ (proc directory))))
+
+(define test-directory
+ ;; Directory where the package definition lives.
+ (make-parameter #f))
+
+(define-syntax-rule (with-test-package fields exp ...)
+ (call-with-test-package fields
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ ;; Run as a separate process to make sure FILE is reloaded.
+ (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "cat" file)
+
+ (load file)
+ (parameterize ((test-directory directory))
+ exp ...))))
+
+(define* (read-lines port line #:optional (count 1))
+ "Read COUNT lines from PORT, starting from LINE."
+ (let loop ((lines '())
+ (count count))
+ (cond ((< (port-line port) (- line 1))
+ (read-char port)
+ (loop lines count))
+ ((zero? count)
+ (string-concatenate-reverse lines))
+ (else
+ (match (read-line port 'concat)
+ ((? eof-object?)
+ (loop lines 0))
+ (line
+ (loop (cons line lines) (- count 1))))))))
+
+(define* (read-package-field package field #:optional (count 1))
+ (let* ((location (package-field-location package field))
+ (file (location-file location))
+ (line (location-line location)))
+ (call-with-input-file (if (string-prefix? "/" file)
+ file
+ (string-append (test-directory) "/"
+ file))
+ (lambda (port)
+ (read-lines port line count)))))
+
+
+(test-begin "style")
+
+(test-equal "nothing to rewrite"
+ '()
+ (with-test-package '()
+ (package-direct-inputs (@ (my-packages) my-coreutils))))
+
+(test-equal "input labels, mismatch"
+ (list `(("foo" ,gmp) ("bar" ,acl))
+ " (inputs `((\"foo\" ,gmp) (\"bar\" ,acl)))\n")
+ (with-test-package '((inputs `(("foo" ,gmp) ("bar" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, simple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ " (inputs (list gmp acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, long list with one item per line"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl
+ gmp
+ acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8))))
+
+(test-equal "input labels, sdl-union"
+ "\
+ (list gmp acl
+ (sdl-union 1 2 3 4)))\n"
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("sdl-union" ,(sdl-union 1 2 3 4)))))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2)))
+
+(test-equal "input labels, output"
+ (list `(("gmp" ,gmp "debug") ("acl" ,acl))
+ " (inputs (list `(,gmp \"debug\") acl))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp "debug") ("acl" ,acl))))
+ (list (package-direct-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs))))
+
+(test-equal "input labels, prepend"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ,@(package-propagated-inputs coreutils))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+
+(test-equal "input labels, prepend + delete"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"gmp\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, prepend + delete multiple"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (delete \"foo\" \"bar\" \"baz\")
+ (prepend gmp acl)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ("acl" ,acl)
+ ,@(fold alist-delete
+ (package-propagated-inputs coreutils)
+ '("foo" "bar" "baz")))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3))))
+
+(test-equal "input labels, replace"
+ (list '() ;there's no "gmp" input to replace
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (replace \"gmp\" gmp)))\n")
+ (with-test-package '((inputs `(("gmp" ,gmp)
+ ,@(alist-delete "gmp"
+ (package-propagated-inputs coreutils)))))
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 2))))
+
+(test-equal "input labels, 'safe' policy"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (inputs (list gmp acl))\n")
+ (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
+ (arguments '())) ;no build system arguments
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (system* "guix" "style" "-L" directory "my-coreutils"
+ "--input-simplification=safe")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
+
+(test-equal "input labels, 'safe' policy, nothing changed"
+ (list `(("GMP" ,gmp) ("ACL" ,acl))
+ "\
+ (inputs `((\"GMP\" ,gmp) (\"ACL\" ,acl)))\n")
+ (call-with-test-package '((inputs `(("GMP" ,gmp) ("ACL" ,acl)))
+ ;; Non-empty argument list, so potentially unsafe
+ ;; input simplification.
+ (arguments
+ '(#:configure-flags
+ (assoc-ref %build-inputs "GMP"))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (system* "guix" "style" "-L" directory "my-coreutils"
+ "--input-simplification=safe")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)))))
+
+(test-equal "input labels, margin comment"
+ (list `(("gmp" ,gmp))
+ `(("acl" ,acl))
+ " (inputs (list gmp)) ;margin comment\n"
+ " (native-inputs (list acl)) ;another one\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp)))
+ (native-inputs `(("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n"))
+ (("\"acl\"(.*)$" _ rest)
+ (string-append "\"acl\"" (string-trim-right rest)
+ " ;another one\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (package-native-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs)
+ (read-package-field (@ (my-packages) my-coreutils) 'native-inputs)))))
+
+(test-equal "input labels, margin comment on long list"
+ (list (concatenate (make-list 4 `(("gmp" ,gmp) ("acl" ,acl))))
+ "\
+ (list gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl
+ gmp ;margin comment
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl)
+ ("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ (("\"gmp\"(.*)$" _ rest)
+ (string-append "\"gmp\"" (string-trim-right rest)
+ " ;margin comment\n")))
+ (system* "cat" file)
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 8)))))
+
+(test-equal "input labels, line comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl))
+ "\
+ (inputs (list gmp
+ ;; line comment!
+ acl))\n")
+ (call-with-test-package '((inputs `(("gmp" ,gmp) ("acl" ,acl))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp)\n ;; line comment!\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 3)))))
+
+(test-equal "input labels, modify-inputs and margin comment"
+ (list `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr))
+ "\
+ (modify-inputs (package-propagated-inputs coreutils)
+ (prepend gmp ;margin comment
+ acl ;another one
+ mpfr)))\n")
+ (call-with-test-package '((inputs
+ `(("gmp" ,gmp) ("acl" ,acl) ("mpfr" ,mpfr)
+ ,@(package-propagated-inputs coreutils))))
+ (lambda (directory)
+ (define file
+ (string-append directory "/my-packages.scm"))
+
+ (substitute* file
+ ((",gmp\\)(.*)$" _ rest)
+ (string-append ",gmp) ;margin comment\n" rest))
+ ((",acl\\)(.*)$" _ rest)
+ (string-append ",acl) ;another one\n" rest)))
+
+ (system* "guix" "style" "-L" directory "my-coreutils")
+
+ (load file)
+ (list (package-inputs (@ (my-packages) my-coreutils))
+ (read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+
+(test-end)
+
+;; Local Variables:
+;; eval: (put 'with-test-package 'scheme-indent-function 1)
+;; eval: (put 'call-with-test-package 'scheme-indent-function 1)
+;; End:
diff --git a/tests/utils.scm b/tests/utils.scm
index 2b7db73905..648e91f242 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -289,6 +290,22 @@ skip these tests."
(string-closest "hello" '("kikoo" "helo" "hihihi" "halo"))
(string-closest "hello" '("aaaaa" "12345" "hellohello" "h"))))
+(test-equal "target-linux?"
+ '(#t #f #f #t)
+ (map target-linux?
+ '("i686-linux-gnu" "i686-w64-mingw32"
+ ;; Checking that "gnu" is present is not sufficient,
+ ;; as GNU/Hurd exists.
+ "i686-pc-gnu"
+ ;; Some targets have a suffix.
+ "arm-linux-gnueabihf")))
+
+(test-equal "target-mingw?"
+ '(#f #f #t)
+ (map target-mingw?
+ '("i686-linux-gnu" "i686-pc-gnu"
+ "i686-w64-mingw32")))
+
(test-equal "target-x86-32?"
'(#f #f #f #t #t #t #t #f)
;; These are (according to Wikipedia) two RISC architectures
generated by cgit v1.2.3 (git 2.45.0) at 2024-06-11 17:23:39 +0000