Message ID | 20230307171833.4170067-1-zimon.toutoune@gmail.com |
---|---|
State | New |
Headers | show |
Series | [bug#62036] guix: packages: Consider 'patches' by 'package-direct-sources'. | expand |
Hi Simon, Simon Tournier <zimon.toutoune@gmail.com> writes: > (define (package-direct-sources package) > "Return all source origins associated with PACKAGE; including origins in > -PACKAGE's inputs." > - `(,@(or (and=> (package-source package) list) '()) > +PACKAGE's inputs and patches." > + (define (expand source) > + (append > + (list source) > + (filter origin? (origin-patches source)))) * cough * (cons source (filter ...)) * cough * Other than that, LGTM! Tests worked fine on my end. No idea what this is used for though :p Best,
Hi Josselin, On jeu., 09 mars 2023 at 20:43, Josselin Poiret via Guix-patches via <guix-patches@gnu.org> wrote: >> + (append >> + (list source) >> + (filter origin? (origin-patches source)))) > > * cough * (cons source (filter ...)) * cough * Ahah! Somehow I removed from my mental toolbox cons, car and cdr because I am spending too much time explaining to non-lispers. :-) Thanks for showing me the light. ;-) > Other than that, LGTM! Tests worked fine on my end. No idea what this > is used for though :p For instance, it can be used to list all the ’origin’ of a package. Consider the package ’tensorflow’, it reads, --8<---------------cut here---------------start------------->8--- (native-inputs [...] ;; The commit hashes and URLs for third-party source code are taken ;; from "tensorflow/workspace.bzl". ("boringssl-src" ,(let ((commit "ee7aa02") (revision "1")) (origin (method git-fetch) (uri (git-reference (url "https://boringssl.googlesource.com/boringssl") --8<---------------cut here---------------end--------------->8--- where some inputs are not packages but just ’origin’. Therefore, the procedure allows to get all the ’origin’, the one from the field ’origin’ and also the ones from inputs. --8<---------------cut here---------------start------------->8--- scheme@(guix-user)> ,use(gnu packages machine-learning) scheme@(guix-user)> ,pp (map origin-uri (package-direct-sources tensorflow)) $1 = (#<<git-reference> url: "https://github.com/tensorflow/tensorflow" commit: "v1.9.0" recursive?: #f> #<<git-reference> url: "https://boringssl.googlesource.com/boringssl" commit: "ee7aa02" recursive?: #f> [...] --8<---------------cut here---------------end--------------->8--- For some packages as ’ntp’, the patches are also a list of ’origin’, --8<---------------cut here---------------start------------->8--- (origin (method url-fetch) (uri (list (string-append "https://www.eecis.udel.edu/~ntp/ntp_spool/ntp4/ntp-" [...] ;; Add an upstream patch to fix build with GCC 10. Taken from ;; <https://bugs.ntp.org/show_bug.cgi?id=3688>. (patches (list (origin (method url-fetch) (uri "https://bugs.ntp.org/attachment.cgi?id=1760&action=diff&context=patch&collapsed=&headers=1&format=raw") [...] --8<---------------cut here---------------end--------------->8--- and the patch allows to also extract them: --8<---------------cut here---------------start------------->8--- scheme@(guix-user)> ,use(gnu packages ntp) scheme@(guix-user)> ,pp (map origin-uri (package-direct-sources ntp)) $2 = (("https://www.eecis.udel.edu/~ntp/ntp_spool/ntp4/ntp-4.2/ntp-4.2.8p15.tar.gz" "http://archive.ntp.org/ntp4/ntp-4.2/ntp-4.2.8p15.tar.gz") "https://bugs.ntp.org/attachment.cgi?id=1760&action=diff&context=patch&collapsed=&headers=1&format=raw" "https://bugs.ntp.org/attachment.cgi?id=1814&action=diff&collapsed=&headers=1&format=raw") --8<---------------cut here---------------end--------------->8--- This way it improves the coverage with Software Heritage. All the source code (origin) is extracted and feed some SWH loader. The code is there: https://git.savannah.gnu.org/cgit/guix/maintenance.git/tree/hydra/build-package-metadata.scm#n58 Cheers, simon
Hi Simon, Simon Tournier <zimon.toutoune@gmail.com> writes: > This way it improves the coverage with Software Heritage. All the > source code (origin) is extracted and feed some SWH loader. The code is > there: > > https://git.savannah.gnu.org/cgit/guix/maintenance.git/tree/hydra/build-package-metadata.scm#n58 Ahh, that's the part I was missing. Great work! Best,
diff --git a/guix/packages.scm b/guix/packages.scm index 041a872f9d..0f88564ab4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -9,6 +9,7 @@ ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2022 jgart <jgart@dismail.de> +;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -1239,8 +1240,13 @@ (define-syntax modify-inputs (define (package-direct-sources package) "Return all source origins associated with PACKAGE; including origins in -PACKAGE's inputs." - `(,@(or (and=> (package-source package) list) '()) +PACKAGE's inputs and patches." + (define (expand source) + (append + (list source) + (filter origin? (origin-patches source)))) + + `(,@(or (and=> (package-source package) expand) '()) ,@(filter-map (match-lambda ((_ (? origin? orig) _ ...) orig) diff --git a/tests/packages.scm b/tests/packages.scm index f58c47817b..27fb918f90 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -418,12 +419,15 @@ (define read-at (let* ((o (dummy-origin)) (u (dummy-origin)) (i (dummy-origin)) + (j (dummy-origin (patches (list o)))) (a (dummy-package "a")) (b (dummy-package "b" (inputs (list a i)))) (c (package (inherit b) (source o))) (d (dummy-package "d" (build-system trivial-build-system) - (source u) (inputs (list c))))) + (source u) (inputs (list c)))) + (e (dummy-package "e" (source j))) + (f (package (inherit e) (inputs (list u))))) (test-assert "package-direct-sources, no source" (null? (package-direct-sources a))) (test-equal "package-direct-sources, #f source" @@ -437,6 +441,17 @@ (define read-at (and (= (length (pk 's-sources s)) 2) (member o s) (member i s)))) + (test-assert "package-direct-sources, with patches" + (let ((s (package-direct-sources e))) + (and (= (length (pk 's-sources s)) 2) + (member o s) + (member j s)))) + (test-assert "package-direct-sources, with patches and inputs" + (let ((s (package-direct-sources f))) + (and (= (length (pk 's-sources s)) 3) + (member o s) + (member j s) + (member u s)))) (test-assert "package-transitive-sources" (let ((s (package-transitive-sources d))) (and (= (length (pk 'd-sources s)) 3)