diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-06-20 23:08:16 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-06-20 23:08:16 +0200 |
commit | 651478aa18a3f575d3b4cc14166a15a1c45b0f61 (patch) | |
tree | 87c27dc9eff3d321f7ad4a622b110c517856a104 /guix | |
parent | 71c08ee60bb3f62bac0614888fb62405f7a388ab (diff) | |
parent | 9a2e5fe5fdcc6ea848ceeefa0f70147dfb360639 (diff) | |
download | gnu-guix-651478aa18a3f575d3b4cc14166a15a1c45b0f61.tar gnu-guix-651478aa18a3f575d3b4cc14166a15a1c45b0f61.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build-system/cargo.scm | 117 | ||||
-rw-r--r-- | guix/build/cargo-build-system.scm | 54 | ||||
-rw-r--r-- | guix/derivations.scm | 9 | ||||
-rw-r--r-- | guix/grafts.scm | 67 | ||||
-rw-r--r-- | guix/import/cabal.scm | 7 | ||||
-rw-r--r-- | guix/import/crate.scm | 47 | ||||
-rw-r--r-- | guix/import/hackage.scm | 62 | ||||
-rw-r--r-- | guix/import/utils.scm | 4 | ||||
-rw-r--r-- | guix/licenses.scm | 6 | ||||
-rw-r--r-- | guix/scripts/build.scm | 5 | ||||
-rw-r--r-- | guix/utils.scm | 6 |
11 files changed, 292 insertions, 92 deletions
diff --git a/guix/build-system/cargo.scm b/guix/build-system/cargo.scm index dc137421e9..fa211d456d 100644 --- a/guix/build-system/cargo.scm +++ b/guix/build-system/cargo.scm @@ -29,6 +29,8 @@ #:use-module (guix build-system) #:use-module (guix build-system gnu) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (%cargo-build-system-modules %cargo-utils-modules @@ -118,18 +120,128 @@ to NAME and VERSION." #:inputs inputs #:system system #:modules imported-modules - #:outputs (cons "src" outputs) + #:outputs outputs #:guile-for-build guile-for-build)) +(define (package-cargo-inputs p) + (apply + (lambda* (#:key (cargo-inputs '()) #:allow-other-keys) + cargo-inputs) + (package-arguments p))) + +(define (package-cargo-development-inputs p) + (apply + (lambda* (#:key (cargo-development-inputs '()) #:allow-other-keys) + cargo-development-inputs) + (package-arguments p))) + +(define (crate-closure inputs) + "Return the closure of INPUTS when considering the 'cargo-inputs' and +'cargod-dev-deps' edges. Omit duplicate inputs, except for those +already present in INPUTS itself. + +This is implemented as a breadth-first traversal such that INPUTS is +preserved, and only duplicate extracted inputs are removed. + +Forked from ((guix packages) transitive-inputs) since this extraction +uses slightly different rules compared to the rest of Guix (i.e. we +do not extract the conventional inputs)." + (define (seen? seen item) + ;; FIXME: We're using pointer identity here, which is extremely sensitive + ;; to memoization in package-producing procedures; see + ;; <https://bugs.gnu.org/30155>. + (vhash-assq item seen)) + + (let loop ((inputs inputs) + (result '()) + (propagated '()) + (first? #t) + (seen vlist-null)) + (match inputs + (() + (if (null? propagated) + (reverse result) + (loop (reverse (concatenate propagated)) result '() #f seen))) + (((and input (label (? package? package))) rest ...) + (if (and (not first?) (seen? seen package)) + (loop rest result propagated first? seen) + (loop rest + (cons input result) + (cons (package-cargo-inputs package) + propagated) + first? + (vhash-consq package package seen)))) + ((input rest ...) + (loop rest (cons input result) propagated first? seen))))) + +(define (expand-crate-sources cargo-inputs cargo-development-inputs) + "Extract all transitive sources for CARGO-INPUTS and CARGO-DEVELOPMENT-INPUTS +along their 'cargo-inputs' edges. + +Cargo requires all transitive crate dependencies' sources to be available +in its index, even if they are optional (this is so it can generate +deterministic Cargo.lock files regardless of the target platform or enabled +features). Thus we need all transitive crate dependencies for any cargo +dev-dependencies, but this is only needed when building/testing a crate directly +(i.e. we will never need transitive dev-dependencies for any dependency crates). + +Another complication arises due potential dependency cycles from Guix's +perspective: Although cargo does not permit cyclic dependencies between crates, +however, it permits cycles to occur via dev-dependencies. For example, if crate +X depends on crate Y, crate Y's tests could pull in crate X to to verify +everything builds properly (this is a rare scenario, but it it happens for +example with the `proc-macro2` and `quote` crates). This is allowed by cargo +because tests are built as a pseudo-crate which happens to depend on the +X and Y crates, forming an acyclic graph. + +We can side step this problem by only considering regular cargo dependencies +since they are guaranteed to not have cycles. We can further resolve any +potential dev-dependency cycles by extracting package sources (which never have +any dependencies and thus no cycles can exist). + +There are several implications of this decision: +* Building a package definition does not require actually building/checking +any dependent crates. This can be a benefits: + - For example, sometimes a crate may have an optional dependency on some OS + specific package which cannot be built or run on the current system. This + approach means that the build will not fail if cargo ends up internally ignoring + the dependency. + - It avoids waiting for quadratic builds from source: cargo always builds + dependencies within the current workspace. This is largely due to Rust not + having a stable ABI and other resolutions that cargo applies. This means that + if we have a depencency chain of X -> Y -> Z and we build each definition + independently the following will happen: + * Cargo will build and test crate Z + * Cargo will build crate Z in Y's workspace, then build and test Y + * Cargo will build crates Y and Z in X's workspace, then build and test X +* But there are also some downsides with this approach: + - If a dependent crate is subtly broken on the system (i.e. it builds but its + tests fail) the consuming crates may build and test successfully but + actually fail during normal usage (however, the CI will still build all + packages which will give visibility in case packages suddenly break). + - Because crates aren't declared as regular inputs, other Guix facilities + such as tracking package graphs may not work by default (however, this is + something that can always be extended or reworked in the future)." + (filter-map + (match-lambda + ((label (? package? p)) + (list label (package-source p))) + ((label input) + (list label input))) + (crate-closure (append cargo-inputs cargo-development-inputs)))) + (define* (lower name #:key source inputs native-inputs outputs system target (rust (default-rust)) + (cargo-inputs '()) + (cargo-development-inputs '()) #:allow-other-keys #:rest arguments) "Return a bag for NAME." (define private-keywords - '(#:source #:target #:rust #:inputs #:native-inputs #:outputs)) + '(#:source #:target #:rust #:inputs #:native-inputs #:outputs + #:cargo-inputs #:cargo-development-inputs)) (and (not target) ;; TODO: support cross-compilation (bag @@ -145,6 +257,7 @@ to NAME and VERSION." ,@(standard-packages))) (build-inputs `(("cargo" ,rust "cargo") ("rustc" ,rust) + ,@(expand-crate-sources cargo-inputs cargo-development-inputs) ,@native-inputs)) (outputs outputs) (build cargo-build) diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm index 9f44bd6ee9..1f36304b15 100644 --- a/guix/build/cargo-build-system.scm +++ b/guix/build/cargo-build-system.scm @@ -54,6 +54,22 @@ (bin-dep? (lambda (dep) (find bin? (get-kinds dep))))) (find bin-dep? (manifest-targets)))) +(define (crate-src? path) + "Check if PATH refers to a crate source, namely a gzipped tarball with a +Cargo.toml file present at its root." + (and (gzip-file? path) + ;; First we print out all file names within the tarball to see if it + ;; looks like the source of a crate. However, the tarball will include + ;; an extra path component which we would like to ignore (since we're + ;; interested in checking if a Cargo.toml exists at the root of the + ;; archive, but not nested anywhere else). We do this by cutting up + ;; each output line and only looking at the second component. We then + ;; check if it matches Cargo.toml exactly and short circuit if it does. + (zero? (apply system* (list "sh" "-c" + (string-append "tar -tf " path + " | cut -d/ -f2" + " | grep -q '^Cargo.toml$'")))))) + (define* (configure #:key inputs (vendor-dir "guix-vendor") #:allow-other-keys) @@ -67,14 +83,21 @@ (for-each (match-lambda ((name . path) - (let* ((rust-share (string-append path "/share/rust-source")) - (basepath (basename path)) - (link-dir (string-append vendor-dir "/" basepath))) - (and (file-exists? rust-share) + (let* ((basepath (basename path)) + (crate-dir (string-append vendor-dir "/" basepath))) + (and (crate-src? path) ;; Gracefully handle duplicate inputs - (not (file-exists? link-dir)) - (symlink rust-share link-dir))))) + (not (file-exists? crate-dir)) + (mkdir-p crate-dir) + ;; Cargo crates are simply gzipped tarballs but with a .crate + ;; extension. We expand the source to a directory name we control + ;; so that we can generate any cargo checksums. + ;; The --strip-components argument is needed to prevent creating + ;; an extra directory within `crate-dir`. + (invoke "tar" "xvf" path "-C" crate-dir "--strip-components" "1") + (generate-checksums crate-dir))))) inputs) + ;; Configure cargo to actually use this new directory. (mkdir-p ".cargo") (let ((port (open-file ".cargo/config" "w" #:encoding "utf-8"))) @@ -117,24 +140,6 @@ directory = '" port) (define (touch file-name) (call-with-output-file file-name (const #t))) -(define* (install-source #:key inputs outputs #:allow-other-keys) - "Install the source for a given Cargo package." - (let* ((out (assoc-ref outputs "out")) - (src (assoc-ref inputs "source")) - (rsrc (string-append (assoc-ref outputs "src") - "/share/rust-source"))) - (mkdir-p rsrc) - ;; Rust doesn't have a stable ABI yet. Because of this - ;; Cargo doesn't have a search path for binaries yet. - ;; Until this changes we are working around this by - ;; vendoring the crates' sources by symlinking them - ;; to store paths. - (copy-recursively "." rsrc) - (touch (string-append rsrc "/.cargo-ok")) - (generate-checksums rsrc) - (install-file "Cargo.toml" rsrc) - #t)) - (define* (install #:key inputs outputs skip-build? #:allow-other-keys) "Install a given Cargo package." (let* ((out (assoc-ref outputs "out"))) @@ -156,7 +161,6 @@ directory = '" port) (define %standard-phases (modify-phases gnu:%standard-phases (delete 'bootstrap) - (add-before 'configure 'install-source install-source) (replace 'configure configure) (replace 'build build) (replace 'check check) diff --git a/guix/derivations.scm b/guix/derivations.scm index cad77bdb06..8145d51143 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -62,6 +62,7 @@ <derivation-input> derivation-input? derivation-input-path + derivation-input-derivation derivation-input-sub-derivations derivation-input-output-paths valid-derivation-input? @@ -152,6 +153,10 @@ (path derivation-input-path) ; store path (sub-derivations derivation-input-sub-derivations)) ; list of strings +(define (derivation-input-derivation input) + "Return the <derivation> object INPUT refers to." + (read-derivation-from-file (derivation-input-path input))) + (set-record-type-printer! <derivation> (lambda (drv port) (format port "#<derivation ~a => ~a ~a>" @@ -243,9 +248,7 @@ result is the set of prerequisites of DRV not already in valid." (fold2 loop (append inputs result) (fold set-insert input-set inputs) - (map (lambda (i) - (read-derivation-from-file (derivation-input-path i))) - inputs))))) + (map derivation-input-derivation inputs))))) (define (offloadable-derivation? drv) "Return true if DRV can be offloaded, false otherwise." diff --git a/guix/grafts.scm b/guix/grafts.scm index a3e12f6efd..3b43e11425 100644 --- a/guix/grafts.scm +++ b/guix/grafts.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,9 +22,9 @@ #:use-module (guix records) #:use-module (guix derivations) #:use-module ((guix utils) #:select (%current-system)) + #:use-module (guix sets) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9 gnu) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (ice-9 match) @@ -151,21 +151,6 @@ are not recursively applied to dependencies of DRV." #:substitutable? #f #:properties properties))))) -(define (item->deriver store item) - "Return two values: the derivation that led to ITEM (a store item), and the -name of the output of that derivation ITEM corresponds to (for example -\"out\"). When ITEM has no deriver, for instance because it is a plain file, -#f and #f are returned." - (match (valid-derivers store item) - (() ;ITEM is a plain file - (values #f #f)) - ((drv-file _ ...) - (let ((drv (read-derivation-from-file drv-file))) - (values drv - (any (match-lambda - ((name . path) - (and (string=? item path) name))) - (derivation->output-paths drv))))))) (define (non-self-references references drv outputs) "Return the list of references of the OUTPUTS of DRV, excluding self @@ -230,6 +215,33 @@ available." (set-current-state (vhash-cons key result cache)) (return result))))))) +(define (reference-origin drv item) + "Return the derivation/output pair among the inputs of DRV, recursively, +that produces ITEM. Return #f if ITEM is not produced by a derivation (i.e., +it's a content-addressed \"source\"), or if it's not produced by a dependency +of DRV." + ;; Perform a breadth-first traversal of the dependency graph of DRV in + ;; search of the derivation that produces ITEM. + (let loop ((drv (list drv)) + (visited (setq))) + (match drv + (() + #f) + ((drv . rest) + (if (set-contains? visited drv) + (loop rest visited) + (let ((inputs (derivation-inputs drv))) + (or (any (lambda (input) + (let ((drv (derivation-input-derivation input))) + (any (match-lambda + ((output . file) + (and (string=? file item) + (cons drv output)))) + (derivation->output-paths drv)))) + inputs) + (loop (append rest (map derivation-input-derivation inputs)) + (set-insert drv visited))))))))) + (define* (cumulative-grafts store drv grafts references #:key @@ -257,16 +269,17 @@ derivations to the corresponding set of grafts." #f))) (define (dependency-grafts item) - (let-values (((drv output) (item->deriver store item))) - (if drv - ;; If GRAFTS already contains a graft from DRV, do not override it. - (if (find (cut graft-origin? drv <>) grafts) - (state-return grafts) - (cumulative-grafts store drv grafts references - #:outputs (list output) - #:guile guile - #:system system)) - (state-return grafts)))) + (match (reference-origin drv item) + ((drv . output) + ;; If GRAFTS already contains a graft from DRV, do not override it. + (if (find (cut graft-origin? drv <>) grafts) + (state-return grafts) + (cumulative-grafts store drv grafts references + #:outputs (list output) + #:guile guile + #:system system))) + (#f + (state-return grafts)))) (with-cache (cons (derivation-file-name drv) outputs) (match (non-self-references references drv outputs) diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm index 1a87be0b00..7dfe771e41 100644 --- a/guix/import/cabal.scm +++ b/guix/import/cabal.scm @@ -40,6 +40,7 @@ cabal-package? cabal-package-name cabal-package-version + cabal-package-revision cabal-package-license cabal-package-home-page cabal-package-source-repository @@ -638,13 +639,14 @@ If #f use the function 'port-filename' to obtain it." ;; information of the Cabal file, but only the ones we currently are ;; interested in. (define-record-type <cabal-package> - (make-cabal-package name version license home-page source-repository + (make-cabal-package name version revision license home-page source-repository synopsis description executables lib test-suites flags eval-environment custom-setup) cabal-package? (name cabal-package-name) (version cabal-package-version) + (revision cabal-package-revision) (license cabal-package-license) (home-page cabal-package-home-page) (source-repository cabal-package-source-repository) @@ -838,6 +840,7 @@ See the manual for limitations."))))))) (define (cabal-evaluated-sexp->package evaluated-sexp) (let* ((name (lookup-join evaluated-sexp "name")) (version (lookup-join evaluated-sexp "version")) + (revision (lookup-join evaluated-sexp "x-revision")) (license (lookup-join evaluated-sexp "license")) (home-page (lookup-join evaluated-sexp "homepage")) (home-page-or-hackage @@ -856,7 +859,7 @@ See the manual for limitations."))))))) (custom-setup (match (make-cabal-section evaluated-sexp 'custom-setup) ((x) x) (_ #f)))) - (make-cabal-package name version license home-page-or-hackage + (make-cabal-package name version revision license home-page-or-hackage source-repository synopsis description executables lib test-suites flags eval-environment custom-setup))) diff --git a/guix/import/crate.scm b/guix/import/crate.scm index e0b400d054..9a73d9fe16 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -65,29 +65,53 @@ (path (string-append "/" version "/dependencies")) (deps-json (json-fetch-alist (string-append crate-url name path))) (deps (assoc-ref deps-json "dependencies")) - (input-crates (filter (crate-kind-predicate "normal") deps)) - (native-input-crates + (dep-crates (filter (crate-kind-predicate "normal") deps)) + (dev-dep-crates (filter (lambda (dep) (not ((crate-kind-predicate "normal") dep))) deps)) - (inputs (crates->inputs input-crates)) - (native-inputs (crates->inputs native-input-crates)) + (cargo-inputs (crates->inputs dep-crates)) + (cargo-development-inputs (crates->inputs dev-dep-crates)) (home-page (match homepage (() repository) (_ homepage)))) (callback #:name name #:version version - #:inputs inputs #:native-inputs native-inputs + #:cargo-inputs cargo-inputs + #:cargo-development-inputs cargo-development-inputs #:home-page home-page #:synopsis synopsis #:description description #:license license))) -(define* (make-crate-sexp #:key name version inputs native-inputs +(define (maybe-cargo-inputs package-names) + (match (package-names->package-inputs package-names) + (() + '()) + ((package-inputs ...) + `((#:cargo-inputs ,package-inputs))))) + +(define (maybe-cargo-development-inputs package-names) + (match (package-names->package-inputs package-names) + (() + '()) + ((package-inputs ...) + `((#:cargo-development-inputs ,package-inputs))))) + +(define (maybe-arguments arguments) + (match arguments + (() + '()) + ((args ...) + `((arguments (,'quasiquote ,args)))))) + +(define* (make-crate-sexp #:key name version cargo-inputs cargo-development-inputs home-page synopsis description license #:allow-other-keys) "Return the `package' s-expression for a rust package with the given NAME, -VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." +VERSION, CARGO-INPUTS, CARGO-DEVELOPMENT-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, +and LICENSE." (let* ((port (http-fetch (crate-uri name version))) (guix-name (crate-name->package-name name)) - (inputs (map crate-name->package-name inputs)) - (native-inputs (map crate-name->package-name native-inputs)) + (cargo-inputs (map crate-name->package-name cargo-inputs)) + (cargo-development-inputs (map crate-name->package-name + cargo-development-inputs)) (pkg `(package (name ,guix-name) (version ,version) @@ -99,8 +123,9 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE." (base32 ,(bytevector->nix-base32-string (port-sha256 port)))))) (build-system cargo-build-system) - ,@(maybe-native-inputs native-inputs "src") - ,@(maybe-inputs inputs "src") + ,@(maybe-arguments (append (maybe-cargo-inputs cargo-inputs) + (maybe-cargo-development-inputs + cargo-development-inputs))) (home-page ,(match home-page (() "") (_ home-page))) diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 366256b40d..6f426af900 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -117,19 +117,34 @@ version is returned." (#f name) (m (match:substring m 1))))))) +(define (read-cabal-and-hash port) + "Read a Cabal file from PORT and return it and its hash in nix-base32 +format as two values." + (let-values (((port get-hash) (open-sha256-input-port port))) + (values (read-cabal (canonical-newline-port port)) + (bytevector->nix-base32-string (get-hash))))) + +(define (hackage-fetch-and-hash name-version) + "Fetch the latest Cabal revision for the package NAME-VERSION, and return +two values: the parsed Cabal file and its hash in nix-base32 format. If the +version part is omitted from the package name, then fetch the latest +version. On failure, both return values will be #f." + (guard (c ((and (http-get-error? c) + (= 404 (http-get-error-code c))) + (values #f #f))) ;"expected" if package is unknown + (let*-values (((name version) (package-name->name+version name-version)) + ((url) (hackage-cabal-url name version)) + ((port _) (http-fetch url)) + ((cabal hash) (read-cabal-and-hash port))) + (close-port port) + (values cabal hash)))) + (define (hackage-fetch name-version) "Return the Cabal file for the package NAME-VERSION, or #f on failure. If the version part is omitted from the package name, then return the latest version." - (guard (c ((and (http-get-error? c) - (= 404 (http-get-error-code c))) - #f)) ;"expected" if package is unknown - (let-values (((name version) (package-name->name+version name-version))) - (let* ((url (hackage-cabal-url name version)) - (port (http-fetch url)) - (result (read-cabal (canonical-newline-port port)))) - (close-port port) - result)))) + (let-values (((cabal hash) (hackage-fetch-and-hash name-version))) + cabal)) (define string->license ;; List of valid values from @@ -198,15 +213,20 @@ package being processed and is used to filter references to itself." (cons own-name ghc-standard-libraries)))) dependencies)) -(define* (hackage-module->sexp cabal #:key (include-test-dependencies? #t)) +(define* (hackage-module->sexp cabal cabal-hash + #:key (include-test-dependencies? #t)) "Return the `package' S-expression for a Cabal package. CABAL is the -representation of a Cabal file as produced by 'read-cabal'." +representation of a Cabal file as produced by 'read-cabal'. CABAL-HASH is +the hash of the Cabal file." (define name (cabal-package-name cabal)) (define version (cabal-package-version cabal)) + + (define revision + (cabal-package-revision cabal)) (define source-url (hackage-source-url name version)) @@ -252,9 +272,14 @@ representation of a Cabal file as produced by 'read-cabal'." (list 'quasiquote inputs)))))) (define (maybe-arguments) - (if (not include-test-dependencies?) - '((arguments `(#:tests? #f))) - '())) + (match (append (if (not include-test-dependencies?) + '(#:tests? #f) + '()) + (if (not (string-null? revision)) + `(#:cabal-revision (,revision ,cabal-hash)) + '())) + (() '()) + (args `((arguments (,'quasiquote ,args)))))) (let ((tarball (with-store store (download-to-store store source-url)))) @@ -294,10 +319,11 @@ symbol 'true' or 'false'. The value associated with other keys has to conform to the Cabal file format definition. The default value associated with the keys \"os\", \"arch\" and \"impl\" is \"linux\", \"x86_64\" and \"ghc\" respectively." - (let ((cabal-meta (if port - (read-cabal (canonical-newline-port port)) - (hackage-fetch package-name)))) - (and=> cabal-meta (compose (cut hackage-module->sexp <> + (let-values (((cabal-meta cabal-hash) + (if port + (read-cabal-and-hash port) + (hackage-fetch-and-hash package-name)))) + (and=> cabal-meta (compose (cut hackage-module->sexp <> cabal-hash #:include-test-dependencies? include-test-dependencies?) (cut eval-cabal <> cabal-environment))))) diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 63fc9bbb27..84503ab907 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -52,6 +52,7 @@ url-fetch guix-hash-url + package-names->package-inputs maybe-inputs maybe-native-inputs package->definition @@ -236,6 +237,9 @@ into a proper sentence and by using two spaces between sentences." cleaned 'pre ". " 'post))) (define* (package-names->package-inputs names #:optional (output #f)) + "Given a list of PACKAGE-NAMES, and an optional OUTPUT, tries to generate a +quoted list of inputs, as suitable to use in an 'inputs' field of a package +definition." (map (lambda (input) (cons* input (list 'unquote (string->symbol input)) (or (and output (list output)) diff --git a/guix/licenses.scm b/guix/licenses.scm index 65d9c3da13..41d4fefad2 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -94,6 +94,7 @@ fsf-free wtfpl2 wxwindows3.1+ + hpnd fsdg-compatible)) (define-record-type <license> @@ -628,6 +629,11 @@ which may be a file:// URI pointing the package's tree." "http://www.gzip.org/zlib/zlib_license.html" "https://www.gnu.org/licenses/license-list#ZLib")) +(define hpnd + (license "HPND" + "https://directory.fsf.org/wiki/License:HPND" + "https://www.gnu.org/licenses/license-list#HPND")) + (define* (fsf-free uri #:optional (comment "")) "Return a license that does not fit any of the ones above or a collection of licenses, approved as free by the FSF. More details can be found at URI." diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8fa700c883..61ca4dca9f 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -935,9 +935,12 @@ needed." #:mode mode)) (cond ((assoc-ref opts 'log-file?) + ;; Pass 'show-build-log' the output file names, not the + ;; derivation file names, because there can be several + ;; derivations leading to the same output. (for-each (cut show-build-log store <> urls) (delete-duplicates - (append (map derivation-file-name drv) + (append (map derivation->output-path drv) items)))) ((assoc-ref opts 'derivations-only?) (format #t "~{~a~%~}" (map derivation-file-name drv)) diff --git a/guix/utils.scm b/guix/utils.scm index 709cdf9353..f480c3291f 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -718,7 +718,7 @@ environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like (define (canonical-newline-port port) "Return an input port that wraps PORT such that all newlines consist - of a single carriage return." + of a single linefeed." (define (get-position) (if (port-has-port-position? port) (port-position port) #f)) (define (set-position! position) @@ -730,11 +730,11 @@ environment variable name like \"XDG_CONFIG_HOME\"; SUFFIX is a suffix like (let loop ((count 0) (byte (get-u8 port))) (cond ((eof-object? byte) count) + ;; XXX: consume all CRs even if not followed by LF. + ((eqv? byte (char->integer #\return)) (loop count (get-u8 port))) ((= count (- n 1)) (bytevector-u8-set! bv (+ start count) byte) n) - ;; XXX: consume all LFs even if not followed by CR. - ((eqv? byte (char->integer #\return)) (loop count (get-u8 port))) (else (bytevector-u8-set! bv (+ start count) byte) (loop (+ count 1) (get-u8 port)))))) |