From ad3729536ab4fe233b32017ac889f026a4bad43e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 11 Feb 2015 22:58:53 +0100 Subject: store: Add optional 'references' parameter to 'text-file'. * guix/store.scm (text-file): Add optional 'references' parameter. Pass it to 'add-text-to-store'. * doc/guix.texi (The Store Monad): Adjust accordingly. --- guix/store.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index 02d84eb517..d88fb3ea54 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -890,11 +890,13 @@ taking the store as its first argument." ;; Store monad operators. ;; -(define* (text-file name text) +(define* (text-file name text + #:optional (references '())) "Return as a monadic value the absolute file name in the store of the file -containing TEXT, a string." +containing TEXT, a string. REFERENCES is a list of store items that the +resulting text file refers to; it defaults to the empty list." (lambda (store) - (values (add-text-to-store store name text '()) + (values (add-text-to-store store name text references) store))) (define* (interned-file file #:optional name -- cgit v1.2.3 From aa72d9afdfe2d65e73c426c280667323181ae592 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Feb 2015 17:23:17 +0100 Subject: gexp: Implement 'imported-modules' & co. using 'gexp->derivation'. * guix/derivations.scm (imported-files): Keep private. (%imported-modules, %compiled-modules, build-expression->derivation): Mark as deprecated. (imported-modules, compiled-modules): Remove. * guix/gexp.scm (%mkdir-p-definition): New variable. (imported-files, search-path*, imported-modules, compiled-modules): New procedures. * tests/derivations.scm ("imported-files"): Remove. * tests/gexp.scm ("imported-files", "gexp->derivation #:modules"): New tests. --- guix/derivations.scm | 19 ++---- guix/gexp.scm | 158 +++++++++++++++++++++++++++++++++++++++++++++++++- tests/derivations.scm | 17 ------ tests/gexp.scm | 34 +++++++++++ 4 files changed, 195 insertions(+), 33 deletions(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index 678550a39e..e5922365a0 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -96,11 +96,8 @@ build-derivations built-derivations - imported-modules - compiled-modules - build-expression->derivation - imported-files) + build-expression->derivation) ;; Re-export it from here for backward compatibility. #:re-export (%guile-for-build)) @@ -942,7 +939,7 @@ recursively." (remove (cut string=? <> ".") (string-tokenize (dirname file-name) not-slash)))))) -(define* (imported-files store files +(define* (imported-files store files ;deprecated #:key (name "file-import") (system (%current-system)) (guile (%guile-for-build))) @@ -982,7 +979,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path." ;; up looking for the same files over and over again. (memoize search-path)) -(define* (%imported-modules store modules +(define* (%imported-modules store modules ;deprecated #:key (name "module-import") (system (%current-system)) (guile (%guile-for-build)) @@ -1001,7 +998,7 @@ search path." (imported-files store files #:name name #:system system #:guile guile))) -(define* (%compiled-modules store modules +(define* (%compiled-modules store modules ;deprecated #:key (name "module-import-compiled") (system (%current-system)) (guile (%guile-for-build)) @@ -1124,7 +1121,7 @@ applied." #:outputs output-names #:local-build? #t))))) -(define* (build-expression->derivation store name exp +(define* (build-expression->derivation store name exp ;deprecated #:key (system (%current-system)) (inputs '()) @@ -1290,9 +1287,3 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?." (define built-derivations (store-lift build-derivations)) - -(define imported-modules - (store-lift %imported-modules)) - -(define compiled-modules - (store-lift %compiled-modules)) diff --git a/guix/gexp.scm b/guix/gexp.scm index fa712a8b9b..0620683078 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -21,6 +21,7 @@ #:use-module (guix monads) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) @@ -31,7 +32,10 @@ gexp->derivation gexp->file gexp->script - text-file*)) + text-file* + imported-files + imported-modules + compiled-modules)) ;;; Commentary: ;;; @@ -500,6 +504,157 @@ package/derivation references." (lambda #,formals #,sexp))))))) + +;;; +;;; Module handling. +;;; + +(define %mkdir-p-definition + ;; The code for 'mkdir-p' is copied from (guix build utils). We use it in + ;; derivations that cannot use the #:modules argument of 'gexp->derivation' + ;; precisely because they implement that functionality. + (gexp + (define (mkdir-p dir) + (define absolute? + (string-prefix? "/" dir)) + + (define not-slash + (char-set-complement (char-set #\/))) + + (let loop ((components (string-tokenize dir not-slash)) + (root (if absolute? "" "."))) + (match components + ((head tail ...) + (let ((path (string-append root "/" head))) + (catch 'system-error + (lambda () + (mkdir path) + (loop tail path)) + (lambda args + (if (= EEXIST (system-error-errno args)) + (loop tail path) + (apply throw args)))))) + (() #t)))))) + +(define* (imported-files files + #:key (name "file-import") + (system (%current-system)) + (guile (%guile-for-build))) + "Return a derivation that imports FILES into STORE. FILES must be a list +of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file +system, imported, and appears under FINAL-PATH in the resulting store path." + (define file-pair + (match-lambda + ((final-path . file-name) + (mlet %store-monad ((file (interned-file file-name + (basename final-path)))) + (return (list final-path file)))))) + + (mlet %store-monad ((files (sequence %store-monad + (map file-pair files)))) + (define build + (gexp + (begin + (use-modules (ice-9 match)) + + (ungexp %mkdir-p-definition) + + (mkdir (ungexp output)) (chdir (ungexp output)) + (for-each (match-lambda + ((final-path store-path) + (mkdir-p (dirname final-path)) + (symlink store-path final-path))) + '(ungexp files))))) + + ;; TODO: Pass FILES as an environment variable so that BUILD remains + ;; exactly the same regardless of FILES: less disk space, and fewer + ;; 'add-to-store' RPCs. + (gexp->derivation name build + #:system system + #:guile-for-build guile + #:local-build? #t))) + +(define search-path* + ;; A memoizing version of 'search-path' so 'imported-modules' does not end + ;; up looking for the same files over and over again. + (memoize search-path)) + +(define* (imported-modules modules + #:key (name "module-import") + (system (%current-system)) + (guile (%guile-for-build)) + (module-path %load-path)) + "Return a derivation that contains the source files of MODULES, a list of +module names such as `(ice-9 q)'. All of MODULES must be in the MODULE-PATH +search path." + ;; TODO: Determine the closure of MODULES, build the `.go' files, + ;; canonicalize the source files through read/write, etc. + (let ((files (map (lambda (m) + (let ((f (string-append + (string-join (map symbol->string m) "/") + ".scm"))) + (cons f (search-path* module-path f)))) + modules))) + (imported-files files #:name name #:system system + #:guile guile))) + +(define* (compiled-modules modules + #:key (name "module-import-compiled") + (system (%current-system)) + (guile (%guile-for-build)) + (module-path %load-path)) + "Return a derivation that builds a tree containing the `.go' files +corresponding to MODULES. All the MODULES are built in a context where +they can refer to each other." + (mlet %store-monad ((modules (imported-modules modules + #:system system + #:guile guile + #:module-path + module-path))) + (define build + (gexp + (begin + (use-modules (ice-9 ftw) + (ice-9 match) + (srfi srfi-26) + (system base compile)) + + (ungexp %mkdir-p-definition) + + (define (regular? file) + (not (member file '("." "..")))) + + (define (process-directory directory output) + (let ((entries (map (cut string-append directory "/" <>) + (scandir directory regular?)))) + (for-each (lambda (entry) + (if (file-is-directory? entry) + (let ((output (string-append output "/" + (basename entry)))) + (mkdir-p output) + (process-directory entry output)) + (let* ((base (string-drop-right + (basename entry) + 4)) ;.scm + (output (string-append output "/" base + ".go"))) + (compile-file entry + #:output-file output + #:opts + %auto-compilation-options)))) + entries))) + + (set! %load-path (cons (ungexp modules) %load-path)) + (mkdir (ungexp output)) + (chdir (ungexp modules)) + (process-directory "." (ungexp output))))) + + ;; TODO: Pass MODULES as an environment variable. + (gexp->derivation name build + #:system system + #:guile-for-build guile + #:local-build? #t))) + ;;; ;;; Convenience procedures. @@ -562,7 +717,6 @@ and store file names; the resulting store file holds references to all these." (gexp->derivation name builder)) - ;;; ;;; Syntactic sugar. diff --git a/tests/derivations.scm b/tests/derivations.scm index 80aabad3a8..e23bdeed77 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -670,23 +670,6 @@ (let ((p (derivation->output-path drv))) (string-contains (call-with-input-file p read-line) "GNU"))))) -(test-assert "imported-files" - (let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm")) - ("a/b/c" . ,(search-path %load-path - "guix/derivations.scm")) - ("p/q" . ,(search-path %load-path "guix.scm")) - ("p/z" . ,(search-path %load-path "guix/store.scm")))) - (drv (imported-files %store files))) - (and (build-derivations %store (list drv)) - (let ((dir (derivation->output-path drv))) - (every (match-lambda - ((path . source) - (equal? (call-with-input-file (string-append dir "/" path) - get-bytevector-all) - (call-with-input-file source - get-bytevector-all)))) - files))))) - (test-assert "build-expression->derivation with modules" (let* ((builder `(begin (use-modules (guix build utils)) diff --git a/tests/gexp.scm b/tests/gexp.scm index 03722e4669..68c470d3b6 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -360,6 +360,40 @@ (string=? (readlink (string-append out "/" two "/one")) one))))))) +(test-assertm "imported-files" + (mlet* %store-monad + ((files -> `(("x" . ,(search-path %load-path "ice-9/q.scm")) + ("a/b/c" . ,(search-path %load-path + "guix/derivations.scm")) + ("p/q" . ,(search-path %load-path "guix.scm")) + ("p/z" . ,(search-path %load-path "guix/store.scm")))) + (drv (imported-files files))) + (mbegin %store-monad + (built-derivations (list drv)) + (let ((dir (derivation->output-path drv))) + (return + (every (match-lambda + ((path . source) + (equal? (call-with-input-file (string-append dir "/" path) + get-bytevector-all) + (call-with-input-file source + get-bytevector-all)))) + files)))))) + +(test-assertm "gexp->derivation #:modules" + (mlet* %store-monad + ((build -> #~(begin + (use-modules (guix build utils)) + (mkdir-p (string-append #$output "/guile/guix/nix")) + #t)) + (drv (gexp->derivation "test-with-modules" build + #:modules '((guix build utils))))) + (mbegin %store-monad + (built-derivations (list drv)) + (let* ((p (derivation->output-path drv)) + (s (stat (string-append p "/guile/guix/nix")))) + (return (eq? (stat:type s) 'directory)))))) + (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad ((one (text-file "one" "hello, world")) -- cgit v1.2.3 From 2bba832f88b579ab466c0c19c9ec5503d1878d26 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Feb 2015 22:58:13 +0100 Subject: tests: Add missing import. * guix/tests.scm: Add missing import, needed by 'dummy-package'. --- guix/tests.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/tests.scm b/guix/tests.scm index 451c1ba4bb..1171bb4dfb 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -23,6 +23,7 @@ #:use-module (guix base32) #:use-module (guix serialization) #:use-module (guix hash) + #:use-module (guix build-system gnu) #:use-module (gnu packages bootstrap) #:use-module (srfi srfi-34) #:use-module (rnrs bytevectors) -- cgit v1.2.3 From b8bedf6051200b0c8eb6ddf4ac1b155466caa3ec Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Feb 2015 23:07:11 +0100 Subject: packages: Add 'set-grafting' procedure. * guix/packages.scm (set-grafting): New procedure. --- guix/packages.scm | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 96f3adfc32..5b686a122f 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -114,6 +114,7 @@ default-guile set-guile-for-build + set-grafting package-file package->derivation package->cross-derivation @@ -906,6 +907,12 @@ code of derivations to GUILE, a package object." (let ((guile (package-derivation store guile))) (values (%guile-for-build guile) store)))) +(define (set-grafting enable?) + "This monadic procedure enables grafting when ENABLE? is true, and disables +it otherwise. It returns the previous setting." + (lambda (store) + (values (%graft? enable?) store))) + (define* (package-file package #:optional file #:key -- cgit v1.2.3 From ce45eb4c385e3b473bc6746a8b58452865f69977 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 13 Feb 2015 23:14:05 +0100 Subject: gexp: Add #:graft? parameter to 'gexp->derivation'. * guix/gexp.scm (gexp->derivation): Add #:graft? parameter and honor it. * tests/gexp.scm ("gexp->derivation vs. grafts"): New test. * doc/guix.texi (G-Expressions): Update 'gexp->derivation' documentation. --- doc/guix.texi | 11 +++++++---- guix/gexp.scm | 62 ++++++++++++++++++++++++++++++++-------------------------- tests/gexp.scm | 17 ++++++++++++++++ 3 files changed, 58 insertions(+), 32 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 04b9b4aaae..50a7084fec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2580,7 +2580,7 @@ below allow you to do that (@pxref{The Store Monad}, for more information about monads.) @deffn {Monadic Procedure} gexp->derivation @var{name} @var{exp} @ - [#:system (%current-system)] [#:target #f] [#:inputs '()] @ + [#:system (%current-system)] [#:target #f] [#:graft? #t] @ [#:hash #f] [#:hash-algo #f] @ [#:recursive? #f] [#:env-vars '()] [#:modules '()] @ [#:module-path @var{%load-path}] @ @@ -2591,12 +2591,15 @@ Return a derivation @var{name} that runs @var{exp} (a gexp) with is true, it is used as the cross-compilation target triplet for packages referred to by @var{exp}. -Make @var{modules} available in the evaluation context of @var{EXP}; -@var{MODULES} is a list of names of Guile modules searched in -@var{MODULE-PATH} to be copied in the store, compiled, and made available in +Make @var{modules} available in the evaluation context of @var{exp}; +@var{modules} is a list of names of Guile modules searched in +@var{module-path} to be copied in the store, compiled, and made available in the load path during the execution of @var{exp}---e.g., @code{((guix build utils) (guix build gnu-build-system))}. +@var{graft?} determines whether packages referred to by @var{exp} should be grafted when +applicable. + When @var{references-graphs} is true, it must be a list of tuples of one of the following forms: diff --git a/guix/gexp.scm b/guix/gexp.scm index 0620683078..a8349c7d6e 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -153,6 +153,7 @@ names and file names suitable for the #:allowed-references argument to (modules '()) (module-path %load-path) (guile-for-build (%guile-for-build)) + (graft? (%graft?)) references-graphs allowed-references local-build?) @@ -165,6 +166,9 @@ names of Guile modules searched in MODULE-PATH to be copied in the store, compiled, and made available in the load path during the execution of EXP---e.g., '((guix build utils) (guix build gnu-build-system)). +GRAFT? determines whether packages referred to by EXP should be grafted when +applicable. + When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the following forms: @@ -198,10 +202,10 @@ The other arguments are as for 'derivation'." (cons file-name thing))) graphs)) - (mlet* %store-monad (;; The following binding is here to force - ;; '%current-system' and '%current-target-system' to be - ;; looked up at >>= time. - (unused (return #f)) + (mlet* %store-monad (;; The following binding forces '%current-system' and + ;; '%current-target-system' to be looked up at >>= + ;; time. + (graft? (set-grafting graft?)) (system -> (or system (%current-system))) (target -> (if (eq? target 'current) @@ -245,30 +249,32 @@ The other arguments are as for 'derivation'." (return guile-for-build) (package->derivation (default-guile) system)))) - (raw-derivation name - (string-append (derivation->output-path guile) - "/bin/guile") - `("--no-auto-compile" - ,@(if (pair? %modules) - `("-L" ,(derivation->output-path modules) - "-C" ,(derivation->output-path compiled)) - '()) - ,builder) - #:outputs outputs - #:env-vars env-vars - #:system system - #:inputs `((,guile) - (,builder) - ,@(if modules - `((,modules) (,compiled) ,@inputs) - inputs) - ,@(match graphs - (((_ . inputs) ...) inputs) - (_ '()))) - #:hash hash #:hash-algo hash-algo #:recursive? recursive? - #:references-graphs (and=> graphs graphs-file-names) - #:allowed-references allowed - #:local-build? local-build?))) + (mbegin %store-monad + (set-grafting graft?) ;restore the initial setting + (raw-derivation name + (string-append (derivation->output-path guile) + "/bin/guile") + `("--no-auto-compile" + ,@(if (pair? %modules) + `("-L" ,(derivation->output-path modules) + "-C" ,(derivation->output-path compiled)) + '()) + ,builder) + #:outputs outputs + #:env-vars env-vars + #:system system + #:inputs `((,guile) + (,builder) + ,@(if modules + `((,modules) (,compiled) ,@inputs) + inputs) + ,@(match graphs + (((_ . inputs) ...) inputs) + (_ '()))) + #:hash hash #:hash-algo hash-algo #:recursive? recursive? + #:references-graphs (and=> graphs graphs-file-names) + #:allowed-references allowed + #:local-build? local-build?)))) (define* (gexp-inputs exp #:optional (references gexp-references)) "Return the input list for EXP, using REFERENCES to get its list of diff --git a/tests/gexp.scm b/tests/gexp.scm index 68c470d3b6..0b189b570b 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -249,6 +249,23 @@ (equal? refs (list (dirname (dirname guile)))) (equal? refs2 (list file)))))) +(test-assertm "gexp->derivation vs. grafts" + (mlet* %store-monad ((p0 -> (dummy-package "dummy" + (arguments + '(#:implicit-inputs? #f)))) + (r -> (package (inherit p0) (name "DuMMY"))) + (p1 -> (package (inherit p0) (replacement r))) + (exp0 -> (gexp (frob (ungexp p0) (ungexp output)))) + (exp1 -> (gexp (frob (ungexp p1) (ungexp output)))) + (void (set-guile-for-build %bootstrap-guile)) + (drv0 (gexp->derivation "t" exp0)) + (drv1 (gexp->derivation "t" exp1)) + (drv1* (gexp->derivation "t" exp1 #:graft? #f))) + (return (and (not (string=? (derivation->output-path drv0) + (derivation->output-path drv1))) + (string=? (derivation->output-path drv0) + (derivation->output-path drv1*)))))) + (test-assertm "gexp->derivation, composed gexps" (mlet* %store-monad ((exp0 -> (gexp (begin (mkdir (ungexp output)) -- cgit v1.2.3 From cb7e486797df42bb971178918e84741ced3e6528 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 12 Feb 2015 12:58:11 +0100 Subject: gnu: Add R. * gnu/packages/statistics.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it * guix/download.scm (%mirrors): Add CRAN mirrors. --- gnu-system.am | 1 + gnu/packages/statistics.scm | 108 ++++++++++++++++++++++++++++++++++++++++++++ guix/download.scm | 10 ++++ 3 files changed, 119 insertions(+) create mode 100644 gnu/packages/statistics.scm (limited to 'guix') diff --git a/gnu-system.am b/gnu-system.am index 04e93452ba..73c3771f73 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -260,6 +260,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/socat.scm \ gnu/packages/ssh.scm \ gnu/packages/stalonetray.scm \ + gnu/packages/statistics.scm \ gnu/packages/swig.scm \ gnu/packages/sxiv.scm \ gnu/packages/synergy.scm \ diff --git a/gnu/packages/statistics.scm b/gnu/packages/statistics.scm new file mode 100644 index 0000000000..acf7b7851d --- /dev/null +++ b/gnu/packages/statistics.scm @@ -0,0 +1,108 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ricardo Wurmus +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu packages statistics) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix utils) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages compression) + #:use-module (gnu packages gcc) + #:use-module (gnu packages gtk) + #:use-module (gnu packages icu4c) + #:use-module (gnu packages image) + #:use-module (gnu packages java) + #:use-module (gnu packages maths) + #:use-module (gnu packages pcre) + #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages readline) + #:use-module (gnu packages texlive) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages which) + #:use-module (gnu packages xorg)) + +(define-public r + (package + (name "r") + (version "3.1.2") + (source (origin + (method url-fetch) + (uri (string-append "mirror://cran/src/base/R-" + (version-prefix version 1) "/R-" + version ".tar.gz")) + (sha256 + (base32 + "0ypsm11c7n49pgh2ricyhhpfhas3famscdazzdp2zq70rapm1ldw")))) + (build-system gnu-build-system) + (arguments + `(#:phases + (alist-cons-before + 'check 'set-timezone + ;; Some tests require the timezone to be set. + (lambda _ (setenv "TZ" "UTC")) + %standard-phases) + #:configure-flags + '("--with-blas" + "--with-lapack" + "--with-cairo" + "--with-libpng" + "--with-jpeglib" + "--with-libtiff" + "--with-ICU" + "--enable-R-shlib" + "--enable-BLAS-shlib" + "--with-system-zlib" + "--with-system-bzlib" + "--with-system-pcre" + "--with-system-tre" + "--with-system-xz"))) + (native-inputs + `(("bzip2" ,bzip2) + ("perl" ,perl) + ("pkg-config" ,pkg-config) + ("texlive" ,texlive) ; needed to make vignettes + ("texinfo" ,texinfo) ; for building HTML manuals + ("which" ,which) ; for tests/Examples/base-Ex.R + ("xz" ,xz))) + (inputs + `(("atlas" ,atlas) ; --with-blas + ("cairo" ,cairo) + ("gfortran" ,gfortran-4.8) + ("icu4c" ,icu4c) + ("icedtea6" ,icedtea6) + ("lapack" ,lapack) + ("libjpeg" ,libjpeg) + ("libpng" ,libpng) + ("libtiff" ,libtiff) + ("libxt" ,libxt) + ("pcre" ,pcre) + ("readline" ,readline) + ("zlib" ,zlib))) + (home-page "http://www.r-project.org/") + (synopsis "Environment for statistical computing and graphics") + (description + "R is a language and environment for statistical computing and graphics. +It provides a variety of statistical techniques, such as linear and nonlinear +modeling, classical statistical tests, time-series analysis, classification +and clustering. It also provides robust support for producing +publication-quality data plots. A large amount of 3rd-party packages are +available, greatly increasing its breadth and scope.") + (license license:gpl3+))) diff --git a/guix/download.scm b/guix/download.scm index 9a1897525b..d87d02e2af 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -164,6 +164,16 @@ "ftp://ftp.nara.wide.ad.jp/pub/CPAN/" "http://mirrors.163.com/cpan/" "ftp://cpan.mirror.ac.za/") + (cran + ;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html + ;; This one automatically redirects to servers worldwide + "http://cran.rstudio.com/" + "http://cran.univ-lyon1.fr/" + "http://cran.r-mirror.de/" + "http://cran.ism.ac.jp/" + "http://cran.stat.auckland.ac.nz/" + "http://cran.mirror.ac.za/" + "http://cran.csie.ntu.edu.tw/") (imagemagick ;; from http://www.imagemagick.org/script/download.php ;; (without mirrors that are unavailable or not up to date) -- cgit v1.2.3 From 2d2a53fc24a3feb723772dfc45bb438256de41f9 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 22 Jan 2015 23:18:57 -0600 Subject: build-system/perl: Use Build.PL for builds if present. * guix/build/perl-build-system.scm (configure): Use Build.PL if present. (build, check, install): New procedures. (%standard-phases): Replace build, check, and install phases. * guix/build-system/perl (perl-build): Add make-maker? and module-build-flags arguments. * doc/guix.texi (Build Systems)[perl-build-system]: Document behavior rsp. Build.PL and new arguments. --- doc/guix.texi | 20 ++++++++++---- guix/build-system/perl.scm | 4 +++ guix/build/perl-build-system.scm | 59 ++++++++++++++++++++++++++++++++-------- 3 files changed, 65 insertions(+), 18 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 50a7084fec..ccb87c9443 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1894,12 +1894,20 @@ parameter. @defvr {Scheme Variable} perl-build-system This variable is exported by @code{(guix build-system perl)}. It -implements the standard build procedure for Perl packages, which -consists in running @code{perl Makefile.PL PREFIX=/gnu/store/@dots{}}, -followed by @code{make} and @code{make install}. - -The initial @code{perl Makefile.PL} invocation passes flags specified by -the @code{#:make-maker-flags} parameter. +implements the standard build procedure for Perl packages, which either +consists in running @code{perl Build.PL --prefix=/gnu/store/@dots{}}, +followed by @code{Build} and @code{Build install}; or in running +@code{perl Makefile.PL PREFIX=/gnu/store/@dots{}}, followed by +@code{make} and @code{make install}; depending on which of +@code{Build.PL} or @code{Makefile.PL} is present in the package +distribution. Preference is given to the former if both @code{Build.PL} +and @code{Makefile.PL} exist in the package distribution. This +preference can be reversed by specifying @code{#t} for the +@code{#:make-maker?} parameter. + +The initial @code{perl Makefile.PL} or @code{perl Build.PL} invocation +passes flags specified by the @code{#:make-maker-flags} or +@code{#:module-build-flags} parameter, respectively. Which Perl package is used can be specified with @code{#:perl}. @end defvr diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index c488adb500..e0f86438a8 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -75,7 +75,9 @@ (tests? #t) (parallel-build? #t) (parallel-tests? #t) + (make-maker? #f) (make-maker-flags ''()) + (module-build-flags ''()) (phases '(@ (guix build perl-build-system) %standard-phases)) (outputs '("out")) @@ -101,7 +103,9 @@ provides a `Makefile.PL' file as its build system." source)) #:search-paths ',(map search-path-specification->sexp search-paths) + #:make-maker? ,make-maker? #:make-maker-flags ,make-maker-flags + #:module-build-flags ,module-build-flags #:phases ,phases #:system ,system #:test-target "test" diff --git a/guix/build/perl-build-system.scm b/guix/build/perl-build-system.scm index 904daf7ac2..7eb944ccd1 100644 --- a/guix/build/perl-build-system.scm +++ b/guix/build/perl-build-system.scm @@ -29,22 +29,57 @@ ;; ;; Code: -(define* (configure #:key outputs (make-maker-flags '()) +(define* (configure #:key outputs make-maker? + (make-maker-flags '()) (module-build-flags '()) #:allow-other-keys) "Configure the given Perl package." - (let ((out (assoc-ref outputs "out"))) - (if (file-exists? "Makefile.PL") - (let ((args `("Makefile.PL" ,(string-append "PREFIX=" out) - "INSTALLDIRS=site" ,@make-maker-flags))) - (format #t "running `perl' with arguments ~s~%" args) - (zero? (apply system* "perl" args))) - (error "no Makefile.PL found")))) + (let* ((out (assoc-ref outputs "out")) + (args (cond + ;; Prefer to use Module::Build unless otherwise told + ((and (file-exists? "Build.PL") + (not make-maker?)) + `("Build.PL" ,(string-append "--prefix=" out) + "--installdirs=site" ,@module-build-flags)) + ((file-exists? "Makefile.PL") + `("Makefile.PL" ,(string-append "PREFIX=" out) + "INSTALLDIRS=site" ,@make-maker-flags)) + (else (error "no Build.PL or Makefile.PL found"))))) + (format #t "running `perl' with arguments ~s~%" args) + (zero? (apply system* "perl" args)))) + +(define-syntax-rule (define-w/gnu-fallback* (name args ...) body ...) + (define* (name args ... #:rest rest) + (if (access? "Build" X_OK) + (begin body ...) + (apply (assoc-ref gnu:%standard-phases 'name) rest)))) + +(define-w/gnu-fallback* (build) + (zero? (system* "./Build"))) + +(define-w/gnu-fallback* (check #:key target + (tests? (not target)) (test-flags '()) + #:allow-other-keys) + (if tests? + (zero? (apply system* "./Build" "test" test-flags)) + (begin + (format #t "test suite not run~%") + #t))) + +(define-w/gnu-fallback* (install) + (zero? (system* "./Build" "install"))) (define %standard-phases - ;; Everything is as with the GNU Build System except for the `configure' - ;; phase. - (alist-replace 'configure configure - gnu:%standard-phases)) + ;; Everything is as with the GNU Build System except for the `configure', + ;; `build', `check', and `install' phases. + (alist-replace + 'configure configure + (alist-replace + 'build build + (alist-replace + 'check check + (alist-replace + 'install install + gnu:%standard-phases))))) (define* (perl-build #:key inputs (phases %standard-phases) #:allow-other-keys #:rest args) -- cgit v1.2.3 From f8e366230d33c0ef5176ef9bc0f648869a59d06c Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Tue, 27 Jan 2015 22:43:21 -0600 Subject: guix: licenses: Add Artistic 2.0 license. * guix/licenses.scm (artistic2.0): New variable. --- guix/licenses.scm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index 86f3ae4e82..ef3f446212 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -28,7 +28,7 @@ cc0 cddl1.0 cecill-c - clarified-artistic + artistic2.0 clarified-artistic cpl1.0 epl1.0 expat @@ -129,6 +129,11 @@ which may be a file:// URI pointing the package's tree." "http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html" "https://www.gnu.org/licenses/license-list.html#CeCILL")) +(define artistic2.0 + (license "Artistic License 2.0" + "http://www.perlfoundation.org/artistic_license_2_0" + "http://www.gnu.org/licenses/license-list.html#ArtisticLicense2")) + (define clarified-artistic (license "Clarified Artistic" ;; http://directory.fsf.org/wiki/User:Jgay/license-categorization#Clarified_Artistic_License -- cgit v1.2.3 From 66392e475d4fa89760ec64d62c5d0c203e853866 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 12 Feb 2015 08:39:09 -0600 Subject: import: cpan: Use corelist to filter dependencies. * guix/import/cpan.scm (%corelist): New variable. (module->dist-name, core-module?): New procedures. (cpan-module->sexp)[convert-inputs]: Use them. Include "test" dependencies in converted inputs. * doc/guix.texi (Invoking guix import)[cpan]: Mention corelist filtering. --- doc/guix.texi | 7 ++++--- guix/import/cpan.scm | 50 ++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 44 insertions(+), 13 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index ccb87c9443..81b9353f1d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3089,9 +3089,10 @@ guix import pypi itsdangerous Import meta-data from @uref{https://www.metacpan.org/, MetaCPAN}. Information is taken from the JSON-formatted meta-data provided through @uref{https://api.metacpan.org/, MetaCPAN's API} and includes most -relevant information. License information should be checked closely. -Package dependencies are included but may in some cases needlessly -include core Perl modules. +relevant information, such as module dependencies. License information +should be checked closely. If Perl is available in the store, then the +@code{corelist} utility will be used to filter core modules out of the +list of dependencies. The command command below imports meta-data for the @code{Acme::Boolean} Perl module: diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 5f4602a8d2..c1b0006e8c 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -19,6 +19,8 @@ (define-module (guix import cpan) #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module ((ice-9 popen) #:select (open-pipe* close-pipe)) + #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (srfi srfi-1) #:use-module (json) #:use-module (guix hash) @@ -27,6 +29,9 @@ #:use-module ((guix download) #:select (download-to-store)) #:use-module (guix import utils) #:use-module (guix import json) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (gnu packages perl) #:export (cpan->guix-package)) ;;; Commentary: @@ -71,6 +76,14 @@ "Transform a 'module' name into a 'release' name" (regexp-substitute/global #f "::" module 'pre "-" 'post)) +(define (module->dist-name module) + "Return the base distribution module for a given module. E.g. the 'ok' +module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would +return \"Test-Simple\"" + (assoc-ref (json-fetch (string-append "http://api.metacpan.org/module/" + module)) + "distribution")) + (define (cpan-fetch module) "Return an alist representation of the CPAN metadata for the perl module MODULE, or #f on failure. MODULE should be e.g. \"Test::Script\"" @@ -84,6 +97,14 @@ or #f on failure. MODULE should be e.g. \"Test::Script\"" (define (cpan-home name) (string-append "http://search.cpan.org/dist/" name)) +(define %corelist + (let* ((perl (with-store store + (derivation->output-path + (package-derivation store perl)))) + (core (string-append perl "/bin/corelist"))) + (and (access? core X_OK) + core))) + (define (cpan-module->sexp meta) "Return the `package' s-expression for a CPAN module from the metadata in META." @@ -98,6 +119,17 @@ META." (define version (assoc-ref meta "version")) + (define (core-module? name) + (and %corelist + (parameterize ((current-error-port (%make-void-port "w"))) + (let* ((corelist (open-pipe* OPEN_READ %corelist name))) + (let loop ((line (read-line corelist))) + (if (eof-object? line) + (begin (close-pipe corelist) #f) + (if (string-contains line "first released with perl") + (begin (close-pipe corelist) #t) + (loop (read-line corelist))))))))) + (define (convert-inputs phases) ;; Convert phase dependencies into a list of name/variable pairs. (match (flatten @@ -112,15 +144,13 @@ META." (delete-duplicates ;; Listed dependencies may include core modules. Filter those out. (filter-map (match-lambda - ((or (module . "0") ("perl" . _)) - ;; TODO: A stronger test might to run MODULE through - ;; `corelist' from our perl package. This current test - ;; seems to be only a loose convention. + (("perl" . _) ;implicit dependency #f) ((module . _) - (let ((name (guix-name (module->name module)))) - (list name - (list 'unquote (string->symbol name)))))) + (and (not (core-module? module)) + (let ((name (guix-name (module->dist-name module)))) + (list name + (list 'unquote (string->symbol name))))))) inputs))))) (define (maybe-inputs guix-name inputs) @@ -147,12 +177,12 @@ META." ,(bytevector->nix-base32-string (file-sha256 tarball)))))) (build-system perl-build-system) ,@(maybe-inputs 'native-inputs - ;; "runtime" and "test" may also be needed here. See + ;; "runtime" may also be needed here. See ;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases, ;; which says they are required during building. We ;; have not yet had a need for cross-compiled perl - ;; modules, however, so we leave them out. - (convert-inputs '("configure" "build"))) + ;; modules, however, so we leave it out. + (convert-inputs '("configure" "build" "test"))) ,@(maybe-inputs 'inputs (convert-inputs '("runtime"))) (home-page ,(string-append "http://search.cpan.org/dist/" name)) -- cgit v1.2.3 From 2491d58962b67c7397147a75a005e78ba6312ec4 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Fri, 13 Feb 2015 21:33:02 -0600 Subject: import: cpan: Adjust licenses. * guix/import/cpan.scm (string->license): Add artistic2.0. Use '(package-license perl) for "perl_5" as is our convention. --- guix/import/cpan.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index c1b0006e8c..307681b6ce 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -49,7 +49,7 @@ ;; apache_1_1 ("apache_2_0" 'asl2.0) ;; artistic_1_0 - ;; artistic_2_0 + ("artistic_2_0" 'artistic2.0) ("bsd" 'bsd-3) ("freebsd" 'bsd-2) ;; gfdl_1_2 @@ -63,7 +63,7 @@ ;; mozilla_1_0 ("mozilla_1_1" 'mpl1.1) ("openssl" 'openssl) - ("perl_5" 'gpl1+) ;and Artistic 1 + ("perl_5" '(package-license perl)) ;GPL1+ and Artistic 1 ("qpl_1_0" 'qpl) ;; ssleay ;; sun -- cgit v1.2.3 From a0c2c4b45bb9c7b77f2b9a1562e791f1124cf93c Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Fri, 13 Feb 2015 21:34:40 -0600 Subject: import: cpan: Sort inputs. * guix/import/cpan.scm (cpan-module->sexp)[convert-inputs]: Sort returned list of inputs. --- guix/import/cpan.scm | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 307681b6ce..bd48c44b1a 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -141,17 +141,22 @@ META." (#f '()) ((inputs ...) - (delete-duplicates - ;; Listed dependencies may include core modules. Filter those out. - (filter-map (match-lambda - (("perl" . _) ;implicit dependency - #f) - ((module . _) - (and (not (core-module? module)) - (let ((name (guix-name (module->dist-name module)))) - (list name - (list 'unquote (string->symbol name))))))) - inputs))))) + (sort + (delete-duplicates + ;; Listed dependencies may include core modules. Filter those out. + (filter-map (match-lambda + (("perl" . _) ;implicit dependency + #f) + ((module . _) + (and (not (core-module? module)) + (let ((name (guix-name (module->dist-name module)))) + (list name + (list 'unquote (string->symbol name))))))) + inputs)) + (lambda args + (match args + (((a _ ...) (b _ ...)) + (string Date: Fri, 13 Feb 2015 21:35:48 -0600 Subject: import: cpan: Use cpan mirror url. * guix/import/cpan.scm (cpan-module->sexp)[source-url]: Substitute cpan mirror url. --- guix/import/cpan.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index bd48c44b1a..3dc6edab51 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -167,7 +167,9 @@ META." (list 'quasiquote inputs)))))) (define source-url - (assoc-ref meta "download_url")) + (regexp-substitute/global #f "http://cpan.metacpan.org" + (assoc-ref meta "download_url") + 'pre "mirror://cpan" 'post)) (let ((tarball (with-store store (download-to-store store source-url)))) -- cgit v1.2.3 From 04dec194d8e460831ec0695a944d9c7313affea2 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 18 Feb 2015 19:33:10 -0500 Subject: download: Handle HTTP redirects to relative URI references. Fixes . Reported by Ricardo Wurmus . * guix/build/download.scm: On Guile 2.0.11 or earlier, redefine the http "Location" header to accept relative URIs. (resolve-uri-reference): New exported procedure. (http-fetch): Use 'resolve-uri-reference' to resolve redirections. * guix/http-client.scm (http-fetch): Use 'resolve-uri-reference' --- guix/build/download.scm | 82 ++++++++++++++++++++++++++++++++++++++++++++++++- guix/http-client.scm | 4 ++- 2 files changed, 84 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index 5928ccd154..16afb1dce1 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +30,7 @@ #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (open-connection-for-uri + resolve-uri-reference maybe-expand-mirrors url-fetch progress-proc @@ -204,6 +206,84 @@ which is not available during bootstrap." (module-define! (resolve-module '(web client)) 'shutdown (const #f)) +;; XXX: Work around , present in Guile +;; up to 2.0.11. +(unless (or (> (string->number (major-version)) 2) + (> (string->number (minor-version)) 0) + (> (string->number (micro-version)) 11)) + (let ((declare-relative-uri-header! + (module-ref (resolve-module '(web http)) + 'declare-relative-uri-header!))) + (declare-relative-uri-header! "Location"))) + +(define (resolve-uri-reference ref base) + "Resolve the URI reference REF, interpreted relative to the BASE URI, into a +target URI, according to the algorithm specified in RFC 3986 section 5.2.2. +Return the resulting target URI." + + (define (merge-paths base-path rel-path) + (let* ((base-components (string-split base-path #\/)) + (base-directory-components (match base-components + ((components ... last) components) + (() '()))) + (base-directory (string-join base-directory-components "/"))) + (string-append base-directory "/" rel-path))) + + (define (remove-dot-segments path) + (let loop ((in + ;; Drop leading "." and ".." components from a relative path. + ;; (absolute paths will start with a "" component) + (drop-while (match-lambda + ((or "." "..") #t) + (_ #f)) + (string-split path #\/))) + (out '())) + (match in + (("." . rest) + (loop rest out)) + ((".." . rest) + (match out + ((or () ("")) + (error "remove-dot-segments: too many '..' components" path)) + (_ + (loop rest (cdr out))))) + ((component . rest) + (loop rest (cons component out))) + (() + (string-join (reverse out) "/"))))) + + (cond ((or (uri-scheme ref) + (uri-host ref)) + (build-uri (or (uri-scheme ref) + (uri-scheme base)) + #:userinfo (uri-userinfo ref) + #:host (uri-host ref) + #:port (uri-port ref) + #:path (remove-dot-segments (uri-path ref)) + #:query (uri-query ref) + #:fragment (uri-fragment ref))) + ((string-null? (uri-path ref)) + (build-uri (uri-scheme base) + #:userinfo (uri-userinfo base) + #:host (uri-host base) + #:port (uri-port base) + #:path (remove-dot-segments (uri-path base)) + #:query (or (uri-query ref) + (uri-query base)) + #:fragment (uri-fragment ref))) + (else + (build-uri (uri-scheme base) + #:userinfo (uri-userinfo base) + #:host (uri-host base) + #:port (uri-port base) + #:path (remove-dot-segments + (if (string-prefix? "/" (uri-path ref)) + (uri-path ref) + (merge-paths (uri-path base) + (uri-path ref)))) + #:query (uri-query ref) + #:fragment (uri-fragment ref))))) + (define (http-fetch uri file) "Fetch data from URI and write it to FILE. Return FILE on success." @@ -260,7 +340,7 @@ which is not available during bootstrap." file)) ((301 ; moved permanently 302) ; found (redirection) - (let ((uri (response-location resp))) + (let ((uri (resolve-uri-reference (response-location resp) uri))) (format #t "following redirection to `~a'...~%" (uri->string uri)) (close connection) diff --git a/guix/http-client.scm b/guix/http-client.scm index 4770628e45..aad7656e19 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2012 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Guix. @@ -29,6 +30,7 @@ #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) + #:use-module ((guix build download) #:select (resolve-uri-reference)) #:export (&http-get-error http-get-error? http-get-error-uri @@ -227,7 +229,7 @@ Raise an '&http-get-error' condition if downloading fails." (values data len))))) ((301 ; moved permanently 302) ; found (redirection) - (let ((uri (response-location resp))) + (let ((uri (resolve-uri-reference (response-location resp) uri))) (close-port port) (format #t (_ "following redirection to `~a'...~%") (uri->string uri)) -- cgit v1.2.3 From 431b28d9dc6767b4ecc14d6c7aac9d3fe56673f8 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Fri, 20 Feb 2015 16:20:38 -0500 Subject: import: cpan: Change %corelist into a promise. Fixes compilation failures in 'guix pull'. * guix/import/cpan.scm (%corelist): Change it to a promise by wrapping it with 'delay'. (cpan-module->sexp): Adapt uses of %corelist by wrapping with 'force'. --- guix/import/cpan.scm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 3dc6edab51..37dd3b162c 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Eric Bavier +;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -98,12 +99,13 @@ or #f on failure. MODULE should be e.g. \"Test::Script\"" (string-append "http://search.cpan.org/dist/" name)) (define %corelist - (let* ((perl (with-store store - (derivation->output-path - (package-derivation store perl)))) - (core (string-append perl "/bin/corelist"))) - (and (access? core X_OK) - core))) + (delay + (let* ((perl (with-store store + (derivation->output-path + (package-derivation store perl)))) + (core (string-append perl "/bin/corelist"))) + (and (access? core X_OK) + core)))) (define (cpan-module->sexp meta) "Return the `package' s-expression for a CPAN module from the metadata in @@ -120,9 +122,9 @@ META." (assoc-ref meta "version")) (define (core-module? name) - (and %corelist + (and (force %corelist) (parameterize ((current-error-port (%make-void-port "w"))) - (let* ((corelist (open-pipe* OPEN_READ %corelist name))) + (let* ((corelist (open-pipe* OPEN_READ (force %corelist) name))) (let loop ((line (read-line corelist))) (if (eof-object? line) (begin (close-pipe corelist) #f) -- cgit v1.2.3 From 12d720fd1a9c43019f2d5afa051b45c7633b3ab0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Feb 2015 23:41:26 +0100 Subject: tests: Factorize the network reachability test. * guix/tests.scm (network-reachable?): New procedure. * tests/builders.scm (network-reachable?): Remove. Replace references to it with calls to the new 'network-reachable?' procedure. * tests/derivations.scm (%coreutils): Use 'network-reachable?' instead of 'getaddrinfo'. * tests/packages.scm: Likewise. * tests/union.scm: Likewise. --- guix/tests.scm | 5 +++++ tests/builders.scm | 7 ++----- tests/derivations.scm | 2 +- tests/packages.scm | 6 ++---- tests/union.scm | 6 ++---- 5 files changed, 12 insertions(+), 14 deletions(-) (limited to 'guix') diff --git a/guix/tests.scm b/guix/tests.scm index 1171bb4dfb..d004a50a36 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -31,6 +31,7 @@ #:export (open-connection-for-tests random-text random-bytevector + network-reachable? mock %substitute-directory with-derivation-narinfo @@ -77,6 +78,10 @@ (loop (1+ i))) bv)))) +(define (network-reachable?) + "Return true if we can reach the Internet." + (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) + (define-syntax-rule (mock (module proc replacement) body ...) "Within BODY, replace the definition of PROC from MODULE with the definition given by REPLACEMENT." diff --git a/tests/builders.scm b/tests/builders.scm index e5acc3e038..3c2a3edc8e 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -56,16 +56,13 @@ (package-native-search-paths package))) (@@ (gnu packages commencement) %boot0-inputs))) -(define network-reachable? - (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) - (define url-fetch* (store-lower url-fetch)) (test-begin "builders") -(unless network-reachable? (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "url-fetch" (let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz" "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) @@ -97,7 +94,7 @@ (test-assert "gnu-build-system" (build-system? gnu-build-system)) -(unless network-reachable? (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "gnu-build" (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (hash (nix-base32-string->bytevector diff --git a/tests/derivations.scm b/tests/derivations.scm index e23bdeed77..72d253c465 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -463,7 +463,7 @@ (define %coreutils (false-if-exception - (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV) + (and (network-reachable?) (or (package-derivation %store %bootstrap-coreutils&co) (nixpkgs-derivation "coreutils"))))) diff --git a/tests/packages.scm b/tests/packages.scm index 851520b343..5725b0a8a9 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -176,8 +176,7 @@ (and (direct-store-path? source) (string-suffix? "utils.scm" source)))) -(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) - (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" @@ -532,8 +531,7 @@ (%current-target-system "foo64-linux-gnu")) (equal? drv (bag->derivation %store bag)))))) -(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) - (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "GNU Make, bootstrap" ;; GNU Make is the first program built during bootstrap; we choose it ;; here so that the test doesn't last for too long. diff --git a/tests/union.scm b/tests/union.scm index 7e55670b86..22ba67ce99 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -84,9 +84,7 @@ (call-with-input-file "bar/two" get-string-all)) (not (file-exists? "bar/one"))))))) -(test-skip (if (and %store - (false-if-exception - (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) +(test-skip (if (and %store (network-reachable?)) 0 1)) -- cgit v1.2.3 From b69c5c2ced1e41fdb5c2e747b1fb3a338ca63768 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 23 Feb 2015 23:52:28 +0100 Subject: tests: Skip tests that would fail due to the shebang length. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Daniel Kochmański . Fixes . * guix/tests.scm (shebang-too-long?): New procedure. * tests/builders.scm ("gnu-build"): Conditionalize on not (shebang-too-long?). * tests/packages.scm ("GNU Make, bootstrap"): Likewise. * tests/guix-package.sh (shebang_not_too_long): New function. Use it to determine whether to build 'gnu-make-boot0'. --- guix/tests.scm | 12 ++++++++++++ tests/builders.scm | 3 ++- tests/guix-package.sh | 13 +++++++++++-- tests/packages.scm | 3 ++- 4 files changed, 27 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/tests.scm b/guix/tests.scm index d004a50a36..0896e842da 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -32,6 +32,7 @@ random-text random-bytevector network-reachable? + shebang-too-long? mock %substitute-directory with-derivation-narinfo @@ -185,6 +186,17 @@ CONTENTS." (delete-file (string-append dir "/example.out")) (delete-file (string-append dir "/example.nar"))))) +(define (shebang-too-long?) + "Return true if the typical shebang in the current store would exceed +Linux's static limit---the BINPRM_BUF_SIZE constant, normally 128 characters +all included." + (define shebang + (string-append "#!" (%store-prefix) "/" + (make-string 32 #\a) + "-bootstrap-binaries-0/bin/bash\0")) + + (> (string-length shebang) 128)) + (define-syntax with-derivation-substitute (syntax-rules (sha256 =>) "Evaluate BODY in a context where DRV is substitutable with the given diff --git a/tests/builders.scm b/tests/builders.scm index 3c2a3edc8e..a7c3e42830 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -94,7 +94,8 @@ (test-assert "gnu-build-system" (build-system? gnu-build-system)) -(unless (network-reachable?) (test-skip 1)) +(when (or (not (network-reachable?)) (shebang-too-long?)) + (test-skip 1)) (test-assert "gnu-build" (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (hash (nix-base32-string->bytevector diff --git a/tests/guix-package.sh b/tests/guix-package.sh index d4917bbf90..94cf927420 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -28,6 +28,14 @@ readlink_base () basename `readlink "$1"` } +# Return true if a typical shebang in the store would not exceed Linux's +# default static limit. +shebang_not_too_long () +{ + test `echo $NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bootstrap-binaries-0/bin/bash | wc -c` \ + -lt 128 +} + module_dir="t-guix-package-$$" profile="t-profile-$$" rm -f "$profile" @@ -55,8 +63,9 @@ test -f "$profile/bin/guile" guix package --search-paths -p "$profile" test "`guix package --search-paths -p "$profile" | wc -l`" = 0 -# Check whether we have network access. -if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null +# Check whether we have network access and an acceptable shebang length. +if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null \ + && shebang_not_too_long then boot_make="(@@ (gnu packages commencement) gnu-make-boot0)" boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`" diff --git a/tests/packages.scm b/tests/packages.scm index 5725b0a8a9..d6371b3b49 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -531,7 +531,8 @@ (%current-target-system "foo64-linux-gnu")) (equal? drv (bag->derivation %store bag)))))) -(unless (network-reachable?) (test-skip 1)) +(when (or (not (network-reachable?)) (shebang-too-long?)) + (test-skip 1)) (test-assert "GNU Make, bootstrap" ;; GNU Make is the first program built during bootstrap; we choose it ;; here so that the test doesn't last for too long. -- cgit v1.2.3 From 6d5e7ef3ae45584fd4f6e1c0374ceabf1c826b3c Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Tue, 24 Feb 2015 16:09:30 +0100 Subject: licenses: Add IPA Font License. * guix/licenses.scm (ipa): New variable. --- guix/licenses.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index ef3f446212..157e74bf37 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2014 Ludovic Courtès -;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013, 2015 Andreas Enge ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -39,6 +39,7 @@ ijg ibmpl1.0 imlib2 + ipa lgpl2.0 lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3 lgpl3+ mpl1.1 mpl2.0 ncsa @@ -215,6 +216,11 @@ which may be a file:// URI pointing the package's tree." "http://directory.fsf.org/wiki/License:Imlib2" "https://www.gnu.org/licenses/license-list#imlib")) +(define ipa + (license "IPA Font License" + "http://directory.fsf.org/wiki/License:IPA_Font_License" + "https://www.gnu.org/licenses/license-list#IPAFONT")) + (define lgpl2.0 (license "LGPL 2.0" "https://www.gnu.org/licenses/old-licenses/lgpl-2.0.html" -- cgit v1.2.3 From 6e1a7d17f4be26f6ec5bfca49c353218811bc71e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 24 Feb 2015 23:42:32 +0100 Subject: guix system: Honor '--no-grub'. Reported by Alex Kost at . * guix/scripts/system.scm (%options) : Use 'alist-cons' instead of 'alist-delete'. --- guix/scripts/system.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 3eea872fe8..b15bb8bb0d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -446,7 +446,7 @@ Build the operating system declared in FILE according to ACTION.\n")) result))) (option '("no-grub") #f #f (lambda (opt name arg result) - (alist-delete 'install-grub? result))) + (alist-cons 'install-grub? #f result))) (option '("full-boot") #f #f (lambda (opt name arg result) (alist-cons 'full-boot? #t result))) -- cgit v1.2.3 From c964a15d8239d28144be51868868aa21d5d4ddce Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 24 Feb 2015 19:58:13 -0500 Subject: download: Cope with Guile 2.0.6 or earlier. * guix/build/download.scm: Do not attempt to support relative URIs in "Location" headers if 'declare-relative-uri-header!' is not present. This is the case for Guile 2.0.6 or earlier. --- guix/build/download.scm | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/download.scm b/guix/build/download.scm index 16afb1dce1..e8d61e0d92 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -211,10 +211,12 @@ which is not available during bootstrap." (unless (or (> (string->number (major-version)) 2) (> (string->number (minor-version)) 0) (> (string->number (micro-version)) 11)) - (let ((declare-relative-uri-header! - (module-ref (resolve-module '(web http)) - 'declare-relative-uri-header!))) - (declare-relative-uri-header! "Location"))) + (let ((var (module-variable (resolve-module '(web http)) + 'declare-relative-uri-header!))) + ;; If 'declare-relative-uri-header!' doesn't exist, forget it. + (when (and var (variable-bound? var)) + (let ((declare-relative-uri-header! (variable-ref var))) + (declare-relative-uri-header! "Location"))))) (define (resolve-uri-reference ref base) "Resolve the URI reference REF, interpreted relative to the BASE URI, into a -- cgit v1.2.3 From b3f213893b67620840597213b8f46af1ddfb4934 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 25 Feb 2015 23:31:51 +0100 Subject: ui: Factorize command-line + env. var. option parsing. * guix/ui.scm (%default-argument-handler, parse-command-line): New procedures. (environment-build-options): Make private. * guix/scripts/archive.scm (guix-archive)[parse-options, parse-options-from]: Remove. Use 'parse-command-line' instead. * guix/scripts/build.scm (guix-build): Likewise. * guix/scripts/environment.scm (guix-environment): Likewise. * guix/scripts/package.scm (guix-package): Likewise. * guix/scripts/system.scm (guix-system): Likewise. * tests/ui.scm (with-environment-variable): New macro. ("parse-command-line"): New test. --- guix/scripts/archive.scm | 16 +--------------- guix/scripts/build.scm | 17 ++--------------- guix/scripts/environment.scm | 18 ++++-------------- guix/scripts/package.scm | 24 +++++++----------------- guix/scripts/system.scm | 34 +++++++++++++--------------------- guix/ui.scm | 28 +++++++++++++++++++++++++++- tests/ui.scm | 31 +++++++++++++++++++++++++++++++ 7 files changed, 85 insertions(+), 83 deletions(-) (limited to 'guix') diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index b85119a0ff..ea6801a6eb 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -297,20 +297,6 @@ the input port." (cut write-acl acl <>))))) (define (guix-archive . args) - (define (parse-options) - ;; Return the alist of option values. - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) - - (define (parse-options-from args) - ;; Actual parsing takes place here. - (args-fold* args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - (define (lines port) ;; Return lines read from PORT. (let loop ((line (read-line port)) @@ -324,7 +310,7 @@ the input port." ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) - (let ((opts (parse-options))) + (let ((opts (parse-command-line args %options (list %default-options)))) (cond ((assoc-ref opts 'generate-key) => generate-key-pair) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 07ced30484..370c2a37ff 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -405,25 +405,12 @@ arguments with packages that use the specified source." ;;; (define (guix-build . args) - (define (parse-options) - ;; Return the alist of option values. - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) - - (define (parse-options-from args) - ;; Actual parsing takes place here. - (args-fold* args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'argument arg result)) - %default-options)) - (with-error-handling ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) - (let* ((opts (parse-options)) + (let* ((opts (parse-command-line args %options + (list %default-options))) (store (open-connection)) (drv (options->derivations store opts)) (roots (filter-map (match-lambda diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index bb2ce53caf..c96ca351c4 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -217,22 +217,12 @@ packages." ;; Entry point. (define (guix-environment . args) - (define (parse-options) - ;; Return the alist of option values. - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) - - (define (parse-options-from args) - ;; Actual parsing takes place here. - (args-fold* args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (alist-cons 'package arg result)) - %default-options)) + (define (handle-argument arg result) + (alist-cons 'package arg result)) (with-store store - (let* ((opts (parse-options)) + (let* ((opts (parse-command-line args %options (list %default-options) + #:argument-handler handle-argument)) (pure? (assoc-ref opts 'pure)) (command (assoc-ref opts 'exec)) (inputs (packages->transitive-inputs diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index fc116d8f6c..c27207f29a 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -692,22 +692,11 @@ doesn't need it." ;;; (define (guix-package . args) - (define (parse-options) - ;; Return the alist of option values. - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) - - (define (parse-options-from args) - ;; Actual parsing takes place here. - (args-fold* args %options - (lambda (opt name arg result arg-handler) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result arg-handler) - (if arg-handler - (arg-handler arg result) - (leave (_ "~A: extraneous argument~%") arg))) - %default-options - #f)) + (define (handle-argument arg result arg-handler) + ;; Process non-option argument ARG by calling back ARG-HANDLER. + (if arg-handler + (arg-handler arg result) + (leave (_ "~A: extraneous argument~%") arg))) (define (ensure-default-profile) ;; Ensure the default profile symlink and directory exist and are @@ -987,7 +976,8 @@ more information.~%")) (_ #f)))) - (let ((opts (parse-options))) + (let ((opts (parse-command-line args %options (list %default-options #f) + #:argument-handler handle-argument))) (with-error-handling (or (process-query opts) (parameterize ((%store (open-connection))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index b15bb8bb0d..1b64e6fb92 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -487,26 +487,15 @@ Build the operating system declared in FILE according to ACTION.\n")) ;;; (define (guix-system . args) - (define (parse-options) - ;; Return the alist of option values. - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) - - (define (parse-options-from args) - ;; Actual parsing takes place here. - (args-fold* args %options - (lambda (opt name arg result) - (leave (_ "~A: unrecognized option~%") name)) - (lambda (arg result) - (if (assoc-ref result 'action) - (alist-cons 'argument arg result) - (let ((action (string->symbol arg))) - (case action - ((build vm vm-image disk-image reconfigure init) - (alist-cons 'action action result)) - (else (leave (_ "~a: unknown action~%") - action)))))) - %default-options)) + (define (parse-sub-command arg result) + ;; Parse sub-command ARG and augment RESULT accordingly. + (if (assoc-ref result 'action) + (alist-cons 'argument arg result) + (let ((action (string->symbol arg))) + (case action + ((build vm vm-image disk-image reconfigure init) + (alist-cons 'action action result)) + (else (leave (_ "~a: unknown action~%") action)))))) (define (match-pair car) ;; Return a procedure that matches a pair with CAR. @@ -534,7 +523,10 @@ Build the operating system declared in FILE according to ACTION.\n")) args)) (with-error-handling - (let* ((opts (parse-options)) + (let* ((opts (parse-command-line args %options + (list %default-options) + #:argument-handler + parse-sub-command)) (args (option-arguments opts)) (file (first args)) (action (assoc-ref opts 'action)) diff --git a/guix/ui.scm b/guix/ui.scm index 382b5b1e0d..09cb6f48ff 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -66,7 +66,7 @@ string->generations string->duration args-fold* - environment-build-options + parse-command-line run-guix-command program-name guix-warning-port @@ -754,6 +754,32 @@ reporting." "Return additional build options passed as environment variables." (arguments-from-environment-variable "GUIX_BUILD_OPTIONS")) +(define %default-argument-handler + ;; The default handler for non-option command-line arguments. + (lambda (arg result) + (alist-cons 'argument arg result))) + +(define* (parse-command-line args options seeds + #:key + (argument-handler %default-argument-handler)) + "Parse the command-line arguments ARGS as well as arguments passed via the +'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of +SRFI-37 options) and return the result, seeded by SEEDS. +Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'. + +ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc' +parameter of 'args-fold'." + (define (parse-options-from args) + ;; Actual parsing takes place here. + (apply args-fold* args options + (lambda (opt name arg . rest) + (leave (_ "~A: unrecognized option~%") name)) + argument-handler + seeds)) + + (append (parse-options-from args) + (parse-options-from (environment-build-options)))) + (define (show-guix-usage) (format (current-error-port) (_ "Try `guix --help' for more information.~%")) diff --git a/tests/ui.scm b/tests/ui.scm index 25fc709431..c71fc71cc1 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -22,6 +22,8 @@ #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) + #:use-module ((guix scripts build) + #:select (%standard-build-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -52,9 +54,34 @@ interface, and powerful string processing.") (item "/gnu/store/...") (output "out"))) +(define-syntax-rule (with-environment-variable variable value body ...) + "Run BODY with VARIABLE set to VALUE." + (let ((orig (getenv variable))) + (dynamic-wind + (lambda () + (setenv variable value)) + (lambda () + body ...) + (lambda () + (if orig + (setenv variable orig) + (unsetenv variable)))))) + (test-begin "ui") +(test-equal "parse-command-line" + '((argument . "bar") (argument . "foo") + (cores . 10) ;takes precedence + (substitutes? . #f) (keep-failed? . #t) + (max-jobs . 77) (cores . 42)) + + (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77" + (parse-command-line '("--keep-failed" "--no-substitutes" + "--cores=10" "foo" "bar") + %standard-build-options + (list '())))) + (test-assert "fill-paragraph" (every (lambda (column) (every (lambda (width) @@ -246,3 +273,7 @@ Second line" 24)) (exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) +;;; End: -- cgit v1.2.3 From cf6ce3e6ef96abc36a40293b2d9f732d462d2a94 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 00:00:04 +0100 Subject: ui: Honor --no-* options passed via $GUIX_BUILD_OPTIONS. Reported by Alex Kost at . * guix/ui.scm (parse-command-line)[parse-options-from]: Add 'seeds' parameter. Thread the result of the first 'parse-options-from' call to the second. --- guix/ui.scm | 10 +++++++--- tests/ui.scm | 9 +++++++++ 2 files changed, 16 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 09cb6f48ff..9558d38ca8 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -769,7 +769,7 @@ Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'. ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc' parameter of 'args-fold'." - (define (parse-options-from args) + (define (parse-options-from args seeds) ;; Actual parsing takes place here. (apply args-fold* args options (lambda (opt name arg . rest) @@ -777,8 +777,12 @@ parameter of 'args-fold'." argument-handler seeds)) - (append (parse-options-from args) - (parse-options-from (environment-build-options)))) + (call-with-values + (lambda () + (parse-options-from (environment-build-options) seeds)) + (lambda seeds + ;; ARGS take precedence over what the environment variable specifies. + (parse-options-from args seeds)))) (define (show-guix-usage) (format (current-error-port) diff --git a/tests/ui.scm b/tests/ui.scm index c71fc71cc1..1478fe213e 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -82,6 +82,15 @@ interface, and powerful string processing.") %standard-build-options (list '())))) +(test-equal "parse-command-line and --no options" + '((argument . "foo") + (substitutes? . #f)) ;takes precedence + + (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes" + (parse-command-line '("foo") + %standard-build-options + (list '((substitutes? . #t)))))) + (test-assert "fill-paragraph" (every (lambda (column) (every (lambda (width) -- cgit v1.2.3 From e9c1e22f0445a54837e1a545475698f08c8f50bc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 26 Feb 2015 00:02:51 +0100 Subject: ui: Add missing copyright line. * guix/ui.scm: Add copyright line for Deck (aka. nebuli). --- guix/ui.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 9558d38ca8..ae37c8e6ca 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2014 Alex Kost +;;; Copyright © 2014 Deck Pickard ;;; ;;; This file is part of GNU Guix. ;;; -- cgit v1.2.3