From 1f466ed6be932526fc69e72ffd50390691d0d382 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 19 Jul 2022 23:04:25 -0400 Subject: build: qt: Add qtbase argument and wrap Qt environment variables exactly. * guix/build-system/qt.scm (default-qtbase): New variable. (lower) <#:qtbase>: Add argument... [build-inputs]: ... and propagate it here. (qt-build): Add qtbase argument. (qt-cross-build): Likewise. * guix/build/qt-utils.scm (%default-qt-major-version): New variable. (variables-for-wrapping): Add qt-major-version argument, and use it to format the various path prefixes. Wrap QT environment variables exactly. (wrap-qt-program*): Add qt-major-version argument, and pass it to variables-for-wrapping. (wrap-qt-program): Add qt-major-version argument, and pass it to wrap-qt-program*. (wrap-all-qt-programs): Add qtbase argument, and extract the major version from it, passing it to wrap-qt-program*. --- guix/build-system/qt.scm | 14 ++++++++++++++ 1 file changed, 14 insertions(+) (limited to 'guix/build-system') diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm index a0b968cef3..bd47ade3fc 100644 --- a/guix/build-system/qt.scm +++ b/guix/build-system/qt.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2019 Hartmut Goebel ;;; Copyright © 2020 Jakub Kądziołka +;;; Copyright © 2022 Maxim Cournoyer ;;; ;;; 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 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 (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? -- cgit v1.2.3 From 4905b5b83904366d068bde899aae15288cc1adcb Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Mon, 1 Aug 2022 11:58:39 -0400 Subject: build-system: qt: Ensure a default value is provided for #:qtbase. * guix/build-system/qt.scm (qt-build)[qtbase]: Specify a default value. Lower it using ungexp-native. (qt-cross-build): Likewise. Reported-by: Maxime Devos and others. --- guix/build-system/qt.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'guix/build-system') diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm index bd47ade3fc..a9bf728f25 100644 --- a/guix/build-system/qt.scm +++ b/guix/build-system/qt.scm @@ -122,7 +122,7 @@ (define* (qt-build name inputs #:key - qtbase + (qtbase (default-qtbase)) source (guile #f) (outputs '("out")) (configure-flags ''()) (search-paths '()) @@ -161,7 +161,7 @@ provides a 'CMakeLists.txt' file as its build system." #:phases #$(if (pair? phases) (sexp->gexp phases) phases) - #:qtbase #$qtbase + #:qtbase #+qtbase #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs #:qt-wrap-excluded-inputs #$qt-wrap-excluded-inputs #:configure-flags #$configure-flags @@ -193,7 +193,7 @@ provides a 'CMakeLists.txt' file as its build system." #:key source target build-inputs target-inputs host-inputs - qtbase + (qtbase (default-qtbase)) (guile #f) (outputs '("out")) (configure-flags ''()) @@ -250,7 +250,7 @@ build system." search-path-specification->sexp native-search-paths) #:phases #$phases - #:qtbase #$qtbase + #:qtbase #+qtbase #:configure-flags #$configure-flags #:make-flags #$make-flags #:out-of-source? #$out-of-source? -- cgit v1.2.3 From 6181f1f26310146ae509af2074c55f87e8f21a96 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Fri, 1 Jul 2022 17:17:32 +0200 Subject: build-system: asdf: Let ASDF locate the .asd files. This approach has many benefits: - It simplifies the build system. - The package definitions are easier to write. - It fixes a bug with systems that call asdf:clear-system which would cause the load to fail. See for instance test systems using Prove. * guix/build-system/asdf.scm (package-with-build-system): Remove 'asd-files' and replace 'test-asd-file' by 'asd-test-systems'. (lower): Same. * guix/build/asdf-build-system.scm (source-asd-file): Remove since ASDF does it better than us. (find-asd-files): Same. (build): Remove unused asd-files argument. (check): Remove asd-files argument and replace asd-systems by asd-test-systems. * guix/build/lisp-utils.scm (compile-systems): Call to ASDF to find the systems. (test-system): Same. Signed-off-by: Guillaume Le Vaillant --- guix/build-system/asdf.scm | 14 +++++++++----- guix/build/asdf-build-system.scm | 29 +++++++---------------------- guix/build/lisp-utils.scm | 35 +++++++++++++++-------------------- 3 files changed, 31 insertions(+), 47 deletions(-) (limited to 'guix/build-system') diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index a0f4634db0..46b0742f6e 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016, 2017 Andy Patterson ;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant ;;; Copyright © 2021 Ludovic Courtès +;;; Copyright © 2022 Pierre Neidhardt ;;; ;;; 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) (package-arguments pkg)) (package-arguments pkg))) @@ -270,9 +271,8 @@ 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 ''()) (phases '%standard-phases) (search-paths '()) (system (%current-system)) @@ -292,6 +292,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 +307,8 @@ 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 #:system #$system #:tests? #$tests? #:phases #$phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 6186613e52..0a3c55c6c4 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson ;;; Copyright © 2020, 2021 Guillaume Le Vaillant +;;; Copyright © 2022 Pierre Neidhardt ;;; ;;; This file is part of GNU Guix. ;;; @@ -78,16 +79,6 @@ (,(library-directory object-output) :**/ :*.*.*))) -(define (source-asd-file output name asd-file) - (string-append (lisp-source-directory output name) "/" asd-file)) - -(define (find-asd-files output name asd-files) - (if (null? asd-files) - (find-files (lisp-source-directory output name) "\\.asd$") - (map (lambda (asd-file) - (source-asd-file output name asd-file)) - asd-files))) - (define (copy-files-to-output out name) "Copy all files from the current directory to OUT. Create an extra link to any system-defining files in the source to a convenient location. This is @@ -190,7 +181,7 @@ if it's present in the native-inputs." (setenv "XDG_CONFIG_DIRS" (string-append out "/etc"))) #t) -(define* (build #:key outputs inputs asd-files asd-systems +(define* (build #:key outputs inputs asd-systems #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) @@ -198,26 +189,20 @@ if it's present in the native-inputs." (source-path (string-append out (%lisp-source-install-prefix))) (translations (wrap-output-translations `(,(output-translation source-path - out)))) - (asd-files (find-asd-files out system-name asd-files))) + out))))) (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (compile-systems asd-systems asd-files)) + (compile-systems asd-systems (lisp-source-directory out system-name))) #t) -(define* (check #:key tests? outputs inputs asd-files asd-systems - test-asd-file +(define* (check #:key tests? outputs inputs asd-test-systems #:allow-other-keys) "Test the system." (let* ((out (library-output outputs)) - (system-name (main-system-name out)) - (asd-files (find-asd-files out system-name asd-files)) - (test-asd-file - (and=> test-asd-file - (cut source-asd-file out system-name <>)))) + (system-name (main-system-name out))) (if tests? - (test-system (first asd-systems) asd-files test-asd-file) + (test-system asd-test-systems (lisp-source-directory out system-name)) (format #t "test suite not run~%"))) #t) diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 8403c94cb5..7c5d865338 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -108,38 +108,33 @@ with PROGRAM." "--eval" "(quit)")) (_ (error "The LISP provided is not supported at this time.")))) -(define (compile-systems systems asd-files) +(define (compile-systems systems directory) "Use a lisp implementation to compile the SYSTEMS using asdf. Load ASD-FILES first." (lisp-eval-program `((require :asdf) - ,@(map (lambda (asd-file) - `(asdf:load-asd (truename ,asd-file))) - asd-files) + (asdf:initialize-source-registry + (list :source-registry (list :tree (uiop:ensure-pathname ,directory + :truenamize t + :ensure-directory t)) + :inherit-configuration)) ,@(map (lambda (system) `(asdf:load-system ,system)) systems)))) -(define (test-system system asd-files test-asd-file) +(define (test-system test-systems directory) "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILES first. Also load TEST-ASD-FILE if necessary." (lisp-eval-program `((require :asdf) - ,@(map (lambda (asd-file) - `(asdf:load-asd (truename ,asd-file))) - asd-files) - ,@(if test-asd-file - `((asdf:load-asd (truename ,test-asd-file))) - ;; Try some likely files. - (map (lambda (file) - `(when (uiop:file-exists-p ,file) - (asdf:load-asd (truename ,file)))) - (list - (string-append system "-tests.asd") - (string-append system "-test.asd") - "tests.asd" - "test.asd"))) - (asdf:test-system ,system)))) + (asdf:initialize-source-registry + (list :source-registry (list :tree (uiop:ensure-pathname ,directory + :truenamize t + :ensure-directory t)) + :inherit-configuration)) + ,@(map (lambda (system) + `(asdf:test-system ,system)) + test-systems)))) (define (string->lisp-keyword . strings) "Return a lisp keyword for the concatenation of STRINGS." -- cgit v1.2.3 From c232375340354f5f137b7495a85ed1df1e0f74c5 Mon Sep 17 00:00:00 2001 From: Guillaume Le Vaillant Date: Wed, 3 Aug 2022 11:46:17 +0200 Subject: build-system: asdf: Add asd-operation parameter. The 'asd-operation' parameter can be used to specify the ASDF operation to use in the build phase. It's default value is "load-system". * guix/build-system/asdf.scm (package-with-build-system, asdf-build): Add 'asd-operation' parameter. * guix/build/asdf-buid-system.scm (build): Add 'asd-operation' parameter and use it. * guix/build/lisp-utils.scm (compile-systems): Add 'asd-operation' parameter and use it. --- guix/build-system/asdf.scm | 6 ++++-- guix/build/asdf-build-system.scm | 8 +++++--- guix/build/lisp-utils.scm | 12 +++++------- 3 files changed, 14 insertions(+), 12 deletions(-) (limited to 'guix/build-system') diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 46b0742f6e..74a3e47da1 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson -;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant +;;; Copyright © 2019, 2020, 2021, 2022 Guillaume Le Vaillant ;;; Copyright © 2021 Ludovic Courtès ;;; Copyright © 2022 Pierre Neidhardt ;;; @@ -203,7 +203,7 @@ set up using CL source package conventions." (define base-arguments (if target-is-source? (strip-keyword-arguments - '(#:tests? #:lisp #:asd-systems #:asd-test-systems) + '(#:tests? #:lisp #:asd-systems #:asd-test-systems #:asd-operation) (package-arguments pkg)) (package-arguments pkg))) @@ -273,6 +273,7 @@ set up using CL source package conventions." (tests? #t) (asd-systems ''()) (asd-test-systems ''()) + (asd-operation "load-system") (phases '%standard-phases) (search-paths '()) (system (%current-system)) @@ -309,6 +310,7 @@ set up using CL source package conventions." #:source #+source #:asd-systems #$systems #:asd-test-systems #$test-systems + #:asd-operation #$asd-operation #:system #$system #:tests? #$tests? #:phases #$phases diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm index 0a3c55c6c4..92154e7d34 100644 --- a/guix/build/asdf-build-system.scm +++ b/guix/build/asdf-build-system.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson -;;; Copyright © 2020, 2021 Guillaume Le Vaillant +;;; Copyright © 2020, 2021, 2022 Guillaume Le Vaillant ;;; Copyright © 2022 Pierre Neidhardt ;;; ;;; This file is part of GNU Guix. @@ -181,7 +181,7 @@ if it's present in the native-inputs." (setenv "XDG_CONFIG_DIRS" (string-append out "/etc"))) #t) -(define* (build #:key outputs inputs asd-systems +(define* (build #:key outputs inputs asd-systems asd-operation #:allow-other-keys) "Compile the system." (let* ((out (library-output outputs)) @@ -193,7 +193,9 @@ if it's present in the native-inputs." (setenv "ASDF_OUTPUT_TRANSLATIONS" (replace-escaped-macros (format #f "~S" translations))) (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache - (compile-systems asd-systems (lisp-source-directory out system-name))) + (compile-systems asd-systems + (lisp-source-directory out system-name) + asd-operation)) #t) (define* (check #:key tests? outputs inputs asd-test-systems diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm index 7c5d865338..646d4a3365 100644 --- a/guix/build/lisp-utils.scm +++ b/guix/build/lisp-utils.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017 Andy Patterson -;;; Copyright © 2020 Guillaume Le Vaillant +;;; Copyright © 2020, 2022 Guillaume Le Vaillant ;;; Copyright © 2022 Pierre Neidhardt ;;; ;;; This file is part of GNU Guix. @@ -108,9 +108,8 @@ with PROGRAM." "--eval" "(quit)")) (_ (error "The LISP provided is not supported at this time.")))) -(define (compile-systems systems directory) - "Use a lisp implementation to compile the SYSTEMS using asdf. -Load ASD-FILES first." +(define (compile-systems systems directory operation) + "Use a lisp implementation to compile the SYSTEMS using asdf." (lisp-eval-program `((require :asdf) (asdf:initialize-source-registry @@ -119,12 +118,11 @@ Load ASD-FILES first." :ensure-directory t)) :inherit-configuration)) ,@(map (lambda (system) - `(asdf:load-system ,system)) + (list (string->symbol (string-append "asdf:" operation)) system)) systems)))) (define (test-system test-systems directory) - "Use a lisp implementation to test SYSTEM using asdf. Load ASD-FILES first. -Also load TEST-ASD-FILE if necessary." + "Use a lisp implementation to test the TEST-SYSTEMS using asdf." (lisp-eval-program `((require :asdf) (asdf:initialize-source-registry -- cgit v1.2.3 From 74fbbb1661bfcb49591daadcf06a66a4fd6d2c45 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 2 Aug 2022 14:13:26 +0200 Subject: build-system/perl: Support cross-compilation of some Perl packages. * guix/build-system/perl.scm: Add info on cross-compilation. (lower)[private-keywords]: Remove #:target when cross-compiling. (lower)[target]: Set. (host-inputs)[perl]: New entry. (host-inputs)[(standard-packages)]: Move to ... (build-inputs)[(standard-packages)]: ... here when cross-compiling. (build-inputs)[standard-cross-packages]: Add when cross-compiling. (target-inputs): New entry when cross-compiling. (build): Use perl-cross-build when cross-compiling. (perl-cross-build): New procedure. Signed-off-by: Mathieu Othacehe --- guix/build-system/perl.scm | 122 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 105 insertions(+), 17 deletions(-) (limited to 'guix/build-system') 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 +;;; Copyright © 2022 Maxime Devos ;;; ;;; 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 -- cgit v1.2.3 From 5bce4c82422de6beb3ce6120ba1592be898c2b72 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 5 Aug 2022 17:09:10 +0200 Subject: build-system: Add 'channel-build-system'. * gnu/ci.scm (channel-build-system, channel-source->package): Remove. * gnu/packages/package-management.scm (channel-source->package): New procedure, moved from (gnu ci). * guix/build-system/channel.scm: New file, with code moved from (gnu ci). * doc/guix.texi (Build Systems): Document it. --- Makefile.am | 1 + doc/guix.texi | 9 ++++++ etc/system-tests.scm | 3 +- gnu/ci.scm | 42 ++------------------------- gnu/packages/package-management.scm | 16 ++++++++++ guix/build-system/channel.scm | 58 +++++++++++++++++++++++++++++++++++++ 6 files changed, 87 insertions(+), 42 deletions(-) create mode 100644 guix/build-system/channel.scm (limited to 'guix/build-system') diff --git a/Makefile.am b/Makefile.am index f7c42e8153..f707b930b2 100644 --- a/Makefile.am +++ b/Makefile.am @@ -142,6 +142,7 @@ MODULES = \ guix/build-system/android-ndk.scm \ guix/build-system/ant.scm \ guix/build-system/cargo.scm \ + guix/build-system/channel.scm \ guix/build-system/chicken.scm \ guix/build-system/clojure.scm \ guix/build-system/cmake.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 9a6a5c307d..5dab9cf169 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9568,6 +9568,15 @@ with @code{build-expression->derivation} (@pxref{Derivations, @code{build-expression->derivation}}). @end defvr +@defvr {Scheme Variable} channel-build-system +This variable is exported by @code{(guix build-system channel)}. + +This build system is meant primarily for internal use. It requires two +arguments, @code{#:commit} and @code{#:source}, and builds a Guix +instance from that channel, in the same way @command{guix time-machine} +would do it (@pxref{Channels}). +@end defvr + @node Build Phases @section Build Phases diff --git a/etc/system-tests.scm b/etc/system-tests.scm index cd22b7e6d3..221a63bb7f 100644 --- a/etc/system-tests.scm +++ b/etc/system-tests.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2016, 2018-2020, 2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +20,6 @@ (gnu packages package-management) (guix monads) (guix store) - ((gnu ci) #:select (channel-source->package)) ((guix git-download) #:select (git-predicate)) ((guix utils) #:select (current-source-directory)) (git) diff --git a/gnu/ci.scm b/gnu/ci.scm index 9389b43824..9cc3a1a81f 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -21,9 +21,9 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu ci) - #:use-module (guix channels) + #:use-module (guix build-system channel) #:use-module (guix config) - #:use-module (guix describe) + #:autoload (guix describe) (package-channels) #:use-module (guix store) #:use-module (guix grafts) #:use-module (guix profiles) @@ -32,7 +32,6 @@ #:use-module (guix channels) #:use-module (guix config) #:use-module (guix derivations) - #:use-module (guix build-system) #:use-module (guix monads) #:use-module (guix gexp) #:use-module (guix ui) @@ -71,7 +70,6 @@ image->job %core-packages - channel-source->package arguments->systems cuirass-jobs)) @@ -288,42 +286,6 @@ otherwise use the IMAGE name." '())) '())) -(define channel-build-system - ;; Build system used to "convert" a channel instance to a package. - (let* ((build (lambda* (name inputs - #:key source commit system - #:allow-other-keys) - (mlet* %store-monad ((source (if (string? source) - (return source) - (lower-object source))) - (instance - -> (checkout->channel-instance - source #:commit commit))) - (channel-instances->derivation (list instance))))) - (lower (lambda* (name #:key system source commit - #:allow-other-keys) - (bag - (name name) - (system system) - (build build) - (arguments `(#:source ,source - #:commit ,commit)))))) - (build-system (name 'channel) - (description "Turn a channel instance into a package.") - (lower lower)))) - -(define* (channel-source->package source #:key commit) - "Return a package for the given channel SOURCE, a lowerable object." - (package - (inherit guix) - (version (string-append (package-version guix) "+")) - (build-system channel-build-system) - (arguments `(#:source ,source - #:commit ,commit)) - (inputs '()) - (native-inputs '()) - (propagated-inputs '()))) - (define* (system-test-jobs store system #:key source commit) "Return a list of jobs for the system tests." diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm index c22c9f7a43..b9cd74eb27 100644 --- a/gnu/packages/package-management.scm +++ b/gnu/packages/package-management.scm @@ -110,6 +110,7 @@ #:use-module (gnu packages xml) #:use-module (gnu packages xorg) #:use-module (gnu packages version-control) + #:autoload (guix build-system channel) (channel-build-system) #:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system gnu) #:use-module (guix build-system guile) @@ -489,6 +490,21 @@ the Nix package manager.") (license license:gpl3+) (properties '((ftp-server . "alpha.gnu.org")))))) +(define* (channel-source->package source #:key commit) + "Return a package for the given channel SOURCE, a lowerable object." + (package + (inherit guix) + (version (string-append (package-version guix) "." + (if commit (string-take commit 7) ""))) + (build-system channel-build-system) + (arguments `(#:source ,source + #:commit ,commit)) + (inputs '()) + (native-inputs '()) + (propagated-inputs '()))) + +(export channel-source->package) + (define-public guix-for-cuirass ;; Known-good revision before commit ;; bd86bbd300474204878e927f6cd3f0defa1662a5, which introduced diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm new file mode 100644 index 0000000000..227eb08373 --- /dev/null +++ b/guix/build-system/channel.scm @@ -0,0 +1,58 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019-2021 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix build-system channel) + #:use-module ((guix store) #:select (%store-monad)) + #: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 channel-build-system + ;; Build system used to "convert" a channel instance to a package. + (let* ((build (lambda* (name inputs + #:key source commit system + #:allow-other-keys) + (mlet* %store-monad ((source (if (string? source) + (return source) + (lower-object source))) + (instance + -> (checkout->channel-instance + source #:commit commit))) + (channel-instances->derivation (list instance))))) + (lower (lambda* (name #:key system source commit + #:allow-other-keys) + (bag + (name name) + (system system) + (build build) + (arguments `(#:source ,source + #:commit ,commit)))))) + (build-system (name 'channel) + (description "Turn a channel instance into a package.") + (lower lower)))) + -- cgit v1.2.3 From cf60a0a906440ccb007bae1243c3e0397c3a0aba Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 8 Aug 2022 23:06:11 +0200 Subject: build-system/channel: Accept a channel or instance as the source. * guix/build-system/channel.scm (latest-channel-instances*): New variable. (build-channels): New procedure, with code formerly in 'channel-build-system', augmented with clauses for when SOURCE is a channel instance or a channel. * doc/guix.texi (Build Systems): Adjust accordingly. --- doc/guix.texi | 12 ++++++---- guix/build-system/channel.scm | 53 +++++++++++++++++++++++++++---------------- 2 files changed, 41 insertions(+), 24 deletions(-) (limited to 'guix/build-system') diff --git a/doc/guix.texi b/doc/guix.texi index 5dab9cf169..306c7b635b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9571,10 +9571,14 @@ with @code{build-expression->derivation} (@pxref{Derivations, @defvr {Scheme Variable} channel-build-system This variable is exported by @code{(guix build-system channel)}. -This build system is meant primarily for internal use. It requires two -arguments, @code{#:commit} and @code{#:source}, and builds a Guix -instance from that channel, in the same way @command{guix time-machine} -would do it (@pxref{Channels}). +This build system is meant primarily for internal use. A package using +this build system must have a channel specification as its @code{source} +field (@pxref{Channels}); alternatively, its source can be a directory +name, in which case an additional @code{#:commit} argument must be +supplied to specify the commit being built (a hexadecimal string). + +The resulting package is a Guix instance of the given channel, similar +to how @command{guix time-machine} would build it. @end defvr @node Build Phases diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm index 227eb08373..b6ef3bfacf 100644 --- a/guix/build-system/channel.scm +++ b/guix/build-system/channel.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019-2021 Ludovic Courtès +;;; Copyright © 2019-2022 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,7 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (guix build-system channel) - #:use-module ((guix store) #:select (%store-monad)) + #:use-module ((guix store) #:select (%store-monad store-lift)) #:use-module ((guix gexp) #:select (lower-object)) #:use-module (guix monads) #:use-module (guix channels) @@ -32,26 +32,39 @@ ;;; ;;; 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?)) + (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* ((build (lambda* (name inputs - #:key source commit system - #:allow-other-keys) - (mlet* %store-monad ((source (if (string? source) - (return source) - (lower-object source))) - (instance - -> (checkout->channel-instance - source #:commit commit))) - (channel-instances->derivation (list instance))))) - (lower (lambda* (name #:key system source commit - #:allow-other-keys) - (bag - (name name) - (system system) - (build build) - (arguments `(#:source ,source - #:commit ,commit)))))) + (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)))) -- cgit v1.2.3 From a81706494753ad84754cbb7583ccc783452decc0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 11 Aug 2022 15:55:38 +0200 Subject: build-system/channel: Correctly handle store file name from (gnu ci). This is a followup to cf60a0a906440ccb007bae1243c3e0397c3a0aba. Reported by Mathieu Othacehe . * guix/build-system/channel.scm (build-channels): Add 'string?' case. --- guix/build-system/channel.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix/build-system') diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm index b6ef3bfacf..6ad377f930 100644 --- a/guix/build-system/channel.scm +++ b/guix/build-system/channel.scm @@ -46,6 +46,13 @@ (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))) -- cgit v1.2.3