;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-pack)
  #:use-module (guix scripts pack)
  #:use-module (guix store)
  #:use-module (guix derivations)
  #:use-module (guix profiles)
  #:use-module (guix monads)
  #:use-module (guix grafts)
  #:use-module (guix tests)
  #:use-module (guix gexp)
  #: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)
  (test-assert name
    (run-with-store %store exp
                    #:guile-for-build (%guile-for-build))))

(define %gzip-compressor
  ;; Compressor that uses the bootstrap 'gzip'.
  ((@ (guix scripts pack) compressor) "gzip"
   "gz"
   #~(#+(file-append %bootstrap-coreutils&co "/bin/gzip") "-6n")))

(define %tar-bootstrap %bootstrap-coreutils&co)


(test-begin "pack")

(unless (network-reachable?) (test-skip 1))
(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))))

(test-end)
/td></tr>
<tr><td><span title='2017-06-02 18:47:06 +0200'>2017-06-02</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=0c152cd6e322e5594ba2028319965e8453489766'>tests: Remove 't-profile-alt-*-link' files.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2017-01-23 22:21:23 +0100'>2017-01-23</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=c5746f239964a72642ac56640b8ff490d5bfa673'>guix package: Honor the order of profiles when -p appears multiple times.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-11-11 00:37:50 +0100'>2015-11-11</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=fc2d2339644b408574f0ead4436e751fa423a7e6'>guix package: '--search-paths' can report combined search paths.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-05-20 12:13:39 +0200'>2015-05-20</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=dbc31ab25c355eae373e1766b4a77fccbe462bf3'>guix package: Add optional argument to --search-paths.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-04-08 10:20:59 +0200'>2015-04-08</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=0b131612d5f0387eb68da4ac49a384c57ca78851'>tests: Skip 'guix-package-net.sh' when prerequisites aren't met.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-04-06 21:52:40 +0200'>2015-04-06</span></td><td><a href='/guix/commit/tests/guix-package-net.sh?id=57b8623754fdd10b2cc194db09772f60010928af'>tests: Move 'guix package' tests that require networking to a separate file.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>