cfcead2e51
Before this change, only plain directories, tar or zip archives were supported as the source of a package for the GNU build system; anything else would cause the unpack phase to fail. Origins relying on snippets would suffer from the same problem. This change adds the support to use files of the following extensions: .gz, .Z, .bz2, .lz, and .xz, even when they are not tarballs. Files of unknown extensions are treated as uncompressed files and supported as well. * guix/packages.scm (patch-and-repack): Only add the compressor utility to the PATH when the file is compressed. Bind more inputs in the mlet, and use them for decompressing single files. Adjust the decompression and compression routines. [decompression-type]: Remove nested variable. * guix/build/utils.scm (compressor, tarball?): New procedures. Move %xz-parallel-args to the new 'compression helpers' section. * tests/packages.scm: Add tests. Add missing copyright year for Jan. * guix/build/gnu-build-system.scm (first-subdirectory): Return #f when no sub-directory was found. (unpack): Support more file types, including uncompressed plain files.
115 lines
4 KiB
Scheme
115 lines
4 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2012, 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
|
||
;;;
|
||
;;; This file is part of GNU Guix.
|
||
;;;
|
||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||
;;; under the terms of the GNU General Public License as published by
|
||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||
;;; your option) any later version.
|
||
;;;
|
||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;;; GNU General Public License for more details.
|
||
;;;
|
||
;;; You should have received a copy of the GNU General Public License
|
||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
|
||
(define-module (tests builders)
|
||
#:use-module (guix download)
|
||
#:use-module (guix build-system)
|
||
#:use-module (guix build-system gnu)
|
||
#:use-module (guix build gnu-build-system)
|
||
#:use-module (guix build utils)
|
||
#:use-module (guix store)
|
||
#:use-module (guix utils)
|
||
#:use-module (guix base32)
|
||
#:use-module (guix derivations)
|
||
#:use-module (gcrypt hash)
|
||
#:use-module (guix tests)
|
||
#:use-module ((guix packages)
|
||
#:select (package?
|
||
package-derivation package-native-search-paths))
|
||
#:use-module (gnu packages bootstrap)
|
||
#:use-module (ice-9 match)
|
||
#:use-module (ice-9 textual-ports)
|
||
#:use-module (srfi srfi-1)
|
||
#:use-module (srfi srfi-11)
|
||
#:use-module (srfi srfi-64))
|
||
|
||
;; Test the higher-level builders.
|
||
|
||
(define %store
|
||
(open-connection-for-tests))
|
||
|
||
(define url-fetch*
|
||
(store-lower url-fetch))
|
||
|
||
|
||
(test-begin "builders")
|
||
|
||
(unless (network-reachable?) (test-skip 1))
|
||
(test-assert "url-fetch"
|
||
(let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"
|
||
"ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
|
||
(hash (nix-base32-string->bytevector
|
||
"0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
|
||
(drv (url-fetch* %store url 'sha256 hash
|
||
#:guile %bootstrap-guile))
|
||
(out-path (derivation->output-path drv)))
|
||
(and (build-derivations %store (list drv))
|
||
(file-exists? out-path)
|
||
(valid-path? %store out-path))))
|
||
|
||
(test-assert "url-fetch, file"
|
||
(let* ((file (search-path %load-path "guix.scm"))
|
||
(hash (call-with-input-file file port-sha256))
|
||
(out (url-fetch* %store file 'sha256 hash)))
|
||
(and (file-exists? out)
|
||
(valid-path? %store out))))
|
||
|
||
(test-assert "url-fetch, file URI"
|
||
(let* ((file (search-path %load-path "guix.scm"))
|
||
(hash (call-with-input-file file port-sha256))
|
||
(out (url-fetch* %store
|
||
(string-append "file://" (canonicalize-path file))
|
||
'sha256 hash)))
|
||
(and (file-exists? out)
|
||
(valid-path? %store out))))
|
||
|
||
(test-assert "gnu-build-system"
|
||
(build-system? gnu-build-system))
|
||
|
||
(define unpack (assoc-ref %standard-phases 'unpack))
|
||
|
||
(define compressors '(("gzip" . "gz")
|
||
("xz" . "xz")
|
||
("bzip2" . "bz2")
|
||
(#f . #f)))
|
||
|
||
(for-each
|
||
(match-lambda
|
||
((comp . ext)
|
||
|
||
(unless (network-reachable?) (test-skip 1)) ;for bootstrap binaries
|
||
(test-equal (string-append "gnu-build-system unpack phase, "
|
||
"single file (compression: "
|
||
(if comp comp "None") ")")
|
||
"expected text"
|
||
(let*-values
|
||
(((name) "test")
|
||
((compressed-name) (if ext
|
||
(string-append name "." ext)
|
||
name))
|
||
((file hash) (test-file %store compressed-name "expected text")))
|
||
(call-with-temporary-directory
|
||
(lambda (dir)
|
||
(with-directory-excursion dir
|
||
(unpack #:source file)
|
||
(call-with-input-file name get-string-all))))))))
|
||
compressors)
|
||
|
||
(test-end "builders")
|