From ee2a7e3fd293b80d3b7f9b9a7949b8a74b2f0575 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 13 Dec 2015 21:04:56 +0100 Subject: guix build: Remove dead code. * guix/scripts/build.scm (options->things-to-build): Remove unused 'match' clause. --- guix/scripts/build.scm | 2 -- 1 file changed, 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8ecd9560ed..debf7c2848 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -424,8 +424,6 @@ (define ensure-list (ensure-list (read/eval str))) (('argument . (? derivation? drv)) drv) - (('argument . (? derivation-path? drv)) - (list )) (_ '())) opts)) -- cgit v1.2.3 From 20464dde13dc540951edc035d1af5d9fd756f2d1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 13 Dec 2015 21:13:16 +0100 Subject: guix build: Gracefully handle type errors in -e and -f. * guix/scripts/build.scm (options->things-to-build)[validate-type]: New procedure. [ensure-list]: Use it. --- guix/scripts/build.scm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index debf7c2848..a6596d0a82 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -404,10 +404,16 @@ (define %options (define (options->things-to-build opts) "Read the arguments from OPTS and return a list of high-level objects to build---packages, gexps, derivations, and so on." - (define ensure-list - (match-lambda - ((x ...) x) - (x (list x)))) + (define (validate-type x) + (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x)) + (leave (_ "~s: not something we can build~%") x))) + + (define (ensure-list x) + (let ((lst (match x + ((x ...) x) + (x (list x))))) + (for-each validate-type lst) + lst)) (append-map (match-lambda (('argument . (? string? spec)) -- cgit v1.2.3 From 4fef1e850e4872f2bc7c1f0a10cbac176b50895f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 14 Dec 2015 19:24:22 +0100 Subject: profiles: Silence Info installation. * guix/profiles.scm (info-dir-file)[build]: Pass --silent to 'install-info'. --- guix/profiles.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index c222f4115d..ce6b2c4f42 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -469,7 +469,7 @@ (define (info-files top) (define (install-info info) (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files (zero? - (system* (string-append #+texinfo "/bin/install-info") + (system* (string-append #+texinfo "/bin/install-info") "--silent" info (string-append #$output "/share/info/dir")))) (mkdir-p (string-append #$output "/share/info")) -- cgit v1.2.3 From 9d3994f70095b46b95e6d05562f32c25be326772 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 14 Dec 2015 19:52:47 +0100 Subject: gexp: 'local-file' resolves relative file names. * guix/gexp.scm (): Rename constructor to '%%local-file'. Add 'absolute' field. (%local-file, extract-directory, absolute-file-name): New procedures. (current-source-directory): New macro. (local-file): Adjust call to '%local-file'. (local-file-absolute-file-name): New procedure. (local-file-compiler): Force the 'absolute' field. * tests/guix-system.sh: Test whether 'local-file' canonicalization works. * doc/guix.texi (G-Expressions): Adjust. --- doc/guix.texi | 5 ++-- guix/gexp.scm | 66 ++++++++++++++++++++++++++++++++++++++++++---------- tests/guix-system.sh | 32 +++++++++++++++++++++++-- 3 files changed, 87 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index 29cea5cef8..07668e917f 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3489,8 +3489,9 @@ content is directly passed as a string. @deffn {Scheme Procedure} local-file @var{file} [@var{name}] @ [#:recursive? #t] Return an object representing local file @var{file} to add to the store; this -object can be used in a gexp. @var{file} will be added to the store under @var{name}--by -default the base name of @var{file}. +object can be used in a gexp. If @var{file} is a relative file name, it is looked +up relative to the source file where this form appears. @var{file} will be added to +the store under @var{name}--by default the base name of @var{file}. When @var{recursive?} is true, the contents of @var{file} are added recursively; if @var{file} designates a flat file and @var{recursive?} is true, its contents are added, and its diff --git a/guix/gexp.scm b/guix/gexp.scm index 14ced747b2..35adc179a1 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -35,6 +35,7 @@ (define-module (guix gexp) local-file local-file? local-file-file + local-file-absolute-file-name local-file-name local-file-recursive? @@ -182,35 +183,76 @@ (define-gexp-compiler (derivation-compiler (drv derivation?) system target) ;;; File declarations. ;;; +;; A local file name. FILE is the file name the user entered, which can be a +;; relative file name, and ABSOLUTE is a promise that computes its canonical +;; absolute file name. We keep it in a promise to compute it lazily and avoid +;; repeated 'stat' calls. (define-record-type - (%local-file file name recursive?) + (%%local-file file absolute name recursive?) local-file? (file local-file-file) ;string + (absolute %local-file-absolute-file-name) ;promise string (name local-file-name) ;string (recursive? local-file-recursive?)) ;Boolean -(define* (local-file file #:optional (name (basename file)) - #:key recursive?) +(define* (%local-file file promise #:optional (name (basename file)) + #:key recursive?) + ;; This intermediate procedure is part of our ABI, but the underlying + ;; %%LOCAL-FILE is not. + (%%local-file file promise name recursive?)) + +(define (extract-directory properties) + "Extract the directory name from source location PROPERTIES." + (match (assq 'filename properties) + (('filename . (? string? file-name)) + (dirname file-name)) + (_ + #f))) + +(define-syntax-rule (current-source-directory) + "Expand to the directory of the current source file or #f if it could not +be determined." + (extract-directory (current-source-location))) + +(define (absolute-file-name file directory) + "Return the canonical absolute file name for FILE, which lives in the +vicinity of DIRECTORY." + (canonicalize-path + (cond ((string-prefix? "/" file) file) + ((not directory) file) + ((string-prefix? "/" directory) + (string-append directory "/" file)) + (else file)))) + +(define-syntax-rule (local-file file rest ...) "Return an object representing local file FILE to add to the store; this -object can be used in a gexp. FILE will be added to the store under NAME--by -default the base name of FILE. +object can be used in a gexp. If FILE is a relative file name, it is looked +up relative to the source file where this form appears. FILE will be added to +the store under NAME--by default the base name of FILE. When RECURSIVE? is true, the contents of FILE are added recursively; if FILE designates a flat file and RECURSIVE? is true, its contents are added, and its permission bits are kept. This is the declarative counterpart of the 'interned-file' monadic procedure." - ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing to - ;; do that, when RECURSIVE? is #t, we could end up creating a dangling - ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would just - ;; throw an error, both of which are inconvenient. - (%local-file (canonicalize-path file) name recursive?)) + (%local-file file + (delay (absolute-file-name file (current-source-directory))) + rest ...)) + +(define (local-file-absolute-file-name file) + "Return the absolute file name for FILE, a instance. A +'system-error' exception is raised if FILE could not be found." + (force (%local-file-absolute-file-name file))) (define-gexp-compiler (local-file-compiler (file local-file?) system target) ;; "Compile" FILE by adding it to the store. (match file - (($ file name recursive?) - (interned-file file name #:recursive? recursive?)))) + (($ file (= force absolute) name recursive?) + ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing + ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling + ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would + ;; just throw an error, both of which are inconvenient. + (interned-file absolute name #:recursive? recursive?)))) (define-record-type (%plain-file name content references) diff --git a/tests/guix-system.sh b/tests/guix-system.sh index e20bc98713..02e2524d9e 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -17,7 +17,7 @@ # along with GNU Guix. If not, see . # -# Test the daemon and its interaction with 'guix substitute'. +# Test 'guix system', mostly error reporting. # set -e @@ -26,7 +26,15 @@ guix system --version tmpfile="t-guix-system-$$" errorfile="t-guix-system-error-$$" -trap 'rm -f "$tmpfile" "$errorfile"' EXIT + +# Note: This directory is chosen outside $builddir so that relative file name +# canonicalization doesn't mess up with 'current-source-directory', used by +# 'local-file' ('load' forces 'relative' for +# %FILE-PORT-NAME-CANONICALIZATION.) +tmpdir="${TMPDIR:-/tmp}/t-guix-system-$$" +mkdir "$tmpdir" + +trap 'rm -f "$tmpfile" "$errorfile" "$tmpdir"/*; rmdir "$tmpdir"' EXIT # Reporting of syntax errors. @@ -180,3 +188,23 @@ make_user_config "users" "group-that-does-not-exist" if guix system build "$tmpfile" -n 2> "$errorfile" then false else grep "supplementary group.*group-that-does-not-exist.*undeclared" "$errorfile"; fi + +# Try 'local-file' and relative file name resolution. + +cat > "$tmpdir/config.scm"< "$tmpdir/my-torrc"< Date: Sun, 20 Dec 2015 14:34:36 +0100 Subject: packages: Add 'package-transitive-native-search-paths'. * guix/packages.scm (package-transitive-native-search-paths): New procedure. * tests/packages.scm ("package-transitive-native-search-paths"): New test. --- guix/packages.scm | 12 ++++++++++++ tests/packages.scm | 21 +++++++++++++++++++++ 2 files changed, 33 insertions(+) (limited to 'guix') diff --git a/guix/packages.scm b/guix/packages.scm index 68fb0916d8..41f3e20c41 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -89,6 +89,7 @@ (define-module (guix packages) package-transitive-target-inputs package-transitive-native-inputs package-transitive-propagated-inputs + package-transitive-native-search-paths package-transitive-supported-systems package-source-derivation package-derivation @@ -632,6 +633,17 @@ (define (package-transitive-propagated-inputs package) recursively." (transitive-inputs (package-propagated-inputs package))) +(define (package-transitive-native-search-paths package) + "Return the list of search paths for PACKAGE and its propagated inputs, +recursively." + (append (package-native-search-paths package) + (append-map (match-lambda + ((label (? package? p) _ ...) + (package-native-search-paths p)) + (_ + '())) + (package-transitive-propagated-inputs package)))) + (define (transitive-input-references alist inputs) "Return a list of (assoc-ref ALIST