tests: Run 'guix pack' tests using the external store.
Fixes <https://bugs.gnu.org/32184>. * guix/tests.scm (call-with-external-store): New procedure. (with-external-store): New macro. * tests/pack.scm (%store): Remove. (test-assertm): Add 'store' parameter. ("self-contained-tarball"): Wrap in 'with-external-store'. * tests/guix-pack.sh: Connect to the external store, if possible, by setting NIX_STORE_DIR and GUIX_DAEMON_SOCKET. Remove most uses of '--bootstrap'.
This commit is contained in:
		
							parent
							
								
									fbdb7b9526
								
							
						
					
					
						commit
						19c924af4f
					
				
					 4 changed files with 95 additions and 48 deletions
				
			
		|  | @ -45,6 +45,7 @@ | |||
|    (eval . (put 'manifest-pattern 'scheme-indent-function 0)) | ||||
|    (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) | ||||
|    (eval . (put 'with-store 'scheme-indent-function 1)) | ||||
|    (eval . (put 'with-external-store 'scheme-indent-function 1)) | ||||
|    (eval . (put 'with-error-handling 'scheme-indent-function 0)) | ||||
|    (eval . (put 'with-mutex 'scheme-indent-function 1)) | ||||
|    (eval . (put 'with-atomic-file-output 'scheme-indent-function 1)) | ||||
|  |  | |||
|  | @ -1,5 +1,5 @@ | |||
| ;;; GNU Guix --- Functional package management for GNU | ||||
| ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> | ||||
| ;;; | ||||
| ;;; This file is part of GNU Guix. | ||||
| ;;; | ||||
|  | @ -17,6 +17,7 @@ | |||
| ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>. | ||||
| 
 | ||||
| (define-module (guix tests) | ||||
|   #:use-module ((guix config) #:select (%storedir %localstatedir)) | ||||
|   #:use-module (guix store) | ||||
|   #:use-module (guix derivations) | ||||
|   #:use-module (guix packages) | ||||
|  | @ -30,6 +31,7 @@ | |||
|   #:use-module (ice-9 binary-ports) | ||||
|   #:use-module (web uri) | ||||
|   #:export (open-connection-for-tests | ||||
|             with-external-store | ||||
|             random-text | ||||
|             random-bytevector | ||||
|             file=? | ||||
|  | @ -74,6 +76,39 @@ | |||
| 
 | ||||
|       store))) | ||||
| 
 | ||||
| (define (call-with-external-store proc) | ||||
|   "Call PROC with an open connection to the external store or #f it there is | ||||
| no external store to talk to." | ||||
|   (parameterize ((%daemon-socket-uri | ||||
|                   (string-append %localstatedir | ||||
|                                  "/guix/daemon-socket/socket")) | ||||
|                  (%store-prefix %storedir)) | ||||
|     (define store | ||||
|       (catch #t | ||||
|         (lambda () | ||||
|           (open-connection)) | ||||
|         (const #f))) | ||||
| 
 | ||||
|     (dynamic-wind | ||||
|       (const #t) | ||||
|       (lambda () | ||||
|         ;; Since we're using a different store we must clear the | ||||
|         ;; package-derivation cache. | ||||
|         (hash-clear! (@@ (guix packages) %derivation-cache)) | ||||
| 
 | ||||
|         (proc store)) | ||||
|       (lambda () | ||||
|         (when store | ||||
|           (close-connection store)))))) | ||||
| 
 | ||||
| (define-syntax-rule (with-external-store store exp ...) | ||||
|   "Evaluate EXP with STORE bound to the external store rather than the | ||||
| temporary test store, or #f if there is no external store to talk to. | ||||
| 
 | ||||
| This is meant to be used for tests that need to build packages that would be | ||||
| too expensive to build entirely in the test store." | ||||
|   (call-with-external-store (lambda (store) exp ...))) | ||||
| 
 | ||||
| (define (random-seed) | ||||
|   (or (and=> (getenv "GUIX_TESTS_RANDOM_SEED") | ||||
|              number->string) | ||||
|  |  | |||
|  | @ -1,5 +1,6 @@ | |||
| # GNU Guix --- Functional package management for GNU | ||||
| # Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> | ||||
| # Copyright © 2018 Ludovic Courtès <ludo@gnu.org> | ||||
| # | ||||
| # This file is part of GNU Guix. | ||||
| # | ||||
|  | @ -28,26 +29,33 @@ fi | |||
| 
 | ||||
| guix pack --version | ||||
| 
 | ||||
| # FIXME: Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, | ||||
| # '--bootstrap' is mostly ineffective since 'guix pack' produces derivations | ||||
| # that refer to guile-sqlite3 and libgcrypt.  For now we just skip the test. | ||||
| exit 77 | ||||
| # Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, 'guix pack' | ||||
| # produces derivations that refer to guile-sqlite3 and libgcrypt.  To make | ||||
| # that relatively inexpensive, run the test in the user's global store if | ||||
| # possible, on the grounds that binaries may already be there or can be built | ||||
| # or downloaded inexpensively. | ||||
| 
 | ||||
| # Use --no-substitutes because we need to verify we can do this ourselves. | ||||
| GUIX_BUILD_OPTIONS="--no-substitutes" | ||||
| export GUIX_BUILD_OPTIONS | ||||
| NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`" | ||||
| localstatedir="`guile -c '(use-modules (guix config))(display %localstatedir)'`" | ||||
| GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket" | ||||
| export NIX_STORE_DIR GUIX_DAEMON_SOCKET | ||||
| 
 | ||||
| if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))' | ||||
| then | ||||
|     exit 77 | ||||
| fi | ||||
| 
 | ||||
| # Build a tarball with no compression. | ||||
| guix pack --compression=none --bootstrap guile-bootstrap | ||||
| guix pack --compression=none guile-bootstrap | ||||
| 
 | ||||
| # Build a tarball (with compression).  Check that '-e' works as well. | ||||
| out1="`guix pack --bootstrap guile-bootstrap`" | ||||
| out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`" | ||||
| out1="`guix pack guile-bootstrap`" | ||||
| out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`" | ||||
| test -n "$out1" | ||||
| test "$out1" = "$out2" | ||||
| 
 | ||||
| # Build a tarball with a symlink. | ||||
| the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`" | ||||
| the_pack="`guix pack -S /opt/gnu/bin=bin guile-bootstrap`" | ||||
| 
 | ||||
| # Try to extract it.  Note: we cannot test whether /opt/gnu/bin/guile itself | ||||
| # exists because /opt/gnu/bin may be an absolute symlink to a store item that | ||||
|  |  | |||
|  | @ -29,15 +29,12 @@ | |||
|   #:use-module (gnu packages bootstrap) | ||||
|   #:use-module (srfi srfi-64)) | ||||
| 
 | ||||
| (define %store | ||||
|   (open-connection-for-tests)) | ||||
| 
 | ||||
| ;; Globally disable grafts because they can trigger early builds. | ||||
| (%graft? #f) | ||||
| 
 | ||||
| (define-syntax-rule (test-assertm name exp) | ||||
| (define-syntax-rule (test-assertm name store exp) | ||||
|   (test-assert name | ||||
|     (run-with-store %store exp | ||||
|     (run-with-store store exp | ||||
|                     #:guile-for-build (%guile-for-build)))) | ||||
| 
 | ||||
| (define %gzip-compressor | ||||
|  | @ -51,37 +48,43 @@ | |||
|  | ||||
| (test-begin "pack") | ||||
| 
 | ||||
| ;; FIXME: The following test would rebuild the world (and likely fail) as a | ||||
| ;; consequence of commit c45477d2a1a651485feede20fe0f3d15aec48b39 (and related | ||||
| ;; changes) that made guile-sqlite3 a dependency of the derivation. | ||||
| ;; See <https://bugs.gnu.org/32184>. | ||||
| (test-skip 1) | ||||
| ;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of | ||||
| ;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes.  Thus, | ||||
| ;; run it on the user's store, if it's available, on the grounds that these | ||||
| ;; dependencies may be already there, or we can get substitutes or build them | ||||
| ;; quite inexpensively; see <https://bugs.gnu.org/32184>. | ||||
| 
 | ||||
| (test-assertm "self-contained-tarball" | ||||
|   (mlet* %store-monad | ||||
|       ((profile (profile-derivation (packages->manifest | ||||
|                                      (list %bootstrap-guile)) | ||||
|                                     #:hooks '() | ||||
|                                     #:locales? #f)) | ||||
|        (tarball (self-contained-tarball "pack" profile | ||||
|                                         #:symlinks '(("/bin/Guile" | ||||
|                                                       -> "bin/guile")) | ||||
|                                         #:compressor %gzip-compressor | ||||
|                                         #:archiver %tar-bootstrap)) | ||||
|        (check   (gexp->derivation | ||||
|                  "check-tarball" | ||||
|                  #~(let ((bin (string-append "." #$profile "/bin"))) | ||||
|                      (setenv "PATH" | ||||
|                              (string-append #$%tar-bootstrap "/bin")) | ||||
|                      (system* "tar" "xvf" #$tarball) | ||||
|                      (mkdir #$output) | ||||
|                      (exit | ||||
|                       (and (file-exists? (string-append bin "/guile")) | ||||
|                            (string=? (string-append #$%bootstrap-guile "/bin") | ||||
|                                      (readlink bin)) | ||||
|                            (string=? (string-append ".." #$profile | ||||
|                                                     "/bin/guile") | ||||
|                                      (readlink "bin/Guile")))))))) | ||||
|     (built-derivations (list check)))) | ||||
| (with-external-store store | ||||
|   (unless store (tests-skip 1)) | ||||
|   (test-assertm "self-contained-tarball" store | ||||
|     (mlet* %store-monad | ||||
|         ((profile (profile-derivation (packages->manifest | ||||
|                                        (list %bootstrap-guile)) | ||||
|                                       #:hooks '() | ||||
|                                       #:locales? #f)) | ||||
|          (tarball (self-contained-tarball "pack" profile | ||||
|                                           #:symlinks '(("/bin/Guile" | ||||
|                                                         -> "bin/guile")) | ||||
|                                           #:compressor %gzip-compressor | ||||
|                                           #:archiver %tar-bootstrap)) | ||||
|          (check   (gexp->derivation | ||||
|                    "check-tarball" | ||||
|                    #~(let ((bin (string-append "." #$profile "/bin"))) | ||||
|                        (setenv "PATH" | ||||
|                                (string-append #$%tar-bootstrap "/bin")) | ||||
|                        (system* "tar" "xvf" #$tarball) | ||||
|                        (mkdir #$output) | ||||
|                        (exit | ||||
|                         (and (file-exists? (string-append bin "/guile")) | ||||
|                              (string=? (string-append #$%bootstrap-guile "/bin") | ||||
|                                        (readlink bin)) | ||||
|                              (string=? (string-append ".." #$profile | ||||
|                                                       "/bin/guile") | ||||
|                                        (readlink "bin/Guile")))))))) | ||||
|       (built-derivations (list check))))) | ||||
| 
 | ||||
| (test-end) | ||||
| 
 | ||||
| ;; Local Variables: | ||||
| ;; eval: (put 'test-assertm 'scheme-indent-function 2) | ||||
| ;; End: | ||||
|  |  | |||
		Reference in a new issue