From 493375cdb23fc1416348da584f17bec7171faadd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 26 May 2019 01:18:53 +0200 Subject: publish: Maintain a hash-part-to-store-item mapping in cache. Fixes . * guix/scripts/publish.scm (hash-part-mapping-cache-file) (hash-part->path*): New procedures. * guix/scripts/publish.scm (render-narinfo/cached)[delete-entry]: Delete the 'hash-part-mapping-cache-file'. Use 'hash-part->path*' instead of 'hash-part->path'. * tests/publish.scm ("with cache, vanishing item"): New test. --- tests/publish.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 097ac036e0..7f44bc700f 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -469,6 +469,35 @@ FileSize: ~a~%" (assoc-ref narinfo "FileSize")) (response-code compressed)))))))))) +(test-equal "with cache, vanishing item" ; + 200 + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6795" + (string-append "--cache=" cache))))))) + (wait-until-ready 6795) + + ;; Make sure that, even if ITEM disappears, we're still able to fetch + ;; it. + (let* ((base "http://localhost:6795/") + (item (add-text-to-store %store "random" (random-text))) + (part (store-path-hash-part item)) + (url (string-append base part ".narinfo")) + (cached (string-append cache + (if (zlib-available?) + "/gzip/" "/none/") + (basename item) + ".narinfo")) + (response (http-get url))) + (and (= 404 (response-code response)) + (wait-for-file cached) + (begin + (delete-paths %store (list item)) + (response-code (pk 'response (http-get url)))))))))) + (test-equal "/log/NAME" `(200 #t application/x-bzip2) (let ((drv (run-with-store %store -- cgit v1.2.3 From 002d17dcaacba0f86265b34f2509419d9e21224d Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sat, 25 May 2019 08:40:38 +0200 Subject: discovery: 'all-modules' returns modules in path order. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A particular effect of this is that if there are ambiguous packages in a directory specified with `-L module_dir` and the distribution, the version from `module_dir` will be loaded, which is usually what would be expected. (E.g. for `guix build` or `guix package -i`.) * guix/discovery.scm (all-modules): Return modules in path order. * tests/guix-package.sh: Test local definitions take precedence. Signed-off-by: Ludovic Courtès --- tests/guix-package.sh | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'tests') diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 767c3f8a66..79d6ec65e4 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -280,6 +280,20 @@ export GUIX_PACKAGE_PATH guix package -A emacs-foo-bar | grep 42 guix package -i emacs-foo-bar@42 -n +# Make sure GUIX_PACKAGE_PATH/'-L' takes precedence in case of duplicate packages. +cat > "$module_dir/bar.scm"<&1 | grep choosing.*bar.scm +( unset GUIX_PACKAGE_PATH; \ + guix package -i hello -n -L "$module_dir" 2>&1 | grep choosing.*bar.scm ) + # Make sure patches that live under $GUIX_PACKAGE_PATH are found. cat > "$module_dir/emacs.patch"< Date: Sun, 26 May 2019 23:18:21 +0200 Subject: import: hackage: Fix Cabal test. * guix/import/hackage.scm (hackage->guix-package): Remove call to 'memoize'. (hackage->guix-package/m): New procedure. (hackage-recursive-import): Use it. * tests/hackage.scm ("hackage->guix-package test 6"): Adjust. Co-authored-by: Robert Vollmert --- tests/hackage.scm | 37 +++++++++++++++++++++++++++++++++++-- 1 file changed, 35 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index e17851a213..0efad0638d 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -207,8 +207,41 @@ library #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 6" - (eval-test-with-cabal test-cabal-6 - #:cabal-environment '(("impl" . "ghc-7.8")))) + (mock + ((guix import hackage) hackage-fetch + (lambda (name-version) + (call-with-input-string test-cabal-6 + read-cabal))) + (match (hackage->guix-package "foo") + (('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-b" ('unquote 'ghc-b)) + ("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('native-inputs + ('quasiquote + (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3)) + #t) + (x + (pk 'fail x #f))))) (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) -- cgit v1.2.3 From 2a991f3ae4823730395c7970d83159e93d5f5fe2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 23 May 2019 21:35:47 +0200 Subject: lzlib: Add 'make-lzip-input-port/compressed'. * guix/lzlib.scm (lzwrite!, make-lzip-input-port/compressed): New procedures. * tests/lzlib.scm ("make-lzip-input-port/compressed"): New test. * guix/tests.scm (%seed): Export. --- tests/lzlib.scm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'tests') diff --git a/tests/lzlib.scm b/tests/lzlib.scm index cf53a9417d..543622bb45 100644 --- a/tests/lzlib.scm +++ b/tests/lzlib.scm @@ -108,4 +108,14 @@ (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)" (compress-and-decompress (random-bytevector (1+ (* 1024 1024))))) +(test-assert "make-lzip-input-port/compressed" + (let* ((len (pk 'len (+ 10 (random 4000 %seed)))) + (data (random-bytevector len)) + (compressed (make-lzip-input-port/compressed + (open-bytevector-input-port data))) + (result (call-with-lzip-input-port compressed + get-bytevector-all))) + (pk (bytevector-length result) (bytevector-length data)) + (bytevector=? result data))) + (test-end) -- cgit v1.2.3 From 4c7ebe318f6b3c4ddadcea8d08c9fb67ac46ec1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 23 May 2019 22:11:33 +0200 Subject: utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz. * tests/utils.scm (test-compression/decompression): New procedure. : Call it for both 'xz and 'gzip. --- tests/utils.scm | 67 ++++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 42 insertions(+), 25 deletions(-) (limited to 'tests') diff --git a/tests/utils.scm b/tests/utils.scm index 3015b21b23..a5141592a8 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016 Mathieu Lirzin ;;; @@ -174,30 +174,47 @@ (any (compose (negate zero?) cdr waitpid) pids)))) -(test-assert "compressed-port, decompressed-port, non-file" - (let ((data (call-with-input-file (search-path %load-path "guix.scm") - get-bytevector-all))) - (let*-values (((compressed pids1) - (compressed-port 'xz (open-bytevector-input-port data))) - ((decompressed pids2) - (decompressed-port 'xz compressed))) - (and (every (compose zero? cdr waitpid) - (append pids1 pids2)) - (equal? (get-bytevector-all decompressed) data))))) - -(false-if-exception (delete-file temp-file)) -(test-assert "compressed-output-port + decompressed-port" - (let* ((file (search-path %load-path "guix/derivations.scm")) - (data (call-with-input-file file get-bytevector-all)) - (port (open-file temp-file "w0b"))) - (call-with-compressed-output-port 'xz port - (lambda (compressed) - (put-bytevector compressed data))) - (close-port port) - - (bytevector=? data - (call-with-decompressed-port 'xz (open-file temp-file "r0b") - get-bytevector-all)))) +(define (test-compression/decompression method run?) + "Test METHOD, a symbol such as 'gzip. Call RUN? to determine whether to +skip these tests." + (unless (run?) (test-skip 1)) + (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]" + method) + (let ((data (call-with-input-file (search-path %load-path "guix.scm") + get-bytevector-all))) + (let*-values (((compressed pids1) + (compressed-port method (open-bytevector-input-port data))) + ((decompressed pids2) + (decompressed-port method compressed))) + (and (every (compose zero? cdr waitpid) + (pk 'pids method (append pids1 pids2))) + (let ((result (get-bytevector-all decompressed))) + (pk 'len method + (if (bytevector? result) + (bytevector-length result) + result) + (bytevector-length data)) + (equal? result data)))))) + + (false-if-exception (delete-file temp-file)) + (unless (run?) (test-skip 1)) + (test-assert (format #f "compressed-output-port + decompressed-port [~a]" + method) + (let* ((file (search-path %load-path "guix/derivations.scm")) + (data (call-with-input-file file get-bytevector-all)) + (port (open-file temp-file "w0b"))) + (call-with-compressed-output-port method port + (lambda (compressed) + (put-bytevector compressed data))) + (close-port port) + + (bytevector=? data + (call-with-decompressed-port method (open-file temp-file "r0b") + get-bytevector-all))))) + +(for-each test-compression/decompression + '(gzip xz lzip) + (list (const #t) (const #t))) ;; This is actually in (guix store). (test-equal "store-path-package-name" -- cgit v1.2.3 From 4e48923e7523c863996bb616c6abb7e4cb78a3b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 23 May 2019 22:14:53 +0200 Subject: utils: Support compression and decompression with lzip. * guix/utils.scm (lzip-port): New procedure. (decompressed-port, compressed-port, compressed-output-port): Add 'lzip case. * tests/utils.scm : Call 'test-compression/decompression' for 'lzip as well. --- tests/utils.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/utils.scm b/tests/utils.scm index a5141592a8..44861384ab 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -23,6 +23,7 @@ #:use-module (guix utils) #:use-module ((guix store) #:select (%store-prefix store-path-package-name)) #:use-module ((guix search-paths) #:select (string-tokenize*)) + #:use-module ((guix lzlib) #:select (lzlib-available?)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-64) @@ -214,7 +215,7 @@ skip these tests." (for-each test-compression/decompression '(gzip xz lzip) - (list (const #t) (const #t))) + (list (const #t) (const #t) lzlib-available?)) ;; This is actually in (guix store). (test-equal "store-path-package-name" -- cgit v1.2.3 From 66229b04ae0ee05779b93d77900a062b8e0e8770 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 24 May 2019 08:26:38 +0200 Subject: publish: Add support for lzip. * guix/scripts/publish.scm (show-help, %options): Support '-C METHOD' and '-C METHOD:LEVEL'. (default-compression): New procedure. (bake-narinfo+nar): Add lzip. (nar-response-port): Likewise. (string->compression-type): New procedure. (make-request-handler): Generalize /nar/gzip handler to handle /nar/lzip as well. * tests/publish.scm ("/nar/lzip/*"): New test. ("/*.narinfo with lzip compression"): New test. * doc/guix.texi (Invoking guix publish): Document it. (Requirements): Mention lzlib. --- tests/publish.scm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 7f44bc700f..80e0977cd5 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -36,6 +36,7 @@ #:use-module (gcrypt pk-crypto) #:use-module ((guix pki) #:select (%public-key-file %private-key-file)) #:use-module (guix zlib) + #:use-module (guix lzlib) #:use-module (web uri) #:use-module (web client) #:use-module (web response) @@ -229,6 +230,19 @@ FileSize: ~a~%" (string-append "/nar/gzip/" (basename %item)))))) (get-bytevector-n nar (bytevector-length %gzip-magic-bytes)))) +(unless (lzlib-available?) + (test-skip 1)) +(test-equal "/nar/lzip/*" + "bar" + (call-with-temporary-output-file + (lambda (temp port) + (let ((nar (http-get-port + (publish-uri + (string-append "/nar/lzip/" (basename %item)))))) + (call-with-lzip-input-port nar + (cut restore-file <> temp))) + (call-with-input-file temp read-string)))) + (unless (zlib-available?) (test-skip 1)) (test-equal "/*.narinfo with compression" @@ -251,6 +265,28 @@ FileSize: ~a~%" (_ #f))) (recutils->alist body))))) +(unless (lzlib-available?) + (test-skip 1)) +(test-equal "/*.narinfo with lzip compression" + `(("StorePath" . ,%item) + ("URL" . ,(string-append "nar/lzip/" (basename %item))) + ("Compression" . "lzip")) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6790" "-Clzip")))))) + (wait-until-ready 6790) + (let* ((url (string-append "http://localhost:6790/" + (store-path-hash-part %item) ".narinfo")) + (body (http-get-port url))) + (filter (lambda (item) + (match item + (("Compression" . _) #t) + (("StorePath" . _) #t) + (("URL" . _) #t) + (_ #f))) + (recutils->alist body))))) + (unless (zlib-available?) (test-skip 1)) (test-equal "/*.narinfo for a compressed file" -- cgit v1.2.3 From 55c98f3261b6ced2c38e060566e1eb952bd3e42b Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:41 +0200 Subject: tests: hackage: Factor out package pattern. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Import result pattern matching via helper. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 133 +++++++++++++++++++++++++++--------------------------- 1 file changed, 66 insertions(+), 67 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index 0efad0638d..41e3b2dcd3 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -155,93 +155,92 @@ library (test-begin "hackage") -(define* (eval-test-with-cabal test-cabal #:key (cabal-environment '())) +(define-syntax-rule (define-package-matcher name pattern) + (define* (name obj) + (match obj + (pattern #t) + (x (pk 'fail x #f))))) + +(define-package-matcher match-ghc-foo + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + +(define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) (mock ((guix import hackage) hackage-fetch (lambda (name-version) (call-with-input-string test-cabal read-cabal))) - (match (hackage->guix-package "foo" #:cabal-environment cabal-environment) - (('package - ('name "ghc-foo") - ('version "1.0.0") - ('source - ('origin - ('method 'url-fetch) - ('uri ('string-append - "https://hackage.haskell.org/package/foo/foo-" - 'version - ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'haskell-build-system) - ('inputs - ('quasiquote - (("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) - ('home-page "http://test.org") - ('synopsis (? string?)) - ('description (? string?)) - ('license 'bsd-3)) - #t) - (x - (pk 'fail x #f))))) + (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment)))) (test-assert "hackage->guix-package test 1" - (eval-test-with-cabal test-cabal-1)) + (eval-test-with-cabal test-cabal-1 match-ghc-foo)) (test-assert "hackage->guix-package test 2" - (eval-test-with-cabal test-cabal-2)) + (eval-test-with-cabal test-cabal-2 match-ghc-foo)) (test-assert "hackage->guix-package test 3" - (eval-test-with-cabal test-cabal-3 + (eval-test-with-cabal test-cabal-3 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 4" - (eval-test-with-cabal test-cabal-4 + (eval-test-with-cabal test-cabal-4 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) (test-assert "hackage->guix-package test 5" - (eval-test-with-cabal test-cabal-5 + (eval-test-with-cabal test-cabal-5 match-ghc-foo #:cabal-environment '(("impl" . "ghc-7.8")))) +(define-package-matcher match-ghc-foo-6 + ('package + ('name "ghc-foo") + ('version "1.0.0") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "https://hackage.haskell.org/package/foo/foo-" + 'version + ".tar.gz")) + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'haskell-build-system) + ('inputs + ('quasiquote + (("ghc-b" ('unquote 'ghc-b)) + ("ghc-http" ('unquote 'ghc-http)) + ("ghc-mtl" ('unquote 'ghc-mtl))))) + ('native-inputs + ('quasiquote + (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) + ('home-page "http://test.org") + ('synopsis (? string?)) + ('description (? string?)) + ('license 'bsd-3))) + (test-assert "hackage->guix-package test 6" - (mock - ((guix import hackage) hackage-fetch - (lambda (name-version) - (call-with-input-string test-cabal-6 - read-cabal))) - (match (hackage->guix-package "foo") - (('package - ('name "ghc-foo") - ('version "1.0.0") - ('source - ('origin - ('method 'url-fetch) - ('uri ('string-append - "https://hackage.haskell.org/package/foo/foo-" - 'version - ".tar.gz")) - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'haskell-build-system) - ('inputs - ('quasiquote - (("ghc-b" ('unquote 'ghc-b)) - ("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) - ('native-inputs - ('quasiquote - (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) - ('home-page "http://test.org") - ('synopsis (? string?)) - ('description (? string?)) - ('license 'bsd-3)) - #t) - (x - (pk 'fail x #f))))) + (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) -- cgit v1.2.3 From 4110cde00560bd97cc8d83c34b80c52f37c680a2 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:42 +0200 Subject: tests: hackage: Don't mock hackage-fetch. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Pass a string input port to tests instead of mocking hackage download. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index 41e3b2dcd3..1b4800164e 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -186,12 +186,8 @@ library ('license 'bsd-3))) (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) - (mock - ((guix import hackage) hackage-fetch - (lambda (name-version) - (call-with-input-string test-cabal - read-cabal))) - (matcher (hackage->guix-package "foo" #:cabal-environment cabal-environment)))) + (define port (open-input-string test-cabal)) + (matcher (hackage->guix-package "foo" #:port port #:cabal-environment cabal-environment))) (test-assert "hackage->guix-package test 1" (eval-test-with-cabal test-cabal-1 match-ghc-foo)) -- cgit v1.2.3 From 0be465924c6f745618a73eea816aa15aba7c8d30 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Fri, 31 May 2019 23:22:43 +0200 Subject: tests: Indent hackage tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm: Reindent using etc/indent-code.el. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index 1b4800164e..e5f3d6caed 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -242,19 +242,19 @@ library (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me")) ('section 'library - (('if ('flag "base4point8") - (("build-depends" ("base >= 4.8 && < 5"))) - (('if ('flag "base4") - (("build-depends" ("base >= 4 && < 4.8"))) - (('if ('flag "base3") - (("build-depends" ("base >= 3 && < 4"))) - (("build-depends" ("base < 3")))))))) - ('if ('or ('flag "base4point8") - ('and ('flag "base4") ('flag "base3"))) - (("build-depends" ("random"))) - ()) - ("build-depends" ("containers")) - ("exposed-modules" ("Test.QuickCheck.Exception"))))) + (('if ('flag "base4point8") + (("build-depends" ("base >= 4.8 && < 5"))) + (('if ('flag "base4") + (("build-depends" ("base >= 4 && < 4.8"))) + (('if ('flag "base3") + (("build-depends" ("base >= 3 && < 4"))) + (("build-depends" ("base < 3")))))))) + ('if ('or ('flag "base4point8") + ('and ('flag "base4") ('flag "base3"))) + (("build-depends" ("random"))) + ()) + ("build-depends" ("containers")) + ("exposed-modules" ("Test.QuickCheck.Exception"))))) #t) (x (pk 'fail x #f)))) -- cgit v1.2.3 From b8fa86adfc01205f1d942af8cb57515eb3726c52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 30 May 2019 18:36:37 +0200 Subject: publish: '--compression' can be repeated. This allows 'guix publish' to compress and advertise multiple compression methods from which users can choose. * guix/scripts/publish.scm (actual-compression): Rename to... (actual-compressions): ... this. Expect REQUESTED to be a list, and always return a list. (%default-options): Remove 'compression. (store-item->recutils): New procedure. (narinfo-string): Change #:compression to #:compressions (plural). Adjust accordingly. (render-narinfo, render-narinfo/cached): Likewise. (bake-narinfo+nar): Change #:compression to #:compressions. [compressed-nar-size]: New procedure. Call 'compress-nar' for each item returned by 'actual-compressions'. Create a narinfo for each compression. (effective-compression): New procedure. (make-request-handler): Change #:compression to #:compressions. Use 'effective-compression' to determine the applicable compression. (guix-publish): Adjust handling of '--compression'. Print a message for each compression that is enabled. * tests/publish.scm ("/*.narinfo"): Adjust to new narinfo field ordering. ("/*.narinfo with properly encoded '+' sign"): Likewise. ("/*.narinfo with lzip + gzip"): New test. ("with cache, lzip + gzip"): New test. * doc/guix.texi (Invoking guix publish): Document it. --- tests/publish.scm | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 82 insertions(+), 7 deletions(-) (limited to 'tests') diff --git a/tests/publish.scm b/tests/publish.scm index 80e0977cd5..64a8ff3cae 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -138,17 +138,17 @@ "StorePath: ~a URL: nar/~a Compression: none +FileSize: ~a NarHash: sha256:~a NarSize: ~d -References: ~a -FileSize: ~a~%" +References: ~a~%" %item (basename %item) + (path-info-nar-size info) (bytevector->nix-base32-string (path-info-hash info)) (path-info-nar-size info) - (basename (first (path-info-references info))) - (path-info-nar-size info))) + (basename (first (path-info-references info))))) (signature (base64-encode (string->utf8 (canonical-sexp->string @@ -170,15 +170,15 @@ FileSize: ~a~%" "StorePath: ~a URL: nar/~a Compression: none +FileSize: ~a NarHash: sha256:~a NarSize: ~d -References: ~%\ -FileSize: ~a~%" +References: ~%" item (uri-encode (basename item)) + (path-info-nar-size info) (bytevector->nix-base32-string (path-info-hash info)) - (path-info-nar-size info) (path-info-nar-size info))) (signature (base64-encode (string->utf8 @@ -301,6 +301,35 @@ FileSize: ~a~%" (list (assoc-ref info "Compression") (dirname (assoc-ref info "URL"))))) +(unless (and (zlib-available?) (lzlib-available?)) + (test-skip 1)) +(test-equal "/*.narinfo with lzip + gzip" + `((("StorePath" . ,%item) + ("URL" . ,(string-append "nar/gzip/" (basename %item))) + ("Compression" . "gzip") + ("URL" . ,(string-append "nar/lzip/" (basename %item))) + ("Compression" . "lzip")) + 200 + 200) + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2")))))) + (wait-until-ready 6793) + (let* ((base "http://localhost:6793/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (body (http-get-port url))) + (list (take (recutils->alist body) 5) + (response-code + (http-get (string-append base "nar/gzip/" + (basename %item)))) + (response-code + (http-get (string-append base "nar/lzip/" + (basename %item)))))))))) + (test-equal "custom nar path" ;; Serve nars at /foo/bar/chbouib instead of /nar. (list `(("StorePath" . ,%item) @@ -441,6 +470,52 @@ FileSize: ~a~%" (stat:size (stat nar))) (response-code uncompressed))))))))) +(unless (and (zlib-available?) (lzlib-available?)) + (test-skip 1)) +(test-equal "with cache, lzip + gzip" + '(200 200 404) + (call-with-temporary-directory + (lambda (cache) + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2" + (string-append "--cache=" cache))))))) + (wait-until-ready 6794) + (let* ((base "http://localhost:6794/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (nar-url (cute string-append "nar/" <> "/" + (basename %item))) + (cached (cute string-append cache "/" <> "/" + (basename %item) ".narinfo")) + (nar (cute string-append cache "/" <> "/" + (basename %item) ".nar")) + (response (http-get url))) + (wait-for-file (cached "gzip")) + (let* ((body (http-get-port url)) + (narinfo (recutils->alist body)) + (uncompressed (string-append base "nar/" + (basename %item)))) + (and (file-exists? (nar "gzip")) + (file-exists? (nar "lzip")) + (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7) + `(("StorePath" . ,%item) + ("URL" . ,(nar-url "gzip")) + ("Compression" . "gzip") + ("FileSize" . ,(number->string + (stat:size (stat (nar "gzip"))))) + ("URL" . ,(nar-url "lzip")) + ("Compression" . "lzip") + ("FileSize" . ,(number->string + (stat:size (stat (nar "lzip"))))))) + (list (response-code + (http-get (string-append base (nar-url "gzip")))) + (response-code + (http-get (string-append base (nar-url "lzip")))) + (response-code + (http-get uncompressed)))))))))) + (unless (zlib-available?) (test-skip 1)) (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz" -- cgit v1.2.3 From b90ae065b5a5fab4ed475bf2faa3a84476389a02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 31 May 2019 16:26:08 +0200 Subject: substitute: Select the best compression methods. When a server publishes several URLs with different compression methods, 'guix substitute' can now choose the best one among the compression methods that it supports. * guix/scripts/substitute.scm ()[uri]: Replace with... [uris]: ... this. [compression]: Replace with... [compressions]: ... this. [file-size]: Replace with... [file-sizes]: ... this. [file-hash]: Replace with... [file-hashes]: ... this. (narinfo-maker): Adjust accordingly. Ensure 'file-sizes' and 'file-hashes' have the right length. (assert-valid-signature, valid-narinfo?): Use the first element of 'narinfo-uris' in error messages. (read-narinfo): Expect "URL", "Compression", "FileSize", and "FileHash" to occur multiple times. (display-narinfo-data): Call 'select-uri' to determine the file size. (%compression-methods): New variable. (supported-compression?, compresses-better?, select-uri): New procedures. (process-substitution): Call 'select-uri' to select the URI and compression. * guix/scripts/weather.scm (report-server-coverage): Account for all the values returned by 'narinfo-file-sizes'. * tests/substitute.scm ("substitute, narinfo with several URLs"): New test. --- tests/substitute.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 50 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/substitute.scm b/tests/substitute.scm index f4f2e9512d..ff2be662be 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -28,8 +28,10 @@ #:use-module (guix base32) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix ui) #:select (guix-warning-port)) + #:use-module ((guix utils) #:select (call-with-compressed-output-port)) + #:use-module ((guix lzlib) #:select (lzlib-available?)) #:use-module ((guix build utils) - #:select (mkdir-p delete-file-recursively)) + #:select (mkdir-p delete-file-recursively dump-port)) #:use-module (guix tests http) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) @@ -475,6 +477,53 @@ System: mips64el-linux\n") "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")))) +(test-equal "substitute, narinfo with several URLs" + "Substitutable data." + (let ((narinfo (string-append "StorePath: " (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo +URL: example.nar.gz +Compression: gzip +URL: example.nar.lz +Compression: lzip +URL: example.nar +Compression: none +NarHash: sha256:" (bytevector->nix-base32-string + (sha256 (string->utf8 "Substitutable data."))) " +NarSize: 42 +References: bar baz +Deriver: " (%store-prefix) "/foo.drv +System: mips64el-linux\n"))) + (with-narinfo (string-append narinfo "Signature: " + (signature-field narinfo)) + (dynamic-wind + (const #t) + (lambda () + (define (compress input output compression) + (call-with-output-file output + (lambda (port) + (call-with-compressed-output-port compression port + (lambda (port) + (call-with-input-file input + (lambda (input) + (dump-port input port)))))))) + + (let ((nar (string-append %main-substitute-directory + "/example.nar"))) + (compress nar (string-append nar ".gz") 'gzip) + (when (lzlib-available?) + (compress nar (string-append nar ".lz") 'lzip))) + + (parameterize ((substitute-urls + (list (string-append "file://" + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + (test-end "substitute") ;;; Local Variables: -- cgit v1.2.3 From ea35f5c599a2fe4d6ab2925b1030f64e8b21e195 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:16:02 +0200 Subject: tests: Fix hackage tests. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a followup to 1cc12357a65e4479c2f4735e915941382ef82d94. * tests/hackage.scm: ghc-mtl is no longer added as an input. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index e5f3d6caed..269c1e1f9b 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -178,8 +178,7 @@ library ('build-system 'haskell-build-system) ('inputs ('quasiquote - (("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) + (("ghc-http" ('unquote 'ghc-http))))) ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) @@ -225,8 +224,7 @@ library ('inputs ('quasiquote (("ghc-b" ('unquote 'ghc-b)) - ("ghc-http" ('unquote 'ghc-http)) - ("ghc-mtl" ('unquote 'ghc-mtl))))) + ("ghc-http" ('unquote 'ghc-http))))) ('native-inputs ('quasiquote (("ghc-haskell-gi" ('unquote 'ghc-haskell-gi))))) -- cgit v1.2.3 From 64d31813577b7471f819652e3ec81abb285bb77c Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:27:49 +0200 Subject: tests: hackage: Test multiline cabal description. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/hackage.scm (test-cabal-multiline-desc): New variable. ("hackage->guix-package test multiline desc"): New test. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index 269c1e1f9b..2f45194fab 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -236,6 +236,25 @@ library (test-assert "hackage->guix-package test 6" (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) +;; Check multi-line layouted description +(define test-cabal-multiline-desc + "name: foo +version: 1.0.0 +homepage: http://test.org +synopsis: synopsis +description: first line + second line +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +(test-assert "hackage->guix-package test multiline desc" + (eval-test-with-cabal test-cabal-multiline-desc match-ghc-foo)) + + (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) ((("name" ("test-me")) -- cgit v1.2.3 From 959c9d159da2c53b87ae0af1421aecac98b20f46 Mon Sep 17 00:00:00 2001 From: Robert Vollmert Date: Sun, 2 Jun 2019 00:27:50 +0200 Subject: import: hackage: Parse braced properties. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This adds partial support for Cabal properties that use curly braces instead of the layout rule. See for example https://hackage.haskell.org/package/cassava/ * guix/import/cabal.scm (read-braced-value): New procedure. (is-property): Remove. (is-layout-property, is-braced-property): New variables. (lex-property): Rename to... (lex-layout-property): ... this. (lex-braced-property, lex-property): New procedures. (lex-token): Add call to 'lex-property'. * guix/tests/hackage.scm: Test braced description import. * tests/hackage.scm (test-cabal-multiline-desc): Rename to... (test-cabal-multiline-layout): ... this. ("hackage->guix-package test multiline desc"): Rename to... ("hackage->guix-package test multiline desc (layout)"): ... this. (test-cabal-multiline-braced): New variable. ("hackage->guix-package test multiline desc (braced)"): New test. Signed-off-by: Ludovic Courtès --- tests/hackage.scm | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/tests/hackage.scm b/tests/hackage.scm index 2f45194fab..38a5825af7 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -237,7 +237,7 @@ library (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) ;; Check multi-line layouted description -(define test-cabal-multiline-desc +(define test-cabal-multiline-layout "name: foo version: 1.0.0 homepage: http://test.org @@ -251,9 +251,28 @@ executable cabal mtl >= 2.0 && < 3 ") -(test-assert "hackage->guix-package test multiline desc" - (eval-test-with-cabal test-cabal-multiline-desc match-ghc-foo)) +(test-assert "hackage->guix-package test multiline desc (layout)" + (eval-test-with-cabal test-cabal-multiline-layout match-ghc-foo)) +;; Check multi-line braced description +(define test-cabal-multiline-braced + "name: foo +version: 1.0.0 +homepage: http://test.org +synopsis: synopsis +description: { +first line +second line +} +license: BSD3 +executable cabal + build-depends: + HTTP >= 4000.2.5 && < 4000.3, + mtl >= 2.0 && < 3 +") + +(test-assert "hackage->guix-package test multiline desc (braced)" + (eval-test-with-cabal test-cabal-multiline-braced match-ghc-foo)) (test-assert "read-cabal test 1" (match (call-with-input-string test-read-cabal-1 read-cabal) -- cgit v1.2.3 From c0a4db66976dc63decbd612aafb934f44629e321 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 7 Jun 2019 22:49:47 +0200 Subject: import: print: Honor the outputs of inputs (!). Fixes . Reported by Jesse Gibbons . * guix/import/print.scm (package->code)[package-lists->code]: Preserve OUT in the result. * tests/print.scm (define-with-source): New macro. (pkg): Use it. (pkg-source): New variable. (pkg-with-inputs, pkg-with-inputs-source): New variables. ("simple package"): Refer to 'pkg-source'. ("package with inputs"): New test. --- tests/print.scm | 48 +++++++++++++++++++++++++++++++----------------- 1 file changed, 31 insertions(+), 17 deletions(-) (limited to 'tests') diff --git a/tests/print.scm b/tests/print.scm index 305807c1d1..d4b2cca93f 100644 --- a/tests/print.scm +++ b/tests/print.scm @@ -24,9 +24,31 @@ #:use-module (guix licenses) #:use-module (srfi srfi-64)) +(define-syntax-rule (define-with-source object source expr) + (begin + (define object expr) + (define source 'expr))) + (test-begin "print") -(define pkg +(define-with-source pkg pkg-source + (package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + (build-system gnu-build-system) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license gpl3+))) + +(define-with-source pkg-with-inputs pkg-with-inputs-source (package (name "test") (version "1.2.3") @@ -38,27 +60,19 @@ (base32 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) (build-system gnu-build-system) + (inputs `(("coreutils" ,(@ (gnu packages base) coreutils)) + ("glibc" ,(@ (gnu packages base) glibc) "debug"))) (home-page "http://gnu.org") (synopsis "Dummy") (description "This is a dummy package.") (license gpl3+))) (test-equal "simple package" - (package->code pkg) - '(package - (name "test") - (version "1.2.3") - (source (origin - (method url-fetch) - (uri (string-append "file:///tmp/test-" - version ".tar.gz")) - (sha256 - (base32 - "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) - (build-system gnu-build-system) - (home-page "http://gnu.org") - (synopsis "Dummy") - (description "This is a dummy package.") - (license gpl3+))) + pkg-source + (package->code pkg)) + +(test-equal "package with inputs" + pkg-with-inputs-source + (package->code pkg-with-inputs)) (test-end "print") -- cgit v1.2.3 From f8a9f99cd602ce1dc5307cb0c21ae718ad8796bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 10 Jun 2019 22:10:21 +0200 Subject: store: 'build-things' accepts derivation/output pairs. This allows callers to request the substitution of a single derivation output. * guix/store.scm (build-things): Accept derivation/output pairs among THINGS. * guix/derivations.scm (build-derivations): Likewise. * tests/store.scm ("substitute + build-things with specific output"): New test. * tests/derivations.scm ("build-derivations with specific output"): New test. * doc/guix.texi (The Store): Adjust accordingly. --- tests/derivations.scm | 22 ++++++++++++++++++++++ tests/store.scm | 20 ++++++++++++++++++++ 2 files changed, 42 insertions(+) (limited to 'tests') diff --git a/tests/derivations.scm b/tests/derivations.scm index dbb5b584eb..c421d094a4 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -787,6 +787,28 @@ (build-derivations store (list drv)) #f))) +(test-assert "build-derivations with specific output" + (with-store store + (let* ((content (random-text)) ;contents of the output + (drv (build-expression->derivation + store "substitute-me" + `(begin ,content (exit 1)) ;would fail + #:outputs '("out" "one" "two") + #:guile-for-build + (package-derivation store %bootstrap-guile))) + (out (derivation->output-path drv))) + (with-derivation-substitute drv content + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (and (has-substitutes? store out) + + ;; Ask for nothing but the "out" output of DRV. + (build-derivations store `((,drv . "out"))) + + (valid-path? store out) + (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all))) + ))))) + (test-assert "build-expression->derivation and derivation-prerequisites-to-build" (let ((drv (build-expression->derivation %store "fail" #f))) ;; The only direct dependency is (%guile-for-build) and it's already diff --git a/tests/store.scm b/tests/store.scm index df66feaebb..518750d26a 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -599,6 +599,26 @@ (valid-path? s o) (equal? c (call-with-input-file o get-string-all))))))) +(test-assert "substitute + build-things with specific output" + (with-store s + (let* ((c (random-text)) ;contents of the output + (d (build-expression->derivation + s "substitute-me" `(begin ,c (exit 1)) ;would fail + #:outputs '("out" "one" "two") + #:guile-for-build + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-substitute d c + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (and (has-substitutes? s o) + + ;; Ask for nothing but the "out" output of D. + (build-things s `((,(derivation-file-name d) . "out"))) + + (valid-path? s o) + (equal? c (call-with-input-file o get-string-all))))))) + (test-assert "substitute, corrupt output hash" ;; Tweak the substituter into installing a substitute whose hash doesn't ;; match the one announced in the narinfo. The daemon must notice this and -- cgit v1.2.3 From 5a9ef8a960706a55764f5bbc67ac83dd48516016 Mon Sep 17 00:00:00 2001 From: Ivan Petkov Date: Fri, 17 May 2019 00:26:07 -0700 Subject: import: crate: Define dependencies as arguments. * guix/import/crate.scm: (crate-fetch)[input-crates]: Rename to dev-crates. [native-input-crates]: Rename to dev-dep-crates. [inputs]: Rename to cargo-inputs. [native-inputs]: Rename to cargo-development-inputs. (maybe-cargo-inputs, maybe-cargo-development-inputs, maybe-arguments): Add them. (make-crate-sexp)[inputs]: Rename to cargo-inputs. [native-inputs]: Rename to cargo-development-inputs. [maybe-native-inputs, maybe-inputs]: Replace with maybe-arguments. * guix/import/utils.scm: (package-names->package-inputs): Make public. Add docstring. * tests/crate.scm (crate->guix-package): Update the match pattern. Signed-off-by: Chris Marusich --- tests/crate.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/crate.scm b/tests/crate.scm index a1dcfd5e52..a4a328d507 100644 --- a/tests/crate.scm +++ b/tests/crate.scm @@ -89,9 +89,9 @@ ('base32 (? string? hash))))) ('build-system 'cargo-build-system) - ('inputs + ('arguments ('quasiquote - (("rust-bar" ('unquote 'rust-bar) "src")))) + (('#:cargo-inputs (("rust-bar" ('unquote rust-bar))))))) ('home-page "http://example.com") ('synopsis "summary") ('description "summary") -- cgit v1.2.3