;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (test-builders)
+(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 build-system python)
#:use-module (guix store)
+ #:use-module (guix monads)
#: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 (guix packages)
#: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-34)
#:use-module (srfi srfi-64))
;; Test the higher-level builders.
(define %store
(open-connection-for-tests))
-(define (%bootstrap-inputs)
- ;; Use the bootstrap inputs so it doesn't take ages to run these tests.
- ;; This still involves building Make, Diffutils, and Findutils.
- ;; XXX: We're relying on the higher-level `package-derivations' here.
- (and %store
- (map (match-lambda
- ((name package)
- (list name (package-derivation %store package))))
- (filter
- (compose package? cadr)
- ((@@ (gnu packages commencement) %boot0-inputs))))))
-
-(define (%bootstrap-search-paths)
- ;; Search path specifications that go with %BOOTSTRAP-INPUTS.
- (append-map (match-lambda
- ((name package _ ...)
- (package-native-search-paths package)))
- (filter
- (compose package? cadr)
- ((@@ (gnu packages commencement) %boot0-inputs)))))
-
(define url-fetch*
(store-lower url-fetch))
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
+
\f
(test-begin "builders")
(test-assert "gnu-build-system"
(build-system? gnu-build-system))
-(when (or (not (network-reachable?)) (shebang-too-long?))
- (test-skip 1))
-(test-assert "gnu-build"
- (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
- (hash (nix-base32-string->bytevector
- "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
- (tarball (url-fetch* %store url 'sha256 hash
- #:guile %bootstrap-guile))
- (build (gnu-build %store "hello-2.8"
- `(("source" ,tarball)
- ,@(%bootstrap-inputs))
- #:guile %bootstrap-guile
- #:search-paths (%bootstrap-search-paths)))
- (out (derivation->output-path build)))
- (and (build-derivations %store (list (pk 'hello-drv build)))
- (valid-path? %store out)
- (file-exists? (string-append out "/bin/hello")))))
+(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)
+
+\f
+;;;
+;;; Test the sanity-check phase of the Python build system.
+;;;
+
+(define* (make-python-dummy name #:key (setup-py-extra "")
+ (init-py "") (use-setuptools? #t))
+ (dummy-package (string-append "python-dummy-" name)
+ (version "0.1")
+ (build-system python-build-system)
+ (arguments
+ `(#:tests? #f
+ #:use-setuptools? ,use-setuptools?
+ #:phases
+ (modify-phases %standard-phases
+ (replace 'unpack
+ (lambda _
+ (mkdir-p "dummy")
+ (with-output-to-file "dummy/__init__.py"
+ (lambda _
+ (display ,init-py)))
+ (with-output-to-file "setup.py"
+ (lambda _
+ (format #t "\
+~a
+setup(
+ name='dummy-~a',
+ version='0.1',
+ packages=['dummy'],
+ ~a
+ )"
+ (if ,use-setuptools?
+ "from setuptools import setup"
+ "from distutils.core import setup")
+ ,name ,setup-py-extra))))))))))
+
+(define python-dummy-ok
+ (make-python-dummy "ok"))
+
+;; distutil won't install any metadata, so make sure our script does not fail
+;; on a otherwise fine package.
+(define python-dummy-no-setuptools
+ (make-python-dummy
+ "no-setuptools" #:use-setuptools? #f))
+
+(define python-dummy-fail-requirements
+ (make-python-dummy "fail-requirements"
+ #:setup-py-extra "install_requires=['nonexistent'],"))
+
+(define python-dummy-fail-import
+ (make-python-dummy "fail-import" #:init-py "import nonexistent"))
+
+(define python-dummy-fail-console-script
+ (make-python-dummy "fail-console-script"
+ #:setup-py-extra (string-append "entry_points={'console_scripts': "
+ "['broken = dummy:nonexistent']},")))
+
+(define (check-build-success store p)
+ (unless store (test-skip 1))
+ (test-assert (string-append "python-build-system: " (package-name p))
+ (let* ((drv (package-derivation store p)))
+ (build-derivations store (list drv)))))
+
+(define (check-build-failure store p)
+ (unless store (test-skip 1))
+ (test-assert (string-append "python-build-system: " (package-name p))
+ (let ((drv (package-derivation store p)))
+ (guard (c ((store-protocol-error? c)
+ (pk 'failure c #t))) ;good!
+ (build-derivations store (list drv))
+ #f)))) ;bad: it should have failed
+
+(with-external-store store
+ (for-each (lambda (p) (check-build-success store p))
+ (list
+ python-dummy-ok
+ python-dummy-no-setuptools))
+ (for-each (lambda (p) (check-build-failure store p))
+ (list
+ python-dummy-fail-requirements
+ python-dummy-fail-import
+ python-dummy-fail-console-script)))
(test-end "builders")
HCoop / jackhill / guix / guix.git / blobdiff