diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/build-utils.scm | 12 | ||||
| -rw-r--r-- | tests/cache.scm | 30 | ||||
| -rw-r--r-- | tests/crate.scm | 113 | ||||
| -rw-r--r-- | tests/elm.scm | 2 | ||||
| -rw-r--r-- | tests/gem.scm | 12 | ||||
| -rw-r--r-- | tests/gexp.scm | 32 | ||||
| -rw-r--r-- | tests/git.scm | 22 | ||||
| -rw-r--r-- | tests/go.scm | 2 | ||||
| -rw-r--r-- | tests/guix-build.sh | 6 | ||||
| -rw-r--r-- | tests/guix-style.sh | 26 | ||||
| -rw-r--r-- | tests/guix-system.sh | 11 | ||||
| -rw-r--r-- | tests/hexpm.scm | 8 | ||||
| -rw-r--r-- | tests/import-utils.scm | 2 | ||||
| -rw-r--r-- | tests/minetest.scm | 2 | ||||
| -rw-r--r-- | tests/modules.scm | 18 | ||||
| -rw-r--r-- | tests/pack.scm | 1 | ||||
| -rw-r--r-- | tests/profiles.scm | 7 | ||||
| -rw-r--r-- | tests/pypi.scm | 8 | ||||
| -rw-r--r-- | tests/store-deduplication.scm | 58 | ||||
| -rw-r--r-- | tests/style.scm | 25 | ||||
| -rw-r--r-- | tests/syscalls.scm | 13 | ||||
| -rw-r--r-- | tests/texlive.scm | 307 |
22 files changed, 541 insertions, 176 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm index 7f4f12ccc7..3babf5d544 100644 --- a/tests/build-utils.scm +++ b/tests/build-utils.scm @@ -41,17 +41,17 @@ '((a . 1) (x . 42) (b . 2) (c . 3)) (alist-cons-before 'b 'x 42 '((a . 1) (b . 2) (c . 3)))) -(test-equal "alist-cons-before, reference not found" - '((a . 1) (b . 2) (c . 3) (x . 42)) - (alist-cons-before 'z 'x 42 '((a . 1) (b . 2) (c . 3)))) +(test-assert "alist-cons-before, reference not found" + (not (false-if-exception + (alist-cons-before 'z 'x 42 '((a . 1) (b . 2) (c . 3)))))) (test-equal "alist-cons-after" '((a . 1) (b . 2) (x . 42) (c . 3)) (alist-cons-after 'b 'x 42 '((a . 1) (b . 2) (c . 3)))) -(test-equal "alist-cons-after, reference not found" - '((a . 1) (b . 2) (c . 3) (x . 42)) - (alist-cons-after 'z 'x 42 '((a . 1) (b . 2) (c . 3)))) +(test-assert "alist-cons-after, reference not found" + (not (false-if-exception + (alist-cons-after 'z 'x 42 '((a . 1) (b . 2) (c . 3)))))) (test-equal "alist-replace" '((a . 1) (b . 77) (c . 3)) diff --git a/tests/cache.scm b/tests/cache.scm index d495ace2bd..e8ad083d40 100644 --- a/tests/cache.scm +++ b/tests/cache.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2020, 2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -22,7 +22,9 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-64) + #:use-module ((guix build syscalls) #:select (lock-file)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module ((rnrs io ports) #:select (get-string-all)) #:use-module (ice-9 match)) (test-begin "cache") @@ -75,6 +77,32 @@ (lambda (port) (display 0 port))))) +(let ((pid #f)) + (test-equal "maybe-remove-expired-cache-entries, cleanup needed but lock taken" + '() + (test-cache-cleanup cache + (let ((in+out (pipe))) + (match (primitive-fork) + (0 (dynamic-wind + (const #t) + (lambda () + (close-port (car in+out)) + (let ((port (lock-file + (string-append cache "/last-expiry-cleanup")))) + (display 0 port) + (display "done!\n" (cdr in+out)) + (close-port (cdr in+out)) + (sleep 100))) + (lambda () + (primitive-exit 0)))) + (n + (set! pid n) + (close-port (cdr in+out)) + (pk 'chr (get-string-all (car in+out))) + (close-port (car in+out))))))) + + (when pid (kill pid SIGKILL))) + (test-equal "maybe-remove-expired-cache-entries, empty cache" '("a" "b" "c") (test-cache-cleanup cache diff --git a/tests/crate.scm b/tests/crate.scm index ce2f08aade..63643c2728 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 David Craven <david@craven.ch> ;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net> +;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2023 David Elsing <david.elsing@posteo.net> ;;; @@ -500,10 +501,10 @@ ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-alice" ('unquote 'rust-leaf-alice-0.7)))))) + ('unquote (list rust-leaf-alice-0.7))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (string=? test-source-hash hash)) @@ -592,7 +593,7 @@ ('quasiquote (#:skip-build? #t))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-alice-0.7 (package @@ -606,12 +607,12 @@ (string-append name "-" version ".tar.gz")) (sha256 (base32 - (? string? hash))))) + (? string? hash))))) (build-system cargo-build-system) (arguments ('quasiquote (#:skip-build? #t))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-bob-3 (package @@ -630,7 +631,7 @@ (arguments ('quasiquote (#:skip-build? #t))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-intermediate-b-1 (package @@ -649,11 +650,10 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-leaf-bob" - ('unquote rust-leaf-bob-3)))))) + ('unquote (list rust-leaf-bob-3))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-intermediate-a-1 (package @@ -672,15 +672,12 @@ (arguments ('quasiquote (#:skip-build? #t #:cargo-inputs - (("rust-intermediate-b" - ('unquote rust-intermediate-b-1)) - ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7)) - ("rust-leaf-bob" - ('unquote rust-leaf-bob-3)))))) + ('unquote (list rust-intermediate-b-1 + rust-leaf-alice-0.7 + rust-leaf-bob-3))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-root-1 (package @@ -698,20 +695,15 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-intermediate-a" - ('unquote rust-intermediate-a-1)) - ("rust-intermediate-b" - ('unquote rust-intermediate-b-1)) - ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7)) - ("rust-leaf-bob" - ('unquote rust-leaf-bob-3))) + ('unquote (list rust-intermediate-a-1 + rust-intermediate-b-1 + rust-leaf-alice-0.7 + rust-leaf-bob-3)) #:cargo-development-inputs - (("rust-intermediate-c" - ('unquote rust-intermediate-c-1)))))) + ('unquote (list rust-intermediate-c-1))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0))))) #t) (x @@ -736,11 +728,10 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-development-inputs - (("rust-leaf-alice" - ('unquote rust-leaf-alice-0.7)))))) + ('unquote (list rust-leaf-alice-0.7))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-alice-0.7 (package @@ -758,7 +749,7 @@ (build-system cargo-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-bob-3 (package @@ -776,7 +767,7 @@ (build-system cargo-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-intermediate-b-1 (package @@ -798,7 +789,7 @@ ('unquote rust-leaf-bob-3)))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-intermediate-a-1 (package @@ -816,15 +807,12 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-intermediate-b" - ('unquote rust-intermediate-b-1)) - ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7)) - ("rust-leaf-bob" - ('unquote rust-leaf-bob-3)))))) + ('unquote (list rust-intermediate-b-1 + rust-leaf-alice-0.7 + rust-leaf-bob-3))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-root-1 (package @@ -842,20 +830,15 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-intermediate-a" - ('unquote rust-intermediate-a-1)) - ("rust-intermediate-b" - ('unquote rust-intermediate-b-1)) - ("rust-leaf-alice" - ('unquote 'rust-leaf-alice-0.7)) - ("rust-leaf-bob" - ('unquote rust-leaf-bob-3))) + ('unquote (list rust-intermediate-a-1 + rust-intermediate-b-1 + rust-leaf-alice-0.7 + rust-leaf-bob-3)) #:cargo-development-inputs - (("rust-intermediate-c" - ('unquote rust-intermediate-c-1)))))) + ('unquote (list rust-intermediate-c-1))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0))))) #t) (x @@ -963,16 +946,13 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3))) + ('unquote (list rust-leaf-bob-3)) #:cargo-development-inputs - (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0.2-yanked)) - ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-4.0.0-yanked)))))) + ('unquote (list rust-leaf-bob-3.0.2-yanked + rust-leaf-bob-4.0.0-yanked))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0))))) #t) (x @@ -1038,7 +1018,7 @@ (build-system cargo-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-bob-3.0.2-yanked (package @@ -1058,7 +1038,7 @@ (build-system cargo-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-leaf-bob-3 (package @@ -1076,7 +1056,7 @@ (build-system cargo-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0)))) (define-public 'rust-bar-1 (package @@ -1094,16 +1074,13 @@ (build-system cargo-build-system) (arguments ('quasiquote (#:cargo-inputs - (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3))) + ('unquote (list rust-leaf-bob-3)) #:cargo-development-inputs - (("rust-leaf-bob" - ('unquote 'rust-leaf-bob-3.0.2-yanked)) - ("rust-leaf-bob" - ('unquote 'rust-leaf-bob-4.0.0-yanked)))))) + ('unquote (list rust-leaf-bob-3.0.2-yanked + rust-leaf-bob-4.0.0-yanked))))) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "This package provides summary.") (license (list license:expat license:asl2.0))))) #t) (x diff --git a/tests/elm.scm b/tests/elm.scm index c30623da03..48d3eb4b01 100644 --- a/tests/elm.scm +++ b/tests/elm.scm @@ -257,7 +257,7 @@ package definition." "https://package.elm-lang.org/packages/elm-guix/demo/3.0.0") (synopsis "A test for `(guix import elm)`") (description - "This package provides a test for `(guix import elm)`") + "This package provides a test for `(guix import elm)`.") (properties '((upstream-name . "elm-guix/demo"))) (license license:gpl3+))) (equal? (directory-sha256 elm-guix-demo-dir) diff --git a/tests/gem.scm b/tests/gem.scm index 7e2436e3fb..dae29437e5 100644 --- a/tests/gem.scm +++ b/tests/gem.scm @@ -117,7 +117,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler ruby-bar)) (synopsis "A cool gem") - (description "This package provides a cool gem") + (description "This package provides a cool gem.") (home-page "https://example.com") (license (list license:expat license:asl2.0))) #t) @@ -146,7 +146,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler ruby-bar)) (synopsis "A cool gem") - (description "This package provides a cool gem") + (description "This package provides a cool gem.") (home-page "https://example.com") (license (list license:expat license:asl2.0))) #t) @@ -182,7 +182,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler)) (synopsis "Another cool gem") - (description "Another cool gem") + (description "Another cool gem.") (home-page "https://example.com") (license #f)) ;no licensing info (package @@ -198,7 +198,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler ruby-bar)) (synopsis "A cool gem") - (description "This package provides a cool gem") + (description "This package provides a cool gem.") (home-page "https://example.com") (license (list license:expat license:asl2.0)))) #t) @@ -234,7 +234,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler)) (synopsis "Another cool gem") - (description "Another cool gem") + (description "Another cool gem.") (home-page "https://example.com") (license #f)) ;no licensing info (package @@ -250,7 +250,7 @@ (build-system ruby-build-system) (propagated-inputs (list bundler ruby-bar)) (synopsis "A cool gem") - (description "This package provides a cool gem") + (description "This package provides a cool gem.") (home-page "https://example.com") (license (list license:expat license:asl2.0)))) #t) diff --git a/tests/gexp.scm b/tests/gexp.scm index 905009caee..ab99e19daa 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -47,6 +47,13 @@ (define %store (open-connection-for-tests)) +(define (bootstrap-guile-effective-version) + ;; TODO The package version of %bootstrap-guile is incorrect for + ;; riscv64-linux + (if (string=? "riscv64-linux" (%current-system)) + "3.0" + (package-version %bootstrap-guile))) + ;; Globally disable grafts because they can trigger early builds. (%graft? #f) @@ -244,6 +251,12 @@ (let ((file (local-file (string-copy "../base32.scm")))) (local-file-absolute-file-name file))))) +(test-equal "local-file, non-literal source relative file name" + (current-filename) + (let ((file (local-file (assume-source-relative-file-name + (string-append "gexp" ".scm"))))) + (local-file-absolute-file-name file))) + (test-assert "local-file, relative file name, within gexp" (let* ((file (search-path %load-path "guix/base32.scm")) (interned (add-to-store %store "base32.scm" #f "sha256" file))) @@ -1099,8 +1112,8 @@ importing.* \\(guix config\\) from the host" (write (list the-answer (multiply 2)) port))))))) (drv (gexp->derivation "thingie" build - ;; %BOOTSTRAP-GUILE is 2.0. - #:effective-version "2.0")) + #:effective-version + (bootstrap-guile-effective-version))) (out -> (derivation->output-path drv))) (mbegin %store-monad (built-derivations (list drv)) @@ -1120,7 +1133,8 @@ importing.* \\(guix config\\) from the host" mkdir-p the-answer)))) (lexp (lower-gexp exp - #:effective-version "2.0"))) + #:effective-version + (bootstrap-guile-effective-version)))) (define (matching-input drv output) (lambda (input) (and (eq? (derivation-input-derivation input) drv) @@ -1134,12 +1148,15 @@ importing.* \\(guix config\\) from the host" (lowered-gexp-inputs lexp)) (member (string-append (derivation->output-path extension-drv) - "/share/guile/site/2.0") + "/share/guile/site/" + (bootstrap-guile-effective-version)) (lowered-gexp-load-path lexp)) (= 2 (length (lowered-gexp-load-path lexp))) (member (string-append (derivation->output-path extension-drv) - "/lib/guile/2.0/site-ccache") + "/lib/guile/" + (bootstrap-guile-effective-version) + "/site-ccache") (lowered-gexp-load-compiled-path lexp)) (= 2 (length (lowered-gexp-load-compiled-path lexp))) (eq? (derivation-input-derivation (lowered-gexp-guile lexp)) @@ -1149,7 +1166,10 @@ importing.* \\(guix config\\) from the host" (mlet* %store-monad ((thing -> (program-file "prog" #~(display "hi!"))) (exp -> #~(list #$(raw-derivation-file thing))) (drv (lower-object thing)) - (lexp (lower-gexp exp #:effective-version "2.0"))) + (lexp (lower-gexp + exp + #:effective-version + (bootstrap-guile-effective-version)))) (return (and (equal? `(list ,(derivation-file-name drv)) (lowered-gexp-sexp lexp)) (equal? (list (derivation-file-name drv)) diff --git a/tests/git.scm b/tests/git.scm index ad43435b67..9ccd04f0cd 100644 --- a/tests/git.scm +++ b/tests/git.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz ;;; ;;; This file is part of GNU Guix. @@ -259,4 +259,24 @@ ;; COMMIT should be the ID of the commit object, not that of the tag. (string=? commit head)))))) +(test-assert "update-cached-checkout, untracked files removed" + (call-with-temporary-directory + (lambda (cache) + (with-temporary-git-repository directory + '((add "a.txt" "A") + (add ".gitignore" ".~\n") + (commit "First commit")) + (let ((directory commit relation + (update-cached-checkout directory + #:ref '() + #:cache-directory cache))) + (close-port + (open-output-file (in-vicinity cache "stale-untracked-file"))) + (let ((directory2 commit2 relation2 + (update-cached-checkout directory + #:ref '() + #:cache-directory cache))) + (not (file-exists? + (in-vicinity cache "stale-untracked-file"))))))))) + (test-end "git") diff --git a/tests/go.scm b/tests/go.scm index d2e8846b30..f925c485c1 100644 --- a/tests/go.scm +++ b/tests/go.scm @@ -389,7 +389,7 @@ require github.com/kr/pretty v0.2.1 (arguments (list #:import-path "github.com/go-check/check")) (propagated-inputs - `(("go-github-com-kr-pretty" ,go-github-com-kr-pretty))) + (list go-github-com-kr-pretty)) (home-page "https://github.com/go-check/check") (synopsis "Instructions") (description "Package check is a rich testing extension for Go's testing \ diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 4eab0e38b6..36eac2b7e0 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012-2014, 2016-2023 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012-2014, 2016-2024 Ludovic Courtès <ludo@gnu.org> # Copyright © 2020 Marius Bakke <mbakke@fastmail.com> # Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> # @@ -161,6 +161,10 @@ export GUIX_PACKAGE_PATH guix build -d -S foo guix build -d -S foo | grep -e 'foo\.tar\.gz' +# Make sure '-s' has an effect together with '-S'. +test "$(guix build -Sd coreutils -s x86_64-linux)" \ + != "$(guix build -Sd coreutils -s aarch64-linux)" + # 'baz' has a replacement so we should be getting the replacement's source. (unset GUIX_BUILD_OPTIONS; test "`guix build -d -S baz`" = "`guix build -d -S foo`") diff --git a/tests/guix-style.sh b/tests/guix-style.sh index 2de879d5e3..9333139435 100644 --- a/tests/guix-style.sh +++ b/tests/guix-style.sh @@ -58,6 +58,24 @@ cat > "$tmpfile" <<EOF ;; The services. (services (cons (service mcron-service-type) %base-services))) +;; Incomplete package definitions in alphabetical order. + +(define-public pkg + (package + (name "bar") + (version "2"))) + +;; The comment below belongs to the foo package. +(define-public pkg + (package + (name "bar") + (version "1"))) +;; Incomplete package definitions in alphabetical order. + +(define-public pkg + (package + (name "foo") + (version "2"))) EOF cp "$tmpfile" "$tmpfile.bak" @@ -78,3 +96,11 @@ test "$initial_hash" != "$(guix hash "$tmpfile")" guix style -f "$tmpfile" test "$initial_hash" = "$(guix hash "$tmpfile")" + +# Swap foo and bar packages. +sed -i "$tmpfile" -e 's/"foo"/"bar"/g' +sed -i "$tmpfile" -e '0,/"bar"/{s//"foo"/}' +test "$initial_hash" != "$(guix hash "$tmpfile")" + +guix style -fA "$tmpfile" +test "$initial_hash" = "$(guix hash "$tmpfile")" diff --git a/tests/guix-system.sh b/tests/guix-system.sh index 29e490c3d4..99147cf332 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2014-2022, 2024 Ludovic Courtès <ludo@gnu.org> # Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> # @@ -355,17 +355,22 @@ for example in gnu/system/examples/*.tmpl; do # Skip it. continue ;; + *desktop*) + # This image uses 'grub-efi-bootloader' so it needs a GPT + # partition. + options="-t efi-raw --system=x86_64-linux";; *) options="" ;; esac - guix system -n disk-image $options "$example" + guix system -n image $options "$example" done # Make sure the desktop image can be built on major architectures. for system in x86_64-linux aarch64-linux do - guix system -n image -s "$system" gnu/system/examples/desktop.tmpl + guix system -n image -s "$system" -t efi-raw \ + gnu/system/examples/desktop.tmpl done # Verify that the images can be built. diff --git a/tests/hexpm.scm b/tests/hexpm.scm index 5df9af0ca6..1e746f9b34 100644 --- a/tests/hexpm.scm +++ b/tests/hexpm.scm @@ -152,7 +152,7 @@ (build-system rebar-build-system) (inputs (list erlang-blubb erlang-fasel)) (synopsis "A cool package") - (description "This package provides a cool package") + (description "This package provides a cool package.") (home-page "https://hex.pm/packages/bla") (license (list license:expat license:asl2.0))) #t) @@ -212,7 +212,7 @@ (build-system mix-build-system) (inputs (list erlang-fasel)) (synopsis "Another cool package") - (description "Another cool package") + (description "Another cool package.") (home-page "https://hex.pm/packages/blubb") (license license:expat)) (package @@ -227,7 +227,7 @@ "1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha")))) (build-system gnu-build-system) (synopsis "Yet another cool package") - (description "Yet another cool package") + (description "Yet another cool package.") (home-page "https://hex.pm/packages/fasel") (license "GPL")) (package @@ -243,7 +243,7 @@ (build-system rebar-build-system) (inputs (list erlang-blubb erlang-fasel)) (synopsis "A cool package") - (description "This package provides a cool package") + (description "This package provides a cool package.") (home-page "https://hex.pm/packages/bla") (license (list license:expat license:asl2.0)))) #t) diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 229e6eafaa..bec38b0c30 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -42,7 +42,7 @@ Trust me Mr. Hendrix, M. Night Shyamalan et al. \ Differences are hard to spot, e.g. in CLOS vs. GOOPS.")) (test-equal "beautify-description: transform fragment into sentence" - "This package provides a function to establish world peace" + "This package provides a function to establish world peace." (beautify-description "A function to establish world peace")) (test-equal "beautify-description: remove single quotes" diff --git a/tests/minetest.scm b/tests/minetest.scm index 78469bf95b..bf1313ee22 100644 --- a/tests/minetest.scm +++ b/tests/minetest.scm @@ -48,7 +48,7 @@ (home-page "https://example.org/foo") (repo "https://example.org/foo.git") (synopsis "synopsis") - (guix-description "description") + (guix-description "description.") (guix-license '(list license:cc-by-sa4.0 license:lgpl3+)) (inputs '()) diff --git a/tests/modules.scm b/tests/modules.scm index e70d2d9e08..4a42da25b7 100644 --- a/tests/modules.scm +++ b/tests/modules.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016-2017, 2024 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,7 +18,7 @@ (define-module (test-modules) #:use-module (guix modules) - #:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules)) + #:use-module ((guix build-system gnu) #:select (%default-gnu-imported-modules)) #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) @@ -30,9 +30,9 @@ (lset= equal? (live-module-closure '((guix build gnu-build-system))) (source-module-closure '((guix build gnu-build-system))) - %gnu-build-system-modules - (source-module-closure %gnu-build-system-modules) - (live-module-closure %gnu-build-system-modules))) + %default-gnu-imported-modules + (source-module-closure %default-gnu-imported-modules) + (live-module-closure %default-gnu-imported-modules))) (test-assert "closure of (gnu build install)" (lset= equal? @@ -65,4 +65,12 @@ (source-module-closure '((baz)) (list directory) #:select? (const #t)))))) +(test-equal "file-name->module-name" + '(guix foo) + (file-name->module-name "guix/foo.scm")) + +(test-equal "file-name->module-name, leading dot" + '(guix foo) + (file-name->module-name "./guix/foo.scm")) + (test-end) diff --git a/tests/pack.scm b/tests/pack.scm index 40897a5589..f8a9e09c28 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -328,6 +328,7 @@ (when (and (file-exists? (string-append bin "/guile")) (file-exists? "var/guix/db/db.sqlite") + (file-is-directory? "tmp") (string=? (string-append #$%bootstrap-guile "/bin") (pk 'binlink (readlink bin))) diff --git a/tests/profiles.scm b/tests/profiles.scm index ddd6d74f3b..e448137cff 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -463,7 +463,6 @@ (target -> "arm-linux-gnueabihf") (grep (package->cross-derivation packages:grep target)) (sed (package->cross-derivation packages:sed target)) - (locales (package->derivation (packages:libc-utf8-locales-for-target))) (drv (profile-derivation manifest #:hooks '() #:locales? #t @@ -475,15 +474,11 @@ (and (string-suffix? name input) input))) (derivation-inputs drv)))) - ;; The inputs for grep and sed should be cross-build derivations, but that - ;; for the glibc-utf8-locales should be a native build. (return (and (string=? (derivation-system drv) (%current-system)) (string=? (find-input packages:grep) (derivation-file-name grep)) (string=? (find-input packages:sed) - (derivation-file-name sed)) - (string=? (find-input (packages:libc-utf8-locales-for-target)) - (derivation-file-name locales)))))) + (derivation-file-name sed)))))) (test-assert "package->manifest-entry defaults to \"out\"" (let ((outputs (package-outputs packages:glibc))) diff --git a/tests/pypi.scm b/tests/pypi.scm index 42b39cde73..c9aee34d8b 100644 --- a/tests/pypi.scm +++ b/tests/pypi.scm @@ -315,7 +315,7 @@ files specified by SPECS. Return its file name." (native-inputs (list python-pytest)) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "summary.") (license license:lgpl2.0)) (and (string=? default-sha256/base32 hash) (equal? (pypi->guix-package "foo" #:version "1.0.0") @@ -356,7 +356,7 @@ to make sure we're testing wheels")))) (native-inputs (list python-pytest)) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "summary.") (license license:lgpl2.0)) (string=? default-sha256/base32 hash)) (x @@ -384,7 +384,7 @@ to make sure we're testing wheels")))) (build-system pyproject-build-system) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "summary.") (license license:lgpl2.0)) (string=? default-sha256/base32 hash)) (x @@ -414,7 +414,7 @@ to make sure we're testing wheels")))) (native-inputs (list python-pytest)) (home-page "http://example.com") (synopsis "summary") - (description "summary") + (description "summary.") (license license:lgpl2.0)) (string=? default-sha256/base32 hash)) (x diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index f1845035d8..f116ff9834 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-2022 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2020-2022, 2024 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,10 +24,27 @@ #:use-module (guix build utils) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) + #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64)) +(define (cartesian-product . lst) + "Return the Cartesian product of all the given lists." + (match lst + ((head) + (map list head)) + ((head . rest) + (let ((others (apply cartesian-product rest))) + (append-map (lambda (init) + (map (lambda (lst) + (cons init lst)) + others)) + head))) + (() + '()))) + + (test-begin "store-deduplication") (test-equal "deduplicate, below %deduplication-minimum-size" @@ -166,4 +183,43 @@ (cut string-append store <>)) '("/a" "/b" "/c")))))))) +(for-each (match-lambda + ((initial-gap middle-gap final-gap) + (test-assert + (format #f "copy-file/deduplicate, sparse files (holes: ~a/~a/~a)" + initial-gap middle-gap final-gap) + (call-with-temporary-directory + (lambda (store) + (let ((source (string-append store "/source"))) + (call-with-output-file source + (lambda (port) + (seek port initial-gap SEEK_CUR) + (display "hi!" port) + (seek port middle-gap SEEK_CUR) + (display "bye." port) + (when (> final-gap 0) + (seek port (- final-gap 1) SEEK_CUR) + (put-u8 port 0)))) + + (for-each (lambda (target) + (copy-file/deduplicate source + (string-append store target) + #:store store)) + '("/a" "/b" "/c")) + (system* "du" "-h" source) + (system* "du" "-h" "--apparent-size" source) + (system* "du" "-h" (string-append store "/a")) + (system* "du" "-h" "--apparent-size" (string-append store "/a")) + (and (directory-exists? (string-append store "/.links")) + (file=? source (string-append store "/a")) + (apply = (map (compose stat:ino stat + (cut string-append store <>)) + '("/a" "/b" "/c"))) + (let ((st (pk 'S (stat (string-append store "/a"))))) + (<= (* 512 (stat:blocks st)) + (stat:size st)))))))))) + (cartesian-product '(0 3333 8192) + '(8192 9999 16384 22222) + '(0 8192))) + (test-end "store-deduplication") diff --git a/tests/style.scm b/tests/style.scm index 5e38549606..3125f4cb1b 100644 --- a/tests/style.scm +++ b/tests/style.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021-2024 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -500,6 +500,29 @@ (load file) (read-package-field (@ (my-packages) my-coreutils) 'arguments 7)))) +(test-equal "gexpify arguments, substitute-keyword-arguments + unquote-splicing" + "\ + (substitute-keyword-arguments (package-arguments coreutils) + ((#:make-flags flags + #~'()) + #~(cons \"-DXYZ=yes\" + #$@(if #t flags + '())))))\n" + (call-with-test-package '((arguments + (substitute-keyword-arguments + (package-arguments coreutils) + ((#:make-flags flags ''()) + `(cons "-DXYZ=yes" ,@(if #t flags '())))))) + (lambda (directory) + (define file + (string-append directory "/my-packages.scm")) + + (system* "guix" "style" "-L" directory "my-coreutils" + "-S" "arguments") + + (load file) + (read-package-field (@ (my-packages) my-coreutils) 'arguments 6)))) + (test-equal "gexpify arguments, append substitute-keyword-arguments" "\ (append (list #:tests? #f) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7cf67c060d..13f4f11721 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -383,6 +383,19 @@ (close-port file) result))))))))) +(test-equal "lock-file + unlock-file" + 'hello + (call-with-temporary-directory + (lambda (directory) + (let* ((file (in-vicinity directory "lock")) + (out (lock-file file #:wait? #f))) + (display "hello" out) + (unlock-file out) + (let* ((in (lock-file file "r0")) + (content (read in))) + (unlock-file in) + content))))) + (test-equal "set-thread-name" "Syscall Test" (let ((name (thread-name))) diff --git a/tests/texlive.scm b/tests/texlive.scm index fac9faf714..8e7e596962 100644 --- a/tests/texlive.scm +++ b/tests/texlive.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2022 Ricardo Wurmus <rekado@elephly.net> -;;; Copyright © 2023 Nicolas Goaziou <mail@nicolasgoaziou.fr> +;;; Copyright © 2023, 2024 Nicolas Goaziou <mail@nicolasgoaziou.fr> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,7 +32,8 @@ (test-begin "texlive") (define %fake-tlpdb - '(("12many" + '((database-revision . 12345) + ("12many" . ((name . "12many") (catalogue @@ -162,6 +163,16 @@ "texmf-dist/tex/lollipop/lollipop.ini" "texmf-dist/tex/lollipop/lollipop.tex") (catalogue-license . "gpl3")) + ("m-tx" + (name . "m-tx") + (shortdesc . "A preprocessor for pmx") + (longdesc . "M-Tx is a preprocessor to pmx") + (depend "m-tx.ARCH") + (runfiles "texmf-dist/scripts/m-tx/m-tx.lua")) + ("m-tx.x86_64-linux" + (name . "m-tx.x86_64-linux") + (binfiles "bin/x86_64-linux/m-tx" + "bin/x86_64-linux/prepmx")) ("pax" (name . "pax") (shortdesc . "Extract and reinsert PDF...") @@ -180,6 +191,9 @@ (shortdesc . "x86_64-linux files of pax") (binfiles "bin/x86_64-linux/pdfannotextractor")) + ("r_und_s" + (name . "r_und_s") + (runfiles "texmf-dist/tex/latex/r_und_s/r_und_s.sty")) ("stricttex" . ((name . "stricttex") @@ -329,7 +343,22 @@ completely compatible with Plain TeX.") "texmf-dist/fonts/tfm/public/trsym/trsy12.tfm" "texmf-dist/tex/latex/trsym/trsym.sty" "texmf-dist/tex/latex/trsym/utrsy.fd") - (catalogue-license . "lppl")))) + (catalogue-license . "lppl")) + ("vlna" + (name . "vlna") + (shortdesc . "Add ~ after non-syllabic preposition") + (longdesc . "Preprocessor for TeX source") + (depend "vlna.ARCH") + (docfiles "texmf-dist/doc/man/man1/vlna.1")) + ("vlna.x86_64-linux" + (shortdesc "x86_64-linux files of vlna") + (binfiles "bin/x86_64-linux/vlna")) + ("web" + (depend "web.ARCH") + (docfiles "texmf-dist/doc/man/man1/tangle.1")) + ("web.x86_64-linux" + (name . "web.x86_64-linux") + (binfiles "bin/x86_64-linux/tangle")))) (test-assert "texlive->guix-package, no docfiles" ;; Replace network resources with sample data. @@ -344,16 +373,21 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "example" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-example") ('version _) - ('source ('texlive-origin - 'name 'version - ('list "tex/latex/example/") - ('base32 (? string? hash)))) + ('source ('origin + ('method 'svn-multi-fetch) + ('uri ('svn-multi-reference + ('url ('texlive-packages-repository 'version)) + ('revision 12345) + ('locations ('list "tex/latex/example/")))) + ('file-name ('git-file-name 'name 'version)) + ('sha256 + ('base32 (? string? hash))))) ('build-system 'texlive-build-system) ('home-page (? string?)) ('synopsis (? string?)) @@ -378,21 +412,27 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "texsis" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-texsis") ('version _) - ('source ('texlive-origin - 'name 'version - ('list "bibtex/bst/texsis/" - "doc/man/man1/texsis.1" - "doc/man/man1/texsis.man1.pdf" - "doc/otherformats/texsis/base/" - "tex/texsis/base/" - "tex/texsis/config/") - ('base32 (? string? hash)))) + ('source ('origin + ('method 'svn-multi-fetch) + ('uri ('svn-multi-reference + ('url ('texlive-packages-repository 'version)) + ('revision 12345) + ('locations + ('list "bibtex/bst/texsis/" + "doc/man/man1/texsis.1" + "doc/man/man1/texsis.man1.pdf" + "doc/otherformats/texsis/base/" + "tex/texsis/base/" + "tex/texsis/config/")))) + ('file-name ('git-file-name 'name 'version)) + ('sha256 + ('base32 (? string? hash))))) ('outputs ''("out" "doc")) ('build-system 'texlive-build-system) ('propagated-inputs @@ -424,8 +464,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "trsym" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name _) @@ -458,18 +498,23 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "12many" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-12many") ('version _) - ('source ('texlive-origin - 'name 'version - ('list "doc/latex/12many/" - "source/latex/12many/" - "tex/latex/12many/") - ('base32 (? string? hash)))) + ('source ('origin + ('method 'svn-multi-fetch) + ('uri ('svn-multi-reference + ('url ('texlive-packages-repository 'version)) + ('revision 12345) + ('locations ('list "doc/latex/12many/" + "source/latex/12many/" + "tex/latex/12many/")))) + ('file-name ('git-file-name 'name 'version)) + ('sha256 + ('base32 (? string? hash))))) ('outputs ''("out" "doc")) ('build-system 'texlive-build-system) ('home-page "https://ctan.org/pkg/one2many") @@ -495,17 +540,23 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "chs-physics-report" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-chs-physics-report") ('version _) - ('source ('texlive-origin - 'name 'version - ('list "doc/latex/chs-physics-report/" - "tex/latex/chs-physics-report/") - ('base32 (? string? hash)))) + ('source ('origin + ('method 'svn-multi-fetch) + ('uri ('svn-multi-reference + ('url ('texlive-packages-repository 'version)) + ('revision 12345) + ('locations + ('list "doc/latex/chs-physics-report/" + "tex/latex/chs-physics-report/")))) + ('file-name ('git-file-name 'name 'version)) + ('sha256 + ('base32 (? string? hash))))) ('outputs ''("out" "doc")) ('build-system 'texlive-build-system) ('home-page (? string?)) @@ -531,12 +582,12 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "collection-texworks" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-collection-texworks") - ('version _) + ('version '%texlive-version) ('source #f) ('build-system 'trivial-build-system) ('arguments @@ -567,17 +618,22 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "lollipop" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-lollipop") ('version _) - ('source ('texlive-origin - 'name 'version - ('list "doc/otherformats/lollipop/" - "tex/lollipop/") - ('base32 (? string? hash)))) + ('source ('origin + ('method 'svn-multi-fetch) + ('uri ('svn-multi-reference + ('url ('texlive-packages-repository 'version)) + ('revision 12345) + ('locations ('list "doc/otherformats/lollipop/" + "tex/lollipop/")))) + ('file-name ('git-file-name 'name 'version)) + ('sha256 + ('base32 (? string? hash))))) ('outputs ''("out" "doc")) ('build-system 'texlive-build-system) ('arguments ('list '#:create-formats ('gexp ('list "lollipop")))) @@ -604,8 +660,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "adforn" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-adforn") @@ -636,8 +692,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "collection-basic" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-collection-basic") @@ -671,8 +727,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "tex" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-tex") @@ -706,8 +762,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "authorindex" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-authorindex") @@ -740,8 +796,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "cyrillic-bin" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-cyrillic-bin") @@ -775,8 +831,8 @@ completely compatible with Plain TeX.") (lambda () (display "source"))))) (let ((result (texlive->guix-package "pax" - #:package-database - (lambda _ %fake-tlpdb)))) + #:version "0" + #:database %fake-tlpdb))) (match result (('package ('name "texlive-pax") @@ -798,4 +854,137 @@ completely compatible with Plain TeX.") (format #t "~s~%" result) (pk 'fail result #f))))))) +(test-assert "texlive->guix-package, propagated binaries, no script" + ;; 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) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "vlna" + #:version "0" + #:database %fake-tlpdb))) + (match result + (('package + ('name "texlive-vlna") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('propagated-inputs + ('list 'texlive-vlna-bin)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, propagated binaries and scripts" + ;; 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) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "m-tx" + #:version "0" + #:database %fake-tlpdb))) + (match result + (('package + ('name "texlive-m-tx") + ('version _) + ('source _) + ('build-system 'texlive-build-system) + ('arguments + ('list '#:link-scripts ('gexp ('list "m-tx.lua")))) + ('propagated-inputs + ('list 'texlive-m-tx-bin)) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with skipped propagated binaries" + ;; 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) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "web" + #:version "0" + #:database %fake-tlpdb))) + (match result + (('package + ('name "texlive-web") + ('version _) + ('source _) + ('outputs _) + ('build-system 'texlive-build-system) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + +(test-assert "texlive->guix-package, with upstream-name property" + ;; 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) + (recursive? #t)) + (mkdir-p directory) + (with-output-to-file (string-append directory "/foo") + (lambda () + (display "source"))))) + (let ((result (texlive->guix-package "r_und_s" + #:version "0" + #:database %fake-tlpdb))) + (match result + (('package + ('name "texlive-r-und-s") + ('version _) + ('source _) + ('properties _) + ('build-system 'texlive-build-system) + ('home-page _) + ('synopsis _) + ('description _) + ('license _)) + #true) + (_ + (begin + (format #t "~s~%" result) + (pk 'fail result #f))))))) + (test-end "texlive") |