Merge branch 'staging' into core-updates

4 files changed, 209 insertions, 23 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index a0f4634db0..74a3e47da1 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2019, 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -202,7 +203,7 @@ set up using CL source package conventions."
       (define base-arguments
         (if target-is-source?
             (strip-keyword-arguments
-             '(#:tests? #:asd-files #:lisp #:asd-systems #:test-asd-file)
+             '(#:tests? #:lisp #:asd-systems #:asd-test-systems #:asd-operation)
              (package-arguments pkg))
             (package-arguments pkg)))
 
@@ -270,9 +271,9 @@ set up using CL source package conventions."
   (lambda* (name inputs
                  #:key source outputs
                  (tests? #t)
-                 (asd-files ''())
                  (asd-systems ''())
-                 (test-asd-file #f)
+                 (asd-test-systems ''())
+                 (asd-operation "load-system")
                  (phases '%standard-phases)
                  (search-paths '())
                  (system (%current-system))
@@ -292,6 +293,11 @@ set up using CL source package conventions."
             `(quote ,(list package-name)))
           asd-systems))
 
+    (define test-systems
+      (if (null? (cadr asd-test-systems))
+          systems
+          asd-test-systems))
+
     (define builder
       (with-imported-modules imported-modules
         #~(begin
@@ -302,9 +308,9 @@ set up using CL source package conventions."
                            (%lisp-type #$lisp-type))
               (asdf-build #:name #$name
                           #:source #+source
-                          #:asd-files #$asd-files
                           #:asd-systems #$systems
-                          #:test-asd-file #$test-asd-file
+                          #:asd-test-systems #$test-systems
+                          #:asd-operation #$asd-operation
                           #:system #$system
                           #:tests? #$tests?
                           #:phases #$phases
diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm
new file mode 100644
index 0000000000..6ad377f930
--- /dev/null
+++ b/guix/build-system/channel.scm
@@ -0,0 +1,78 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019-2022 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 (guix build-system channel)
+  #:use-module ((guix store) #:select (%store-monad store-lift))
+  #:use-module ((guix gexp) #:select (lower-object))
+  #:use-module (guix monads)
+  #:use-module (guix channels)
+  #:use-module (guix build-system)
+  #:export (channel-build-system))
+
+;;; Commentary:
+;;;
+;;; The "channel" build system lets you build Guix instances from channel
+;;; specifications, similar to how 'guix time-machine' would do it, as regular
+;;; packages.
+;;;
+;;; Code:
+
+(define latest-channel-instances*
+  (store-lift latest-channel-instances))
+
+(define* (build-channels name inputs
+                         #:key source system commit
+                         (authenticate? #t)
+                         #:allow-other-keys)
+  (mlet* %store-monad ((instances
+                        (cond ((channel-instance? source)
+                               (return (list source)))
+                              ((channel? source)
+                               (latest-channel-instances*
+                                (list source)
+                                #:authenticate? authenticate?))
+                              ((string? source)
+                               ;; If SOURCE is a store file name, as is the
+                               ;; case when called from (gnu ci), return it as
+                               ;; is.
+                               (return
+                                (list (checkout->channel-instance
+                                       source #:commit commit))))
+                              (else
+                               (mlet %store-monad ((source
+                                                    (lower-object source)))
+                                 (return
+                                  (list (checkout->channel-instance
+                                         source #:commit commit))))))))
+    (channel-instances->derivation instances)))
+
+(define channel-build-system
+  ;; Build system used to "convert" a channel instance to a package.
+  (let ((lower (lambda* (name #:key system source commit (authenticate? #t)
+                              #:allow-other-keys)
+                 (bag
+                   (name name)
+                   (system system)
+                   (build build-channels)
+                   (arguments `(#:source ,source
+                                #:authenticate? ,authenticate?
+                                #:commit ,commit))))))
+    (build-system (name 'channel)
+                  (description "Turn a channel instance into a package.")
+                  (lower lower))))
+
diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index db0a916fb2..43ec2fdcb6 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,13 +30,17 @@
   #:use-module (ice-9 match)
   #:export (%perl-build-system-modules
             perl-build
+            perl-cross-build
             perl-build-system))
 
 ;; Commentary:
 ;;
 ;; Standard build procedure for Perl packages using the "makefile
 ;; maker"---i.e., "perl Makefile.PL".  This is implemented as an extension of
-;; `gnu-build-system'.
+;; `gnu-build-system'.  Cross-compilation is supported for some simple Perl
+;; packages, but not for any Perl packages that do things like XS (Perl's FFI),
+;; which makes C-style shared libraries, as it is currently not known how to
+;; tell Perl to properly cross-compile.
 ;;
 ;; Code:
 
@@ -59,24 +64,44 @@
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:perl #:inputs #:native-inputs))
+    `(#:perl #:inputs #:native-inputs
+      ,@(if target '() '(#:target))))
 
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
+  (bag
+    (name name)
+    (system system) (target target)
+    (host-inputs `(,@(if source
+                         `(("source" ,source))
+                         '())
+                   ,@inputs
+                   ;; For interpreters in #! (shebang)
+                   ,@(if target
+                         `(("perl" ,perl))
+                         '())
 
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
-         (build-inputs `(("perl" ,perl)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build perl-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+                   ;; Keep the standard inputs of 'gnu-build-system'.
+                   ;; TODO: make this unconditional, putting this into
+                   ;; 'build-inputs'.
+                   ,@(if target
+                         '()
+                         (standard-packages))))
+    (build-inputs `(("perl" ,perl)
+                    ,@native-inputs
+                    ,@(if target
+                          (standard-cross-packages target 'host)
+                          '())
+                    ,@(if target
+                          (standard-packages)
+                          '())))
+    ;; Keep the standard inputs of 'gnu-build-system'.
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs outputs)
+    (build (if target
+               perl-cross-build
+               perl-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (perl-build name inputs
                      #:key source
@@ -127,6 +152,69 @@ provides a `Makefile.PL' file as its build system."
     (gexp->derivation name build
                       #:system system
                       #:target #f
+                      #:graft? #f
+                      #:guile-for-build guile)))
+
+(define* (perl-cross-build name #:key
+                           source
+                           target
+                           build-inputs host-inputs target-inputs
+                           (search-paths '())
+                           (native-search-paths '())
+                           (tests? #f) ; usually not possible when cross-compiling
+                           (parallel-build? #t)
+                           (parallel-tests? #t)
+                           (make-maker? #f)
+                           (make-maker-flags ''())
+                           (module-build-flags ''())
+                           (phases '(@ (guix build perl-build-system)
+                                       %standard-phases))
+                           (outputs '("out"))
+                           (system (%current-system))
+                           (build (nix-system->gnu-triplet system))
+                           (guile #f)
+                           (imported-modules %perl-build-system-modules)
+                           (modules '((guix build perl-build-system)
+                                      (guix build utils))))
+  "Cross-build SOURCE to TARGET using PERL, and with INPUTS.  This assumes
+that SOURCE provides a `Makefile.PL' file as its build system and does not use
+XS or similar."
+  (define inputs
+    #~(append #$(input-tuples->gexp host-inputs)
+              #+(input-tuples->gexp target-inputs)))
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+          (perl-build #:name #$name
+                      #:source #+source
+                      #:search-paths '#$(sexp->gexp
+                                         (map search-path-specification->sexp
+                                              search-paths))
+                      #:native-search-paths
+                      '#$(sexp->gexp
+                          (map search-path-specification->sexp
+                               native-search-paths))
+                      #:make-maker? #$make-maker?
+                      #:make-maker-flags #$make-maker-flags
+                      #:module-build-flags #$(sexp->gexp module-build-flags)
+                      #:phases #$phases
+                      #:build #$build
+                      #:system #$system
+                      #:target #$target
+                      #:test-target "test"
+                      #:tests? #$tests?
+                      #:parallel-build? #$parallel-build?
+                      #:parallel-tests? #$parallel-tests?
+                      #:outputs #$(outputs->gexp outputs)
+                      #:inputs #$inputs
+                      #:native-inputs #+(input-tuples->gexp build-inputs)))))
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:target target
+                      #:graft? #false
                       #:guile-for-build guile)))
 
 (define perl-build-system
diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index a0b968cef3..a9bf728f25 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,11 +68,19 @@
   (let ((module (resolve-interface '(gnu packages cmake))))
     (module-ref module 'cmake-minimal)))
 
+(define (default-qtbase)
+  "Return the default qtbase package."
+
+  ;; Do not use `@' to avoid introducing circular dependencies.
+  (let ((module (resolve-interface '(gnu packages qt))))
+    (module-ref module 'qtbase-5)))
+
 ;; This barely is a copy from (guix build-system cmake), only adjusted to use
 ;; the variables defined here.
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (cmake (default-cmake))
+                (qtbase (default-qtbase))
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
@@ -87,6 +96,7 @@
                           `(("source" ,source))
                           '())
                     ,@`(("cmake" ,cmake))
+                    ,@`(("qtbase" ,qtbase))
                     ,@native-inputs
                     ,@(if target
                           ;; Use the standard cross inputs of
@@ -112,6 +122,7 @@
 
 (define* (qt-build name inputs
                    #:key
+                   (qtbase (default-qtbase))
                    source (guile #f)
                    (outputs '("out")) (configure-flags ''())
                    (search-paths '())
@@ -150,6 +161,7 @@ provides a 'CMakeLists.txt' file as its build system."
                     #:phases #$(if (pair? phases)
                                    (sexp->gexp phases)
                                    phases)
+                    #:qtbase #+qtbase
                     #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
                     #:qt-wrap-excluded-inputs #$qt-wrap-excluded-inputs
                     #:configure-flags #$configure-flags
@@ -181,6 +193,7 @@ provides a 'CMakeLists.txt' file as its build system."
                          #:key
                          source target
                          build-inputs target-inputs host-inputs
+                         (qtbase (default-qtbase))
                          (guile #f)
                          (outputs '("out"))
                          (configure-flags ''())
@@ -237,6 +250,7 @@ build system."
                                               search-path-specification->sexp
                                               native-search-paths)
                     #:phases #$phases
+                    #:qtbase #+qtbase
                     #:configure-flags #$configure-flags
                     #:make-flags #$make-flags
                     #:out-of-source? #$out-of-source?