gtk and wayland update

[jackhill/guix/guix.git] / tests / builders.scm

diff --git a/tests/builders.scm b/tests/builders.scm
index fdcf38d..0b5577c 100644 (file)
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2019 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.
 ;;;
@@ -17,22 +18,27 @@
 ;;; 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.
@@ -43,6 +49,9 @@
 (define url-fetch*
   (store-lower url-fetch))
 
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
+
 \f
 (test-begin "builders")
 
@@ -78,4 +87,116 @@
 (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)
+
+\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")