From b20cd80ff1f3c9eb988a0cc27ed9538b68914608 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Oct 2021 22:14:40 +0200 Subject: import: pypi: Allow imports of a specific version. * guix/import/pypi.scm (latest-version): New procedure. (latest-source-release): Rename to... (source-release): ... this. Add 'version' parameter. (latest-wheel-release): Rename to... (wheel-release): ... this. Add 'version' parameter. (pypi->guix-package): Honor 'version' parameter. (pypi-recursive-import): Add 'version' parameter and honor it. * guix/scripts/import/pypi.scm (guix-import-pypi): Expect a spec. Pass it to 'package-name->name+version'. Pass the 'version' parameter. * tests/pypi.scm ("pypi->guix-package, no wheel"): Exercise the #:version parameter. * doc/guix.texi (Invoking guix import): Document it. --- guix/import/pypi.scm | 47 +++++++++++++++++++++++--------------------- guix/scripts/import/pypi.scm | 32 ++++++++++++++++-------------- 2 files changed, 42 insertions(+), 37 deletions(-) (limited to 'guix') diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index f908136481..418a3556ec 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -128,27 +128,30 @@ missing-source-error? (package missing-source-error-package)) -(define (latest-source-release pypi-package) - "Return the latest source release for PYPI-PACKAGE." - (let ((releases (assoc-ref (pypi-project-releases pypi-package) - (project-info-version - (pypi-project-info pypi-package))))) +(define (latest-version project) + "Return the latest version of PROJECT, a record." + (project-info-version (pypi-project-info project))) + +(define* (source-release pypi-package + #:optional (version (latest-version pypi-package))) + "Return the source release of VERSION for PYPI-PACKAGE, a +record, by default the latest version." + (let ((releases (or (assoc-ref (pypi-project-releases pypi-package) version) + '()))) (or (find (lambda (release) (string=? "sdist" (distribution-package-type release))) releases) (raise (condition (&missing-source-error (package pypi-package))))))) -(define (latest-wheel-release pypi-package) +(define* (wheel-release pypi-package + #:optional (version (latest-version pypi-package))) "Return the url of the wheel for the latest release of pypi-package, or #f if there isn't any." - (let ((releases (assoc-ref (pypi-project-releases pypi-package) - (project-info-version - (pypi-project-info pypi-package))))) - (or (find (lambda (release) - (string=? "bdist_wheel" (distribution-package-type release))) - releases) - #f))) + (let ((releases (assoc-ref (pypi-project-releases pypi-package) version))) + (find (lambda (release) + (string=? "bdist_wheel" (distribution-package-type release))) + releases))) (define (python->package-name name) "Given the NAME of a package on PyPI, return a Guix-compliant name for the @@ -484,18 +487,17 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the `package' s-expression corresponding to that package, or #f on failure." (let* ((project (pypi-fetch package-name)) - (info (and project (pypi-project-info project)))) + (info (and=> project pypi-project-info)) + (version (or version (and=> project latest-version)))) (and project (guard (c ((missing-source-error? c) (let ((package (missing-source-error-package c))) (leave (G_ "no source release for pypi package ~a ~a~%") - (project-info-name info) - (project-info-version info))))) - (make-pypi-sexp (project-info-name info) - (project-info-version info) - (and=> (latest-source-release project) + (project-info-name info) version)))) + (make-pypi-sexp (project-info-name info) version + (and=> (source-release project version) distribution-url) - (and=> (latest-wheel-release project) + (and=> (wheel-release project version) distribution-url) (project-info-home-page info) (project-info-summary info) @@ -503,8 +505,9 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (string->license (project-info-license info))))))))) -(define (pypi-recursive-import package-name) +(define* (pypi-recursive-import package-name #:optional version) (recursive-import package-name + #:version version #:repo->guix-package pypi->guix-package #:guix-name python->package-name)) @@ -538,7 +541,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (let* ((info (pypi-project-info pypi-package)) (version (project-info-version info)) (url (distribution-url - (latest-source-release pypi-package)))) + (source-release pypi-package)))) (upstream-source (urls (list url)) (input-changes diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 9170a0b359..a52cd95c93 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-pypi)) @@ -83,21 +84,22 @@ Import and convert the PyPI package for PACKAGE-NAME.\n")) (_ #f)) (reverse opts)))) (match args - ((package-name) - (if (assoc-ref opts 'recursive) - ;; Recursive import - (map (match-lambda - ((and ('package ('name name) . rest) pkg) - `(define-public ,(string->symbol name) - ,pkg)) - (_ #f)) - (pypi-recursive-import package-name)) - ;; Single import - (let ((sexp (pypi->guix-package package-name))) - (unless sexp - (leave (G_ "failed to download meta-data for package '~a'~%") - package-name)) - sexp))) + ((spec) + (let ((name version (package-name->name+version spec))) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (pypi-recursive-import name version)) + ;; Single import + (let ((sexp (pypi->guix-package name #:version version))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + name)) + sexp)))) (() (leave (G_ "too few arguments~%"))) ((many ...) -- cgit v1.2.3 From 450e1dd52e0a34bb00fcb655956e40d69d50a331 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Oct 2021 21:26:16 +0200 Subject: import: cran: Allow imports of a specific version. * guix/import/cran.scm (download): Handle the case where URL is a list. (fetch-description-from-tarball): New procedure. (fetch-description): Add #:version parameter. Honor it when REPOSITORY is 'cran. Use 'fetch-description-from-tarball' when REPOSITORY is 'bioconductor. (description->package): SOURCE-URL may now be a list. (cran->guix-package): Pass VERSION to 'fetch-description'. (cran-recursive-import): Add #:version parameter. * guix/scripts/import/cran.scm (guix-import-cran): Expect a spec rather than a mere package name. * doc/guix.texi (Invoking guix import): Document it. --- doc/guix.texi | 6 +++ guix/import/cran.scm | 91 ++++++++++++++++++++++++++++---------------- guix/scripts/import/cran.scm | 35 +++++++++-------- 3 files changed, 84 insertions(+), 48 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index c748a572ea..29a6665540 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11833,6 +11833,12 @@ The command command below imports metadata for the Cairo R package: guix import cran Cairo @end example +You can also ask for a specific version: + +@example +guix import cran rasterVis@@0.50.3 +@end example + When @option{--recursive} is added, the importer will traverse the dependency graph of the given upstream package recursively and generate package expressions for all those packages that are not yet in Guix. diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 07a5656cf1..7478866515 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -229,26 +229,61 @@ bioconductor package NAME, or #F if the package is unknown." (let ((store-directory (add-to-store store (basename url) #t "sha256" dir))) (values store-directory changeset))))))) - (else (download-to-store store url))))))) - -(define (fetch-description repository name) + (else + (match url + ((? string?) + (download-to-store store url)) + ((urls ...) + ;; Try all the URLs. A use case where this is useful is when one + ;; of the URLs is the /Archive CRAN URL. + (any (cut download-to-store store <>) urls))))))))) + +(define (fetch-description-from-tarball url) + "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and +return the resulting alist." + (match (download url) + (#f #f) + (tarball + (call-with-temporary-directory + (lambda (dir) + (parameterize ((current-error-port (%make-void-port "rw+")) + (current-output-port (%make-void-port "rw+"))) + (and (zero? (system* "tar" "--wildcards" "-x" + "--strip-components=1" + "-C" dir + "-f" tarball "*/DESCRIPTION")) + (description->alist + (call-with-input-file (string-append dir "/DESCRIPTION") + read-string))))))))) + +(define* (fetch-description repository name #:optional version) "Return an alist of the contents of the DESCRIPTION file for the R package -NAME in the given REPOSITORY, or #f in case of failure. NAME is +NAME at VERSION in the given REPOSITORY, or #f in case of failure. NAME is case-sensitive." (case repository ((cran) - (let ((url (string-append %cran-url name "/DESCRIPTION"))) - (guard (c ((http-get-error? c) - (warning (G_ "failed to retrieve package information \ + (guard (c ((http-get-error? c) + (warning (G_ "failed to retrieve package information \ from ~a: ~a (~a)~%") - (uri->string (http-get-error-uri c)) - (http-get-error-code c) - (http-get-error-reason c)) - #f)) - (let* ((port (http-fetch url)) - (result (description->alist (read-string port)))) - (close-port port) - result)))) + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c)) + #f)) + ;; When VERSION is true, we have to download the tarball to get at its + ;; 'DESCRIPTION' file; only the latest one is directly accessible over + ;; HTTP. + (if version + (let ((urls (list (string-append "mirror://cran/src/contrib/" + name "_" version ".tar.gz") + (string-append "mirror://cran/src/contrib/Archive/" + name "/" + name "_" version ".tar.gz")))) + (fetch-description-from-tarball urls)) + (let* ((url (string-append %cran-url name "/DESCRIPTION")) + (port (http-fetch url)) + (result (description->alist (read-string port)))) + (close-port port) + result)))) ((bioconductor) ;; Currently, the bioconductor project does not offer a way to access a ;; package's DESCRIPTION file over HTTP, so we determine the version, @@ -257,22 +292,13 @@ from ~a: ~a (~a)~%") (and (latest-bioconductor-package-version name) #t) (and (latest-bioconductor-package-version name 'annotation) 'annotation) (and (latest-bioconductor-package-version name 'experiment) 'experiment))) + ;; TODO: Honor VERSION. (version (latest-bioconductor-package-version name type)) (url (car (bioconductor-uri name version type))) - (tarball (download url))) - (call-with-temporary-directory - (lambda (dir) - (parameterize ((current-error-port (%make-void-port "rw+")) - (current-output-port (%make-void-port "rw+"))) - (and (zero? (system* "tar" "--wildcards" "-x" - "--strip-components=1" - "-C" dir - "-f" tarball "*/DESCRIPTION")) - (and=> (description->alist (with-input-from-file - (string-append dir "/DESCRIPTION") read-string)) - (lambda (meta) - (if (boolean? type) meta - (cons `(bioconductor-type . ,type) meta)))))))))) + (meta (fetch-description-from-tarball url))) + (if (boolean? type) + meta + (cons `(bioconductor-type . ,type) meta)))) ((git) (and (string-prefix? "http" name) ;; Download the git repository at "NAME" @@ -485,7 +511,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." ((bioconductor) (list (assoc-ref meta 'bioconductor-type))) (else '()))) - ((url rest ...) url) + ((urls ...) urls) ((? string? url) url) (_ #f))))) (git? (assoc-ref meta 'git)) @@ -592,7 +618,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (lambda* (package-name #:key (repo 'cran) version) "Fetch the metadata for PACKAGE-NAME from REPO and return the `package' s-expression corresponding to that package, or #f on failure." - (let ((description (fetch-description repo package-name))) + (let ((description (fetch-description repo package-name version))) (if description (description->package repo description) (case repo @@ -610,8 +636,9 @@ s-expression corresponding to that package, or #f on failure." (&message (message "couldn't find meta-data for R package"))))))))))) -(define* (cran-recursive-import package-name #:key (repo 'cran)) +(define* (cran-recursive-import package-name #:key (repo 'cran) version) (recursive-import package-name + #:version version #:repo repo #:repo->guix-package cran->guix-package #:guix-name cran-guix-name)) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index 3e4b038cc4..2934d4300a 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -27,8 +27,8 @@ #:use-module (guix import utils) #:use-module (guix scripts import) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-cran)) @@ -98,21 +98,24 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) (reverse opts)))) (parameterize ((%input-style (assoc-ref opts 'style))) (match args - ((package-name) - (if (assoc-ref opts 'recursive) - ;; Recursive import - (with-error-handling - (map package->definition - (filter identity - (cran-recursive-import package-name - #:repo (or (assoc-ref opts 'repo) 'cran))))) - ;; Single import - (let ((sexp (cran->guix-package package-name - #:repo (or (assoc-ref opts 'repo) 'cran)))) - (unless sexp - (leave (G_ "failed to download description for package '~a'~%") - package-name)) - sexp))) + ((spec) + (let ((name version (package-name->name+version spec))) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (with-error-handling + (map package->definition + (filter identity + (cran-recursive-import name + #:version version + #:repo (or (assoc-ref opts 'repo) 'cran))))) + ;; Single import + (let ((sexp (cran->guix-package name + #:version version + #:repo (or (assoc-ref opts 'repo) 'cran)))) + (unless sexp + (leave (G_ "failed to download description for package '~a'~%") + name)) + sexp)))) (() (leave (G_ "too few arguments~%"))) ((many ...) -- cgit v1.2.3 From 04d929570ad816793d7e0024a11314124ce87f98 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Oct 2021 21:51:39 +0200 Subject: import: print: Properly render packages with origins as inputs. * guix/import/print.scm (package->code)[source->code]: Check whether VERSION is true before calling 'factorize-uri'. [package-lists->code]: Add clause for inputs that are origins. * tests/print.scm (pkg-with-origin-input, pkg-with-origin-input-source): New variables. ("package with origin input"): New test. --- guix/import/print.scm | 14 +++++++++----- tests/print.scm | 28 ++++++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/import/print.scm b/guix/import/print.scm index 0310739b3a..8acf5d52f6 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -89,9 +89,11 @@ when evaluated." (guix hg-download) (guix svn-download))) (procedure-name method))) - (uri (string-append ,@(match (factorize-uri uri version) - ((? string? uri) (list uri)) - (factorized factorized)))) + (uri ,(if version + `(string-append ,@(match (factorize-uri uri version) + ((? string? uri) (list uri)) + (factorized factorized))) + uri)) ,(if (equal? (content-hash-algorithm hash) 'sha256) `(sha256 (base32 ,(bytevector->nix-base32-string (content-hash-value hash)))) @@ -109,7 +111,7 @@ when evaluated." (map (match-lambda ((? symbol? s) (list (symbol->string s) (list 'unquote s))) - ((label pkg . out) + ((label (? package? pkg) . out) (let ((mod (package-module-name pkg))) (cons* label ;; FIXME: using '@ certainly isn't pretty, but it @@ -117,7 +119,9 @@ when evaluated." ;; modules. (list 'unquote (list '@ mod (variable-name pkg mod))) - out)))) + out))) + ((label (? origin? origin)) + (list label (list 'unquote (source->code origin #f))))) lsts))) (let ((name (package-name package)) diff --git a/tests/print.scm b/tests/print.scm index 3386590d3a..ad19f4573a 100644 --- a/tests/print.scm +++ b/tests/print.scm @@ -67,6 +67,30 @@ (description "This is a dummy package.") (license license:gpl3+))) +(define-with-source pkg-with-origin-input pkg-with-origin-input-source + (package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + (build-system (@ (guix build-system gnu) gnu-build-system)) + (inputs + `(("o" ,(origin + (method url-fetch) + (uri "http://example.org/somefile.txt") + (sha256 + (base32 + "0000000000000000000000000000000000000000000000000000")))))) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license license:gpl3+))) + (test-equal "simple package" `(define-public test ,pkg-source) (package->code pkg)) @@ -75,4 +99,8 @@ `(define-public test ,pkg-with-inputs-source) (package->code pkg-with-inputs)) +(test-equal "package with origin input" + `(define-public test ,pkg-with-origin-input-source) + (package->code pkg-with-origin-input)) + (test-end "print") -- cgit v1.2.3 From b3240ae846cb1ace2322a68eca3497f11d0be6f1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Oct 2021 22:23:21 +0200 Subject: import: print: Correctly handle URI lists. * guix/import/print.scm (package->code)[factorized-uri-code]: New procedure. [source->code]: Use it, and factorize URI when it's a list. * tests/print.scm (pkg-with-origin-input): Check origin URI to a list. --- guix/import/print.scm | 15 ++++++++++++--- tests/print.scm | 6 ++++-- 2 files changed, 16 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/import/print.scm b/guix/import/print.scm index 8acf5d52f6..4e65d18bc3 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -25,6 +25,7 @@ #:use-module (guix build-system) #:use-module (gnu packages) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (guix import utils) #:use-module (ice-9 control) #:use-module (ice-9 match) @@ -72,6 +73,11 @@ when evaluated." (file-type (quote ,(search-path-specification-file-type spec))) (file-pattern ,(search-path-specification-file-pattern spec)))) + (define (factorized-uri-code uri version) + (match (factorize-uri uri version) + ((? string? uri) uri) + ((factorized ...) `(string-append ,@factorized)))) + (define (source->code source version) (let ((uri (origin-uri source)) (method (origin-method source)) @@ -90,9 +96,12 @@ when evaluated." (guix svn-download))) (procedure-name method))) (uri ,(if version - `(string-append ,@(match (factorize-uri uri version) - ((? string? uri) (list uri)) - (factorized factorized))) + (match uri + ((? string? uri) + (factorized-uri-code uri version)) + ((lst ...) + `(list + ,@(map (cut factorized-uri-code <> version) uri)))) uri)) ,(if (equal? (content-hash-algorithm hash) 'sha256) `(sha256 (base32 ,(bytevector->nix-base32-string diff --git a/tests/print.scm b/tests/print.scm index ad19f4573a..7f4c8ccdd1 100644 --- a/tests/print.scm +++ b/tests/print.scm @@ -73,8 +73,10 @@ (version "1.2.3") (source (origin (method url-fetch) - (uri (string-append "file:///tmp/test-" - version ".tar.gz")) + (uri (list (string-append "file:///tmp/test-" + version ".tar.gz") + (string-append "http://example.org/test-" + version ".tar.gz"))) (sha256 (base32 "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) -- cgit v1.2.3 From b2ed40c29f578d46d42cb1c5e99bd797cea3aba0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 29 Oct 2021 22:29:05 +0200 Subject: import: print: Handle patches that are origins. * guix/import/print.scm (package->code)[source->code]: Handle patches that are origins. * tests/print.scm (pkg-with-origin-input): Add 'patches' field. (pkg-with-origin-patch, pkg-with-origin-patch-source): New variables. ("package with origin patch"): New test. --- guix/import/print.scm | 13 +++++++++++-- tests/print.scm | 33 ++++++++++++++++++++++++++++++++- 2 files changed, 43 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/import/print.scm b/guix/import/print.scm index 4e65d18bc3..e04a6647b4 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -112,8 +112,17 @@ when evaluated." ;; FIXME: in order to be able to throw away the directory prefix, ;; we just assume that the patch files can be found with ;; "search-patches". - ,@(if (null? patches) '() - `((patches (search-patches ,@(map basename patches)))))))) + ,@(cond ((null? patches) + '()) + ((every string? patches) + `((patches (search-patches ,@(map basename patches))))) + (else + `((patches (list ,@(map (match-lambda + ((? string? file) + `(search-patch ,file)) + ((? origin? origin) + (source->code origin #f))) + patches))))))))) (define (package-lists->code lsts) (list 'quasiquote diff --git a/tests/print.scm b/tests/print.scm index 7f4c8ccdd1..ff0db469ab 100644 --- a/tests/print.scm +++ b/tests/print.scm @@ -22,6 +22,7 @@ #:use-module (guix download) #:use-module (guix packages) #:use-module ((guix licenses) #:prefix license:) + #:use-module ((gnu packages) #:select (search-patches)) #:use-module (srfi srfi-64)) (define-syntax-rule (define-with-source object source expr) @@ -79,7 +80,9 @@ version ".tar.gz"))) (sha256 (base32 - "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")) + (patches (search-patches "guile-linux-syscalls.patch" + "guile-relocatable.patch")))) (build-system (@ (guix build-system gnu) gnu-build-system)) (inputs `(("o" ,(origin @@ -93,6 +96,30 @@ (description "This is a dummy package.") (license license:gpl3+))) +(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source + (package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")) + (patches + (list (origin + (method url-fetch) + (uri "http://example.org/x.patch") + (sha256 + (base32 + "0000000000000000000000000000000000000000000000000000"))))))) + (build-system (@ (guix build-system gnu) gnu-build-system)) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license license:gpl3+))) + (test-equal "simple package" `(define-public test ,pkg-source) (package->code pkg)) @@ -105,4 +132,8 @@ `(define-public test ,pkg-with-origin-input-source) (package->code pkg-with-origin-input)) +(test-equal "package with origin patch" + `(define-public test ,pkg-with-origin-patch-source) + (package->code pkg-with-origin-patch)) + (test-end "print") -- cgit v1.2.3 From 3756ce32674139376bcf11dac96bc562582088f7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 11 Nov 2021 00:10:44 +0100 Subject: import: print: Replace packages and origins in 'arguments'. * guix/import/print.scm (package->code)[variable-reference] [object->code]: New procedures. [package-lists->code]: Rewrite in terms of 'object->code'. Pass the 'arguments' field through 'object->code'. * tests/print.scm (pkg-with-arguments, pkg-with-arguments-source): New variables. ("package with arguments"): New test. --- guix/import/print.scm | 50 ++++++++++++++++++++++++++++++-------------------- tests/print.scm | 23 +++++++++++++++++++++++ 2 files changed, 53 insertions(+), 20 deletions(-) (limited to 'guix') diff --git a/guix/import/print.scm b/guix/import/print.scm index e04a6647b4..767b0528d5 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2020 Ricardo Wurmus +;;; Copyright © 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,9 +32,6 @@ #:use-module (ice-9 match) #:export (package->code)) -;; FIXME: the quasiquoted arguments field may contain embedded package -;; objects, e.g. in #:disallowed-references; they will just be printed with -;; their usual # representation, not as variable names. (define (package->code package) "Return an S-expression representing the source code that produces PACKAGE when evaluated." @@ -124,23 +122,34 @@ when evaluated." (source->code origin #f))) patches))))))))) + (define (variable-reference module name) + ;; FIXME: using '@ certainly isn't pretty, but it avoids having to import + ;; the individual package modules. + (list '@ module name)) + + (define (object->code obj quoted?) + (match obj + ((? package? package) + (let* ((module (package-module-name package)) + (name (variable-name package module))) + (if quoted? + (list 'unquote (variable-reference module name)) + (variable-reference module name)))) + ((? origin? origin) + (let ((code (source->code origin #f))) + (if quoted? + (list 'unquote code) + code))) + ((lst ...) + (let ((lst (map (cut object->code <> #t) lst))) + (if quoted? + lst + (list 'quasiquote lst)))) + (obj + obj))) + (define (package-lists->code lsts) - (list 'quasiquote - (map (match-lambda - ((? symbol? s) - (list (symbol->string s) (list 'unquote s))) - ((label (? package? pkg) . out) - (let ((mod (package-module-name pkg))) - (cons* label - ;; FIXME: using '@ certainly isn't pretty, but it - ;; avoids having to import the individual package - ;; modules. - (list 'unquote - (list '@ mod (variable-name pkg mod))) - out))) - ((label (? origin? origin)) - (list label (list 'unquote (source->code origin #f))))) - lsts))) + (list 'quasiquote (object->code lsts #t))) (let ((name (package-name package)) (version (package-version package)) @@ -176,7 +185,8 @@ when evaluated." '-build-system))) ,@(match arguments (() '()) - (args `((arguments ,(list 'quasiquote args))))) + (_ `((arguments + ,(list 'quasiquote (object->code arguments #t)))))) ,@(match outputs (("out") '()) (outs `((outputs (list ,@outs))))) diff --git a/tests/print.scm b/tests/print.scm index ff0db469ab..1527251b01 100644 --- a/tests/print.scm +++ b/tests/print.scm @@ -120,6 +120,25 @@ (description "This is a dummy package.") (license license:gpl3+))) +(define-with-source pkg-with-arguments pkg-with-arguments-source + (package + (name "test") + (version "1.2.3") + (source (origin + (method url-fetch) + (uri (string-append "file:///tmp/test-" + version ".tar.gz")) + (sha256 + (base32 + "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) + (build-system (@ (guix build-system gnu) gnu-build-system)) + (arguments + `(#:disallowed-references (,(@ (gnu packages base) coreutils)))) + (home-page "http://gnu.org") + (synopsis "Dummy") + (description "This is a dummy package.") + (license license:gpl3+))) + (test-equal "simple package" `(define-public test ,pkg-source) (package->code pkg)) @@ -136,4 +155,8 @@ `(define-public test ,pkg-with-origin-patch-source) (package->code pkg-with-origin-patch)) +(test-equal "package with arguments" + `(define-public test ,pkg-with-arguments-source) + (package->code pkg-with-arguments)) + (test-end "print") -- cgit v1.2.3 From 0c21ec1c7915bdc08c68c66eba411cf533d4e503 Mon Sep 17 00:00:00 2001 From: Attila Lendvai Date: Tue, 2 Nov 2021 11:57:29 +0100 Subject: import: utils: Add more licenses and extend their detection. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/utils.scm (spdx-string->license): Identify more licenses (CC-BY-4.0, Freetype, HPND). * guix/licenses.scm: Add a comment that mentions "MIT" so that people who grep for MIT end up there. Signed-off-by: Ludovic Courtès --- guix/import/utils.scm | 3 +++ guix/licenses.scm | 2 ++ 2 files changed, 5 insertions(+) (limited to 'guix') diff --git a/guix/import/utils.scm b/guix/import/utils.scm index a180742ca3..dc89386ddb 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -152,6 +152,7 @@ of the string VERSION is replaced by the symbol 'version." ("CC0-1.0" 'license:cc0) ("CC-BY-2.0" 'license:cc-by2.0) ("CC-BY-3.0" 'license:cc-by3.0) + ("CC-BY-4.0" 'license:cc-by4.0) ("CC-BY-SA-2.0" 'license:cc-by-sa2.0) ("CC-BY-SA-3.0" 'license:cc-by-sa3.0) ("CC-BY-SA-4.0" 'license:cc-by-sa4.0) @@ -163,6 +164,7 @@ of the string VERSION is replaced by the symbol 'version." ("EPL-1.0" 'license:epl1.0) ("MIT" 'license:expat) ("FTL" 'license:freetype) + ("Freetype" 'license:freetype) ("GFDL-1.1" 'license:fdl1.1+) ("GFDL-1.2" 'license:fdl1.2+) ("GFDL-1.3" 'license:fdl1.3+) @@ -179,6 +181,7 @@ of the string VERSION is replaced by the symbol 'version." ("GPL-3.0-only" 'license:gpl3) ("GPL-3.0+" 'license:gpl3+) ("GPL-3.0-or-later" 'license:gpl3+) + ("HPND" 'license:hpnd) ("ISC" 'license:isc) ("IJG" 'license:ijg) ("Imlib2" 'license:imlib2) diff --git a/guix/licenses.scm b/guix/licenses.scm index c071aae4a9..82ca44f42e 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -308,6 +308,8 @@ at URI, which may be a file:// URI pointing the package's tree." "https://directory.fsf.org/wiki/License:EUPL-1.2" "https://www.gnu.org/licenses/license-list#EUPL-1.2")) +;; Some people call it the MIT license. For clarification see: +;; https://www.gnu.org/licenses/license-list.html#Expat (define expat (license "Expat" "http://directory.fsf.org/wiki/License:Expat" -- cgit v1.2.3 From 193d7b5b450d2004c26720e488a9cce930542e9e Mon Sep 17 00:00:00 2001 From: jgart Date: Sat, 13 Nov 2021 01:27:15 -0500 Subject: guix: packages: Clarify that list is a list of records. * guix/packages/packages.scm (): Clarify that the license field takes a list of licenses rather than a generic list. Signed-off-by: Liliana Marie Prikler --- guix/packages.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 4b6098bb8d..a3602a3d7a 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -520,7 +520,7 @@ Texinfo. Otherwise, return the string." (sanitize validate-texinfo)) ; one-line description (description package-description (sanitize validate-texinfo)) ; one or two paragraphs - (license package-license) ; instance or list + (license package-license) ; (list of) (home-page package-home-page) (supported-systems package-supported-systems ; list of strings (default %supported-systems)) -- cgit v1.2.3 From 12c06847f07b3fc530e07d4338e3959f60dbefdd Mon Sep 17 00:00:00 2001 From: Thiago Jung Bauermann Date: Thu, 11 Nov 2021 20:46:48 -0300 Subject: environment: Fix ‘--check’ with exported PS1 variable. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit If your .bashrc (unnecessarily) exports PS1 and you’re in a non-login shell, Guix crashes: user@popigai:~$ guix shell --check coreutils guix shell: checking the environment variables visible from shell '/bin/bash'... Backtrace: 14 (primitive-load "/home/user/.config/guix/current/bin/g…") In guix/ui.scm: 2206:7 13 (run-guix . _) 2169:10 12 (run-guix-command _ . _) In ice-9/boot-9.scm: 1752:10 11 (with-exception-handler _ _ #:unwind? _ # _) 1752:10 10 (with-exception-handler _ _ #:unwind? _ # _) In guix/store.scm: 658:37 9 (thunk) 1320:8 8 (call-with-build-handler _ _) 1320:8 7 (call-with-build-handler # …) In guix/status.scm: 800:4 6 (call-with-status-report _ _) In guix/scripts/environment.scm: 951:12 5 (_) In guix/store.scm: 2119:24 4 (run-with-store # …) In guix/scripts/environment.scm: 521:35 3 (_ _) In unknown file: 2 (string=? ("PS1" . "${debian_chroot:+($debian_chroot)…") …) In ice-9/boot-9.scm: 1685:16 1 (raise-exception _ #:continuable? _) 1685:16 0 (raise-exception _ #:continuable? _) ice-9/boot-9.scm:1685:16: In procedure raise-exception: In procedure string=: Wrong type argument in position 1 (expecting string): ("PS1" . "${debian_chroot:+($debian_chroot)}\\[\\033[01;32m\\]\\u@\\h\\[\\033[00m\\]:\\[\\033[01;34m\\]\\w\\[\\033[00m\\]${EXTRA}\\$ ") user@popigai:~$ This is because the match pattern doesn’t expect `(vhash-assoc "PS1" actual)` to return a pair. * guix/scripts/environment.scm (validate-child-shell-environment): Change match pattern to expect a pair. Signed-off-by: Ludovic Courtès --- guix/scripts/environment.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 8176de4a5e..821f20e2f2 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -517,7 +517,7 @@ environment~%"))) (unless warned? (match (vhash-assoc "PS1" actual) (#f #f) - (str + ((_ . str) (when (and (getenv "PS1") (string=? str (getenv "PS1"))) (warning (G_ "'PS1' is the same in sub-shell~%")) (display-hint (G_ "Consider setting a different prompt for -- cgit v1.2.3 From 75cae188ad6e911564c1c7984680bb431793ff18 Mon Sep 17 00:00:00 2001 From: Vagrant Cascadian Date: Sun, 14 Nov 2021 18:00:22 -0800 Subject: build: wrap-qt-program: Fix typo. * gnu/build/qt-utils.scm (wrap-qt-program): Fix spelling of "program". --- guix/build/qt-utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index c2b80cab7d..5d3a4d22e6 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -109,7 +109,7 @@ (define* (wrap-qt-program program-name #:key inputs output (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)) - "Wrap the specified programm (which must reside in the OUTPUT's \"/bin\" + "Wrap the specified program (which must reside in the OUTPUT's \"/bin\" directory) with suitably set environment variables. This is like qt-build-systems's phase \"qt-wrap\", but only the named program -- cgit v1.2.3 From 3af351a7de41b8d50f27f3623c46392f571b9a4e Mon Sep 17 00:00:00 2001 From: Jean-Baptiste Volatier Date: Fri, 12 Nov 2021 14:23:52 +0000 Subject: build-system/julia: Enable Julia Pkg to find installed packages. Julia's built-in package manager (Pkg) looks for packages in JULIA_DEPOT_PATH/packages/PACKAGENAME/XXXX, where XXXX is a string encoding package UUID and SHA1 of files. The link-depot phase creates a link at the correct location to allow Pkg to find packages that were already installed by Guix. * guix/build/julia-build-system.scm (link-depot): New phase. (%package-path): Modified package path from packages/ to loadpath/. (project.toml->uuid): New procedure, retrive package uuid from TOML file. (precompile, check): Adjust to the change in paths. (%standard-phases): Add link-depot phase. (julia-build): Add julia-package-uuid keyword. * guix/build-system/julia.scm (julia-build): Also use the julia-package-uuid keyword. * gnu/packages/julia-jll.scm (julia-bzip2-jll, julia-cairo-jll, julia-compilersupportlibraries-jll, julia-expat-jll, julia-ffmpeg-jll, julia-fontconfig-jll, julia-freetype2-jll, julia-fribidi-jll, julia-gettext-jll, julia-glib-jll, julia-gr-jll, julia-gumbo-jll, julia-imagemagick-jll, julia-jllwrappers-jll, julia-jpegturbo-jll, julia-lame-jll, julia-libass-jll, julia-libfdk-aac-jll, julia-libffi-jll, julia-libgcrypt-jll, julia-libglvnd-jll, julia-libgpg-error-jll, juli-libiconv-jll, julia-libmount-jll, julia-libpng-jll, julia-libsass-jll, julia-libtiff-jll, julia-libuuid-jll, julia-libvorbis-jll, julia-lzo-jll, julia-mbedtls-jll, julia-ogg-jll, julia-openspecfun-jll, julia-openssl-jll, julia-opus-jll, julia-pcre-jll, julia-pixman-jll, julia-qt5base-jll, julia-wayland-jll, julia-wayland-protocols-jll, julia-x264-jll, julia-x265-jll, julia-xkbcommon-jll, julia-xml2-jll, julia-xorg-libpthread-stubs-jll, julia-xorg-libx11-jll, julia-xorg-libxau-jll, julia-xorg-libxcb-jll, julia-xorg-libxcursor-jll, julia-xorg-libxdmcp-jll, julia-xorg-libxext-jll, julia-xorg-libxfixes-jll, julia-xorg-libxi-jll, julia-xorg-libxinerama-jll, julia-xorg-libxkbfile-jll, julia-xorg-libxrandr-jll, julia-xorg-libxrender-jll, julia-xorg-xcb-util-jll, julia-xorg-xcb-util-keysyms-jll, julia-xorg-xcb-util-renderutil-jll, julia-xorg-xcb-util-wm-jll, julia-xorg-xkbcomp-jll, julia-xorg-xkeyboard-config-jll, julia-xorg-xtrans-jll, julia-xslt-jll, julia-zlib-jll, julia-zstd-jll) [argument]: Adjust the order of the phases to the change in the julia-build-system. * gnu/packages/julia-xyz.scm (julia-bufferedstreams, julia-calculus, julia-dataframes, julia-datavalues, julia-distances, julia-documenter, julia-dualnumbers, julia-ellipsisnotation, julia-expronicon, julia-fileio, julia-fixedpointnumbers, julia-functionwrappers, julia-fuzzycompletions, julia-genericlinearalgebra, julia-genericschur, julia-geometrybasics, julia-imagemagick, julia-infinity, julia-matrixfactorizations, julia-media, julia-missings, julia-nnlib, julia-optimtestproblems, julia-orderedcollections, julia-prettytables, julia-pycall, julia-quadmath, julia-safetests, julia-stackviews) [arguments]: Correct paths to reflect change of %package-path modify order of phases as link-depot needs to run on an unmodified src directory add package-name-uuid keyword argument to packages without Project.toml file. * gnu/packages/julia.scm (julia)[native-search-paths]: Correct paths to reflect change of %package-path modify order of phases as link-depot needs to run on an unmodified src directory. Signed-off-by: Efraim Flashner --- gnu/packages/julia-jll.scm | 138 +++++++++++++++++++------------------- gnu/packages/julia-xyz.scm | 69 ++++++++++--------- gnu/packages/julia.scm | 2 +- guix/build-system/julia.scm | 5 +- guix/build/julia-build-system.scm | 48 +++++++++++-- 5 files changed, 154 insertions(+), 108 deletions(-) (limited to 'guix') diff --git a/gnu/packages/julia-jll.scm b/gnu/packages/julia-jll.scm index 51643819ae..d8cf5b9eaf 100644 --- a/gnu/packages/julia-jll.scm +++ b/gnu/packages/julia-jll.scm @@ -77,7 +77,7 @@ '(#:tests? #f ; No runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -117,7 +117,7 @@ compression program.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -163,7 +163,7 @@ compression program.") `(#:tests? #f ; no runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -205,7 +205,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -243,7 +243,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -292,7 +292,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -335,7 +335,7 @@ build tree Yggdrasil.") '(#:tests? #f ; No runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -377,7 +377,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -413,7 +413,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -454,7 +454,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -497,7 +497,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -541,7 +541,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -590,7 +590,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (let ((gumbo (string-append (assoc-ref inputs "gumbo-parser")))) (for-each @@ -630,7 +630,7 @@ rendering library.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -672,7 +672,7 @@ rendering library.") '(#:tests? #f #:phases (modify-phases %standard-phases - (add-after 'unpack 'custom-override-path + (add-after 'link-depot 'custom-override-path (lambda* (#:key inputs #:allow-other-keys) ;; Make @generate_wrapper_header take an optional argument that ;; guix packagers can pass to override the default "override" @@ -718,7 +718,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -754,7 +754,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -790,7 +790,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -830,7 +830,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -866,7 +866,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -903,7 +903,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -942,7 +942,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -980,7 +980,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1018,7 +1018,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1056,7 +1056,7 @@ used in autogenerated packages via @code{BinaryBuilder.jl}.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1095,7 +1095,7 @@ from util-linux.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1133,7 +1133,7 @@ from util-linux.") `(#:tests? #f ; no runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1175,7 +1175,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1214,7 +1214,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1252,7 +1252,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1290,7 +1290,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1328,7 +1328,7 @@ build tree Yggdrasil.") '(#:tests? #f ; No runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1366,7 +1366,7 @@ wrappers.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1403,7 +1403,7 @@ wrappers.") `(#:tests? #f ; no runtests.jl #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1446,7 +1446,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1482,7 +1482,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1518,7 +1518,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1556,7 +1556,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1594,7 +1594,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1645,7 +1645,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1684,7 +1684,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1721,7 +1721,7 @@ build tree Yggdrasil.") `(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (let ((libx264 (assoc-ref inputs "libx264"))) (map @@ -1762,7 +1762,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1798,7 +1798,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1838,7 +1838,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1878,7 +1878,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1915,7 +1915,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1953,7 +1953,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -1989,7 +1989,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2029,7 +2029,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2067,7 +2067,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2103,7 +2103,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2140,7 +2140,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2177,7 +2177,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2215,7 +2215,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2252,7 +2252,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2289,7 +2289,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2327,7 +2327,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2364,7 +2364,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2401,7 +2401,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2438,7 +2438,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2475,7 +2475,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2512,7 +2512,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2549,7 +2549,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2586,7 +2586,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2623,7 +2623,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2659,7 +2659,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2702,7 +2702,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) @@ -2740,7 +2740,7 @@ build tree Yggdrasil.") '(#:tests? #f ; no runtests #:phases (modify-phases %standard-phases - (add-after 'unpack 'override-binary-path + (add-after 'link-depot 'override-binary-path (lambda* (#:key inputs #:allow-other-keys) (map (lambda (wrapper) diff --git a/gnu/packages/julia-xyz.scm b/gnu/packages/julia-xyz.scm index 93fadf318c..73768317b8 100644 --- a/gnu/packages/julia-xyz.scm +++ b/gnu/packages/julia-xyz.scm @@ -410,7 +410,8 @@ structures.") ;; https://travis-ci.org/BioJulia/BufferedStreams.jl/jobs/491050182 (arguments '(#:tests? #f - #:julia-package-name "BufferedStreams")) + #:julia-package-name "BufferedStreams" + #:julia-package-uuid "e1450e63-4bb3-523b-b2a4-4ffa8c0fd77d")) (propagated-inputs `(("julia-compat" ,julia-compat))) (home-page "https://github.com/BioJulia/BufferedStreams.jl") (synopsis "Fast composable IO streams") @@ -778,12 +779,12 @@ way.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'fix-tests + (add-after 'link-depot 'fix-tests (lambda _ (substitute* "test/runtests.jl" (("option.toml") "test/option.toml")) #t)) - (add-after 'unpack 'dont-use-exproniconlite + (add-after 'link-depot 'dont-use-exproniconlite (lambda _ (substitute* '("Project.toml" "src/Configurations.jl" @@ -919,7 +920,7 @@ dependency on it.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-failing-test + (add-after 'link-depot 'skip-failing-test (lambda _ ;; Tests with non-standard colors. (substitute* "test/show.jl" @@ -1022,7 +1023,7 @@ without having to take direct dependencies.") `(#:tests? #f ; Tests need upgrading with newer Julia version. #:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-known-failing-tests + (add-after 'link-depot 'skip-known-failing-tests (lambda _ ;; See upstream report: ;; https://github.com/queryverse/DataValues.jl/issues/83 @@ -1100,7 +1101,7 @@ dictionaries in Julia, for improved productivity and performance.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-flakey-tests + (add-after 'link-depot 'skip-flakey-tests (lambda _ ;; Some combination of these tests fail nondeterministically ;; each of the times this package is built. @@ -1166,14 +1167,14 @@ valuable enough at this time.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'patch-source + (add-after 'link-depot 'patch-source (lambda* (#:key inputs #:allow-other-keys) (substitute* "src/Deps.jl" (("pip install") (string-append (assoc-ref inputs "python") "/bin/pip install"))) #t)) - (add-after 'unpack 'remove-javascript-downloads + (add-after 'link-depot 'remove-javascript-downloads (lambda _ (substitute* "src/Writers/HTMLWriter.jl" (("cdnjs.cloudflare.com") "example.com")) @@ -1352,7 +1353,7 @@ stressing the robustness of differentiation tools.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'adjust-test-suite + (add-after 'link-depot 'adjust-test-suite (lambda _ (substitute* "test/runtests.jl" ;; Seems to not play nicely with SpecialFunctions @@ -1386,7 +1387,7 @@ combinations of dual numbers with predefined Julia numeric types.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'adjust-test-suite + (add-after 'link-depot 'adjust-test-suite (lambda _ (substitute* "test/runtests.jl" ;; Seems to not play nicely with Julia-1.6. @@ -1438,7 +1439,7 @@ before (or after)\".") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-network-tests + (add-after 'link-depot 'skip-network-tests (lambda _ (substitute* "test/runtests.jl" ;; This test tries to access the Julia package registry. @@ -1517,7 +1518,7 @@ need the ffmpeg binaries + executables, and don't want the overhead of `(#:phases (modify-phases %standard-phases (delete 'reset-gzip-timestamps) - (add-after 'unpack 'skip-network-tests + (add-after 'link-depot 'skip-network-tests (lambda _ ;; These tests try to download audio/video files. (substitute* "test/query.jl" @@ -1677,7 +1678,7 @@ using finite difference.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'disable-failing-test + (add-after 'link-depot 'disable-failing-test (lambda* (#:key outputs #:allow-other-keys) (substitute* "test/fixed.jl" ;; A deprecation warning is not thrown @@ -1764,7 +1765,7 @@ differentiation (AD).") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'adjust-tests + (add-after 'link-depot 'adjust-tests (lambda _ (substitute* "test/runtests.jl" (("testset \\\"Abstract.*" all) @@ -1817,7 +1818,7 @@ update step.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-failing-test + (add-after 'link-depot 'skip-failing-test (lambda _ (substitute* "test/runtests.jl" ((".*RPLE.*") ""))))))) @@ -1844,7 +1845,7 @@ update step.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'adjust-test-suite + (add-after 'link-depot 'adjust-test-suite (lambda _ (substitute* "test/runtests.jl" ((".*lapack.*") ""))))))) @@ -1875,7 +1876,7 @@ algebra routines written in Julia (except for optimized BLAS).") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'adjust-test-suite + (add-after 'link-depot 'adjust-test-suite (lambda _ (substitute* "test/complex.jl" ;; expected Array{Int32,1}, got a value of type Array{Int64,1} @@ -1912,13 +1913,13 @@ matrices the Schur form is often more useful.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'remove-earcut + (add-after 'link-depot 'remove-earcut (lambda _ (substitute* '("Project.toml" "src/GeometryBasics.jl") ((".*EarCut.*") "")) #t)) - (add-after 'unpack 'skip-incompatible-test + (add-after 'link-depot 'skip-incompatible-test (lambda _ (substitute* "test/runtests.jl" (("@testset.*MetaT and heterogeneous data.*" all) @@ -2268,7 +2269,7 @@ be downscaled to fit into the size of your active terminal session.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-failing-test + (add-after 'link-depot 'skip-failing-test (lambda _ ;; These tests try to download from the imagemagick.org (substitute* "test/runtests.jl" @@ -2465,7 +2466,7 @@ indexed images, sometimes called \"colormap images\" or \"paletted images.\"") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'remove-timezones.jl + (add-after 'link-depot 'remove-timezones.jl (lambda _ (substitute* "test/runtests.jl" (("using TimeZones.*") "") @@ -2864,7 +2865,7 @@ comes from the fact that @code{M == map(f, A)}.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-failing-test + (add-after 'link-depot 'skip-failing-test (lambda _ ;; Tests with math functions are hard. (substitute* "test/test_ul.jl" @@ -2981,7 +2982,8 @@ resolving them into absolute units.") (build-system julia-build-system) ;; Package without Project.toml (arguments - '(#:julia-package-name "Media")) + '(#:julia-package-name "Media" + #:julia-package-uuid "e89f7d12-3494-54d1-8411-f7d8b9ae1f27")) (propagated-inputs `(("julia-macrotools" ,julia-macrotools))) (home-page "https://github.com/JunoLab/Media.jl") @@ -3202,7 +3204,7 @@ interface to interact with these types.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-cuda-tests + (add-after 'link-depot 'skip-cuda-tests (lambda _ (substitute* "test/runtests.jl" (("using CUDA") "") @@ -3238,7 +3240,8 @@ doesn't provide any other \"high-level\" functionality like layers or AD.") (base32 "10h47x5ws42pkqjccimaz0yxfvz41w0yazq6inamfk4lg5g2g3d9")))) (build-system julia-build-system) (arguments - `(#:julia-package-name "OptimTestProblems")) + `(#:julia-package-name "OptimTestProblems" + #:julia-package-uuid "cec144fc-5a64-5bc6-99fb-dde8f63e154c")) (home-page "https://github.com/JuliaNLSolvers/OptimTestProblems.jl") (synopsis "Collection of optimization test problems") (description "The purpose of this package is to provide test problems for @@ -3528,7 +3531,7 @@ everything from run time algorithm choice to code generation at compile time.") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-color-tests + (add-after 'link-depot 'skip-color-tests (lambda _ (substitute* "test/text_backend.jl" ((".*colors\\.jl.*") "")) @@ -3567,7 +3570,7 @@ human-readable format.") ((guix build python-build-system) #:prefix python:)) #:phases (modify-phases %standard-phases - (add-after 'unpack 'remove-conda + (add-after 'link-depot 'remove-conda (lambda _ (substitute* "Project.toml" ((".*Conda.*") "")) @@ -3577,7 +3580,7 @@ human-readable format.") (substitute* "deps/depsutils.jl" (("Conda.PYTHONDIR") "\"/\"")) #t)) - (add-after 'unpack 'set-python + (add-after 'link-depot 'set-python (lambda* (#:key inputs outputs #:allow-other-keys) (let ((python (assoc-ref inputs "python"))) (setenv "PYCALL_JL_RUNTIME_PYTHON" @@ -3690,7 +3693,7 @@ arbitrary normed vector spaces (e.g. matrix-valued integrands).") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'hardcode-libmath-location + (add-after 'link-depot 'hardcode-libmath-location (lambda* (#:key inputs #:allow-other-keys) (let ((gcclib (assoc-ref inputs "gcc:lib"))) (substitute* "src/Quadmath.jl" @@ -4082,7 +4085,8 @@ through matrix-vector multiplication.") (base32 "1fb1dfdmiw2ggx60hf70954xlps0r48fcb3k3dvxynlz7ylphp96")))) (build-system julia-build-system) (arguments - `(#:julia-package-name "SafeTestsets")) + `(#:julia-package-name "SafeTestsets" + #:julia-package-uuid "1bc83da4-3b8d-516f-aca4-4fe02f6d838f")) (native-inputs `(("julia-staticarrays" ,julia-staticarrays))) (home-page "https://github.com/YingboMa/SafeTestsets.jl") @@ -4308,7 +4312,7 @@ some performance improvements).") (arguments `(#:phases (modify-phases %standard-phases - (add-after 'unpack 'skip-doctest + (add-after 'link-depot 'skip-doctest (lambda _ (substitute* "test/runtests.jl" ((".*doctest.*") "")) @@ -4811,6 +4815,7 @@ types, modules, and dictionaries.") (build-system julia-build-system) (arguments '(#:julia-package-name "URIs" ;required to run tests + #:julia-package-uuid "5c2747f8-b7ea-4ff2-ba2e-563bfd36b1d4" #:phases (modify-phases %standard-phases (add-before 'check 'change-dir @@ -4818,7 +4823,7 @@ types, modules, and dictionaries.") (lambda* (#:key source outputs #:allow-other-keys) (let ((out (assoc-ref outputs "out"))) (chdir - (string-append out "/share/julia/packages/URIs/test"))) + (string-append out "/share/julia/loadpath/URIs/test"))) #t))))) ;; required for tests (inputs `(("julia-json" ,julia-json))) diff --git a/gnu/packages/julia.scm b/gnu/packages/julia.scm index 411f2e2e10..5b9bf91ed6 100644 --- a/gnu/packages/julia.scm +++ b/gnu/packages/julia.scm @@ -673,7 +673,7 @@ libraries. It is also a bit like @code{ldd} and @code{otool -L}.") (native-search-paths (list (search-path-specification (variable "JULIA_LOAD_PATH") - (files (list "share/julia/packages/"))) + (files (list "share/julia/loadpath/"))) (search-path-specification (variable "JULIA_DEPOT_PATH") (files (list "share/julia/"))))) diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm index 63cb7cd864..8ceac090c7 100644 --- a/guix/build-system/julia.scm +++ b/guix/build-system/julia.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Nicolò Balzarotti +;;; Copyright © 2021 Jean-Baptiste Volatier ;;; ;;; This file is part of GNU Guix. ;;; @@ -83,6 +84,7 @@ (system (%current-system)) (guile #f) (julia-package-name #f) + (julia-package-uuid #f) (imported-modules %julia-build-system-modules) (modules '((guix build julia-build-system) (guix build utils)))) @@ -105,7 +107,8 @@ #:search-paths ',(map search-path-specification->sexp search-paths) #:inputs %build-inputs - #:julia-package-name ,julia-package-name))) + #:julia-package-name ,julia-package-name + #:julia-package-uuid ,julia-package-uuid))) (define guile-for-build (match guile diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm index d74acf2a05..41c69665c6 100644 --- a/guix/build/julia-build-system.scm +++ b/guix/build/julia-build-system.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2020 Nicolò Balzarotti +;;; Copyright © 2021 Jean-Baptiste Volatier ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,9 +21,11 @@ (define-module (guix build julia-build-system) #:use-module ((guix build gnu-build-system) #:prefix gnu:) #:use-module (guix build utils) + #:use-module (rnrs io ports) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) + #:use-module (ice-9 popen) #:export (%standard-phases julia-create-package-toml julia-build)) @@ -37,7 +40,7 @@ (invoke "julia" "-e" code)) ;; subpath where we store the package content -(define %package-path "/share/julia/packages/") +(define %package-path "/share/julia/loadpath/") (define (project.toml->name file) "Look for Julia package name in the TOML file FILE (usually named @@ -51,6 +54,18 @@ Project.toml)." (if m (match:substring m 1) (loop (read-line in 'concat))))))))) +(define (project.toml->uuid file) + "Look for Julia package uuid in the TOML file FILE (usually named +Project.toml)." + (call-with-input-file file + (lambda (in) + (let loop ((line (read-line in 'concat))) + (if (eof-object? line) + #f + (let ((m (string-match "uuid\\s*=\\s*\"(.*)\"" line))) + (if m (match:substring m 1) + (loop (read-line in 'concat))))))))) + (define* (install #:key source inputs outputs julia-package-name #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) @@ -73,7 +88,7 @@ Project.toml)." (setenv "JULIA_DEPOT_PATH" builddir) ;; Add new package dir to the load path. (setenv "JULIA_LOAD_PATH" - (string-append builddir "packages/" ":" + (string-append builddir "loadpath/" ":" (or (getenv "JULIA_LOAD_PATH") ""))) ;; Actual precompilation: @@ -97,15 +112,36 @@ Project.toml)." (setenv "SOURCE_DATE_EPOCH" "1") (setenv "JULIA_DEPOT_PATH" builddir) (setenv "JULIA_LOAD_PATH" - (string-append builddir "packages/" ":" + (string-append builddir "loadpath/" ":" (or (getenv "JULIA_LOAD_PATH") ""))) (setenv "HOME" "/tmp") (invoke "julia" "--depwarn=yes" - (string-append builddir "packages/" + (string-append builddir "loadpath/" package "/test/runtests.jl")))) #t) +(define* (link-depot #:key source inputs outputs julia-package-name julia-package-uuid + #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (package-name (or + julia-package-name + (project.toml->name "Project.toml"))) + (package-dir (string-append out %package-path package-name)) + (uuid (or julia-package-uuid (project.toml->uuid "Project.toml"))) + (pipe (open-pipe* OPEN_READ "julia" "-e" + (format #f "using Pkg; +println(Base.version_slug(Base.UUID(\"~a\"), + Base.SHA1(Pkg.GitTools.tree_hash(\".\"))))" uuid))) + (slug (string-trim-right (get-string-all pipe)))) + ;; When installing a package, julia looks first at in the JULIA_DEPOT_PATH + ;; for a path like packages/PACKAGE/XXXX + ;; Where XXXX is a slug encoding the package UUID and SHA1 of the files + ;; Here we create a link with the correct path to enable julia to find the package + (mkdir-p (string-append out "/share/julia/packages/" package-name)) + (symlink package-dir (string-append out "/share/julia/packages/" package-name "/" slug))) + #t) + (define (julia-create-package-toml outputs source name uuid version deps) @@ -138,6 +174,7 @@ version = \"" version "\" (delete 'check) ; tests must be run after installation (replace 'install install) (add-after 'install 'precompile precompile) + (add-after 'unpack 'link-depot link-depot) (add-after 'install 'check check) ;; TODO: In the future we could add a "system-image-generation" phase ;; where we use PackageCompiler.jl to speed up package loading times @@ -146,11 +183,12 @@ version = \"" version "\" (delete 'patch-usr-bin-file) (delete 'build))) -(define* (julia-build #:key inputs julia-package-name +(define* (julia-build #:key inputs julia-package-name julia-package-uuid (phases %standard-phases) #:allow-other-keys #:rest args) "Build the given Julia package, applying all of PHASES in order." (apply gnu:gnu-build #:inputs inputs #:phases phases #:julia-package-name julia-package-name + #:julia-package-uuid julia-package-uuid args)) -- cgit v1.2.3 From f39397b21041fe418247239f27473aff49a203c9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 13 Nov 2021 16:11:25 +0100 Subject: tests: Factorize 'file=?'. * guix/tests.scm (file=?): Add optional 'stat' parameter. Add fast patch comparing inode numbers. * tests/gexp.scm ("imported-files with file-like objects"): Remove 'file=?' procedure and use the one from (guix tests). --- guix/tests.scm | 30 +++++++++++++++++------------- tests/gexp.scm | 11 +++-------- 2 files changed, 20 insertions(+), 21 deletions(-) (limited to 'guix') diff --git a/guix/tests.scm b/guix/tests.scm index fc3d521163..e1c194340c 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2013-2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -182,18 +182,22 @@ too expensive to build entirely in the test store." (loop (1+ i))) bv)))) -(define (file=? a b) - "Return true if files A and B have the same type and same content." - (and (eq? (stat:type (lstat a)) (stat:type (lstat b))) - (case (stat:type (lstat a)) - ((regular) - (equal? - (call-with-input-file a get-bytevector-all) - (call-with-input-file b get-bytevector-all))) - ((symlink) - (string=? (readlink a) (readlink b))) - (else - (error "what?" (lstat a)))))) +(define* (file=? a b #:optional (stat lstat)) + "Return true if files A and B have the same type and same content. Call +STAT to obtain file metadata." + (let ((sta (stat a)) (stb (stat b))) + (and (eq? (stat:type sta) (stat:type stb)) + (case (stat:type sta) + ((regular) + (or (and (= (stat:ino sta) (stat:ino stb)) + (= (stat:dev sta) (stat:dev stb))) + (equal? + (call-with-input-file a get-bytevector-all) + (call-with-input-file b get-bytevector-all)))) + ((symlink) + (string=? (readlink a) (readlink b))) + (else + (error "what?" (stat a))))))) (define (canonical-file? file) "Return #t if FILE is in the store, is read-only, and its mtime is 1." diff --git a/tests/gexp.scm b/tests/gexp.scm index 39a47d4e8c..0758a49f5f 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2014-2021 Ludovic Courtès ;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. @@ -827,19 +827,14 @@ (files -> `(("a/b/c" . ,q-scm) ("p/q" . ,plain))) (drv (imported-files files))) - (define (file=? file1 file2) - ;; Assume deduplication is in place. - (= (stat:ino (stat file1)) - (stat:ino (stat file2)))) - (mbegin %store-monad (built-derivations (list (pk 'drv drv))) (mlet %store-monad ((dir -> (derivation->output-path drv)) (plain* (text-file "foo" "bar!")) (q-scm* (interned-file q-scm "c"))) (return - (and (file=? (string-append dir "/a/b/c") q-scm*) - (file=? (string-append dir "/p/q") plain*))))))) + (and (file=? (string-append dir "/a/b/c") q-scm* stat) + (file=? (string-append dir "/p/q") plain* stat))))))) (test-equal "gexp-modules & ungexp" '((bar) (foo)) -- cgit v1.2.3 From 472a0e82a52a3d5d841e1dfad6b13e26082a5750 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 13 Nov 2021 21:47:15 +0100 Subject: daemon: Do not deduplicate files smaller than 8 KiB. Files smaller than 8 KiB typically represent ~70% of the entries in /gnu/store/.links but only contribute to ~4% of the space savings afforded by deduplication. Not considering these files for deduplication speeds up file insertion in the store and, more importantly, leaves 'removeUnusedLinks' with fewer entries to traverse, thereby speeding it up proportionally. Partly fixes . * config-daemon.ac: Remove symlink hard link check and CAN_LINK_SYMLINK definition. * guix/store/deduplication.scm (%deduplication-minimum-size): New variable. (deduplicate)[loop]: Do not recurse when FILE's size is below %DEDUPLICATION-MINIMUM-SIZE. (dump-port): New procedure. (dump-file/deduplicate)[hash]: Turn into... [dump-and-compute-hash]: ... this thunk. Call 'deduplicate' only when SIZE is greater than %DEDUPLICATION-MINIMUM-SIZE; otherwise call 'dump-port'. * nix/libstore/gc.cc (LocalStore::removeUnusedLinks): Drop files where st.st_size < deduplicationMinSize. * nix/libstore/local-store.hh (deduplicationMinSize): New declaration. * nix/libstore/optimise-store.cc (deduplicationMinSize): New variable. (LocalStore::optimisePath_): Return when PATH is a symlink or smaller than 'deduplicationMinSize'. * tests/derivations.scm ("identical files are deduplicated"): Produce files bigger than %DEDUPLICATION-MINIMUM-SIZE. * tests/nar.scm ("restore-file-set with directories (signed, valid)"): Likewise. * tests/store-deduplication.scm ("deduplicate, below %deduplication-minimum-size"): New test. ("deduplicate", "deduplicate, ENOSPC"): Produce files bigger than %DEDUPLICATION-MINIMUM-SIZE. * tests/store.scm ("substitute, deduplication"): Likewise. --- config-daemon.ac | 11 ------- guix/store/deduplication.scm | 69 ++++++++++++++++++++++++++++++++++++------ nix/libstore/gc.cc | 4 ++- nix/libstore/local-store.hh | 3 ++ nix/libstore/optimise-store.cc | 15 +++++---- tests/derivations.scm | 14 ++++++--- tests/nar.scm | 7 +++-- tests/store-deduplication.scm | 41 +++++++++++++++++++++---- tests/store.scm | 4 ++- 9 files changed, 126 insertions(+), 42 deletions(-) (limited to 'guix') diff --git a/config-daemon.ac b/config-daemon.ac index 5ddc740600..86306effe1 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -94,17 +94,6 @@ if test "x$guix_build_daemon" = "xyes"; then AC_CHECK_FUNCS([lutimes lchown posix_fallocate sched_setaffinity \ statvfs nanosleep strsignal statx]) - dnl Check whether the store optimiser can optimise symlinks. - AC_MSG_CHECKING([whether it is possible to create a link to a symlink]) - ln -s bla tmp_link - if ln tmp_link tmp_link2 2> /dev/null; then - AC_MSG_RESULT(yes) - AC_DEFINE(CAN_LINK_SYMLINK, 1, [Whether link() works on symlinks.]) - else - AC_MSG_RESULT(no) - fi - rm -f tmp_link tmp_link2 - dnl Check for . AC_LANG_PUSH(C++) AC_CHECK_HEADERS([locale]) diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm index cd9660174c..370df4a74c 100644 --- a/guix/store/deduplication.scm +++ b/guix/store/deduplication.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Caleb Ristvedt -;;; Copyright © 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2018-2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,12 +22,13 @@ (define-module (guix store deduplication) #:use-module (gcrypt hash) - #:use-module (guix build utils) + #:use-module ((guix build utils) #:hide (dump-port)) #:use-module (guix build syscalls) #:use-module (guix base32) #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 ftw) #:use-module (ice-9 match) @@ -37,6 +38,31 @@ dump-file/deduplicate copy-file/deduplicate)) +;; TODO: Remove once 'dump-port' in (guix build utils) has an optional 'len' +;; parameter. +(define* (dump-port in out + #:optional len + #:key (buffer-size 16384)) + "Read LEN bytes from IN (or as much as possible if LEN is #f) and write it +to OUT, using chunks of BUFFER-SIZE bytes." + (define buffer + (make-bytevector buffer-size)) + + (let loop ((total 0) + (bytes (get-bytevector-n! in buffer 0 + (if len + (min len buffer-size) + buffer-size)))) + (or (eof-object? bytes) + (and len (= total len)) + (let ((total (+ total bytes))) + (put-bytevector out buffer 0 bytes) + (loop total + (get-bytevector-n! in buffer 0 + (if len + (min (- len total) buffer-size) + buffer-size))))))) + (define (nar-sha256 file) "Gives the sha256 hash of a file and the size of the file in nar form." (let-values (((port get-hash) (open-sha256-port))) @@ -127,11 +153,27 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system." (unless (= EMLINK (system-error-errno args)) (apply throw args))))))) +(define %deduplication-minimum-size + ;; Size below which files are not deduplicated. This avoids adding too many + ;; entries to '.links', which would slow down 'removeUnusedLinks' while + ;; saving little space. Keep in sync with optimize-store.cc. + 8192) + (define* (deduplicate path hash #:key (store (%store-directory))) "Check if a store item with sha256 hash HASH already exists. If so, replace PATH with a hardlink to the already-existing one. If not, register PATH so that future duplicates can hardlink to it. PATH is assumed to be under STORE." + ;; Lightweight promises. + (define-syntax-rule (delay exp) + (let ((value #f)) + (lambda () + (unless value + (set! value exp)) + value))) + (define-syntax-rule (force promise) + (promise)) + (define links-directory (string-append store "/.links")) @@ -144,13 +186,18 @@ under STORE." ((file . properties) (unless (member file '("." "..")) (let* ((file (string-append path "/" file)) + (st (delay (lstat file))) (type (match (assoc-ref properties 'type) ((or 'unknown #f) - (stat:type (lstat file))) + (stat:type (force st))) (type type)))) - (loop file type - (and (not (eq? 'directory type)) - (nar-sha256 file))))))) + (when (or (eq? 'directory type) + (and (eq? 'regular type) + (>= (stat:size (force st)) + %deduplication-minimum-size))) + (loop file type + (and (not (eq? 'directory type)) + (nar-sha256 file)))))))) (scandir* path)) (let ((link-file (string-append links-directory "/" (bytevector->nix-base32-string hash)))) @@ -222,9 +269,9 @@ OUTPUT as it goes." This procedure is suitable as a #:dump-file argument to 'restore-file'. When used that way, it deduplicates files on the fly as they are restored, thereby -removing the need to a deduplication pass that would re-read all the files +removing the need for a deduplication pass that would re-read all the files down the road." - (define hash + (define (dump-and-compute-hash) (call-with-output-file file (lambda (output) (let-values (((hash-port get-hash) @@ -236,7 +283,11 @@ down the road." (close-port hash-port) (get-hash))))) - (deduplicate file hash #:store store)) + (if (>= size %deduplication-minimum-size) + (deduplicate file (dump-and-compute-hash) #:store store) + (call-with-output-file file + (lambda (output) + (dump-port input output size))))) (define* (copy-file/deduplicate source target #:key (store (%store-directory))) diff --git a/nix/libstore/gc.cc b/nix/libstore/gc.cc index e1d0765154..16519116e4 100644 --- a/nix/libstore/gc.cc +++ b/nix/libstore/gc.cc @@ -606,7 +606,9 @@ void LocalStore::removeUnusedLinks(const GCState & state) throw SysError(format("statting `%1%'") % path); #endif - if (st.st_nlink != 1) { + /* Drop links for files smaller than 'deduplicationMinSize', even if + they have more than one hard link. */ + if (st.st_nlink != 1 && st.st_size >= deduplicationMinSize) { actualSize += st.st_size; unsharedSize += (st.st_nlink - 1) * st.st_size; continue; diff --git a/nix/libstore/local-store.hh b/nix/libstore/local-store.hh index 9ba37219da..20d3c3c893 100644 --- a/nix/libstore/local-store.hh +++ b/nix/libstore/local-store.hh @@ -292,4 +292,7 @@ void canonicaliseTimestampAndPermissions(const Path & path); MakeError(PathInUse, Error); +/* Size below which a file is not considered for deduplication. */ +extern const size_t deduplicationMinSize; + } diff --git a/nix/libstore/optimise-store.cc b/nix/libstore/optimise-store.cc index eb303ab4c3..9fd6f3cb35 100644 --- a/nix/libstore/optimise-store.cc +++ b/nix/libstore/optimise-store.cc @@ -15,6 +15,9 @@ namespace nix { +/* Any file smaller than this is not considered for deduplication. + Keep in sync with (guix store deduplication). */ +const size_t deduplicationMinSize = 8192; static void makeWritable(const Path & path) { @@ -105,12 +108,12 @@ void LocalStore::optimisePath_(OptimiseStats & stats, const Path & path, InodeHa return; } - /* We can hard link regular files and maybe symlinks. */ - if (!S_ISREG(st.st_mode) -#if CAN_LINK_SYMLINK - && !S_ISLNK(st.st_mode) -#endif - ) return; + /* We can hard link regular files (and maybe symlinks), but do that only + for files larger than some threshold. This avoids adding too many + entries to '.links', which would slow down 'removeUnusedLinks' while + saving little space. */ + if (!S_ISREG(st.st_mode) || ((size_t) st.st_size) < deduplicationMinSize) + return; /* Sometimes SNAFUs can cause files in the store to be modified, in particular when running programs as root under diff --git a/tests/derivations.scm b/tests/derivations.scm index cd165d1be6..0775719ea3 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012-2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -170,11 +170,15 @@ #f)))) (test-assert "identical files are deduplicated" - (let* ((build1 (add-text-to-store %store "one.sh" - "echo hello, world > \"$out\"\n" + ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE. + (let* ((data (make-string 9000 #\a)) + (build1 (add-text-to-store %store "one.sh" + (string-append "echo -n " data + " > \"$out\"\n") '())) (build2 (add-text-to-store %store "two.sh" - "# Hey!\necho hello, world > \"$out\"\n" + (string-append "# Hey!\necho -n " + data " > \"$out\"\n") '())) (drv1 (derivation %store "foo" %bash `(,build1) @@ -187,7 +191,7 @@ (file2 (derivation->output-path drv2))) (and (valid-path? %store file1) (valid-path? %store file2) (string=? (call-with-input-file file1 get-string-all) - "hello, world\n") + data) (= (stat:ino (lstat file1)) (stat:ino (lstat file2)))))))) diff --git a/tests/nar.scm b/tests/nar.scm index ba4881caaa..98752f2088 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012-2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -486,8 +486,9 @@ ;; their mtime and permissions were not reset. Ensure that this bug is ;; gone. (with-store store - (let* ((text1 (random-text)) - (text2 (random-text)) + ;; Note: TEXT1 and TEXT2 must be longer than %DEDUPLICATION-MINIMUM-SIZE. + (let* ((text1 (string-concatenate (make-list 200 (random-text)))) + (text2 (string-concatenate (make-list 200 (random-text)))) (tree `("tree" directory ("a" regular (data ,text1)) ("b" directory diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm index b1c2d93bbd..2950fbc1a3 100644 --- a/tests/store-deduplication.scm +++ b/tests/store-deduplication.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2020 Ludovic Courtès +;;; Copyright © 2018, 2020-2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,13 +30,40 @@ (test-begin "store-deduplication") +(test-equal "deduplicate, below %deduplication-minimum-size" + (list #t (make-list 5 1)) + + (call-with-temporary-directory + (lambda (store) + ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE. + (let ((data "Hello, world!") + (identical (map (lambda (n) + (string-append store "/" (number->string n) + "/a/b/c")) + (iota 5)))) + (for-each (lambda (file) + (mkdir-p (dirname file)) + (call-with-output-file file + (lambda (port) + (put-bytevector port (string->utf8 data))))) + identical) + + (deduplicate store (nar-sha256 store) #:store store) + + ;; (system (string-append "ls -lRia " store)) + (list (= (length (delete-duplicates + (map (compose stat:ino stat) identical))) + (length identical)) + (map (compose stat:nlink stat) identical)))))) + (test-equal "deduplicate" (cons* #t #f ;inode comparisons 2 (make-list 5 6)) ;'nlink' values (call-with-temporary-directory (lambda (store) - (let ((data (string->utf8 "Hello, world!")) + ;; Note: DATA must be longer than %DEDUPLICATION-MINIMUM-SIZE. + (let ((data (string-concatenate (make-list 1000 "Hello, world!"))) (identical (map (lambda (n) (string-append store "/" (number->string n) "/a/b/c")) @@ -46,7 +73,7 @@ (mkdir-p (dirname file)) (call-with-output-file file (lambda (port) - (put-bytevector port data)))) + (put-bytevector port (string->utf8 data))))) identical) ;; Make the parent of IDENTICAL read-only. This should not prevent ;; deduplication from inserting its hard link. @@ -54,7 +81,7 @@ (call-with-output-file unique (lambda (port) - (put-bytevector port (string->utf8 "This is unique.")))) + (put-bytevector port (string->utf8 (string-reverse data))))) (deduplicate store (nar-sha256 store) #:store store) @@ -77,8 +104,10 @@ (lambda (store) (let ((true-link link) (links 0) - (data1 (string->utf8 "Hello, world!")) - (data2 (string->utf8 "Hi, world!")) + (data1 (string->utf8 + (string-concatenate (make-list 1000 "Hello, world!")))) + (data2 (string->utf8 + (string-concatenate (make-list 1000 "Hi, world!")))) (identical (map (lambda (n) (string-append store "/" (number->string n) "/a/b/c")) diff --git a/tests/store.scm b/tests/store.scm index 2150a0048c..5c9f651d6c 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -759,7 +759,9 @@ (test-assert "substitute, deduplication" (with-store s - (let* ((c (random-text)) ; contents of the output + ;; Note: C must be longer than %DEDUPLICATION-MINIMUM-SIZE. + (let* ((c (string-concatenate + (make-list 200 (random-text)))) ; contents of the output (g (package-derivation s %bootstrap-guile)) (d1 (build-expression->derivation s "substitute-me" `(begin ,c (exit 1)) -- cgit v1.2.3