Noé Lopez wrote 1 months ago
(address . guix-patches@gnu.org)(name . Noé Lopez)(address . noe@xn--no-cja.eu)
From: Noé Lopez <noelopez@free.fr>
The comparison would fail if the load path for guix was not already
canonicalized, since it is doing a string comparison.
* gnu/packages.scm (%patch-path): Canonicalize paths before
comparing.
* guix/ui.scm (try-canonicalize-path): Move to (guix utils).
* guix/utils.scm (try-canonicalize-path): New function.
Change-Id: Id5d51ce483af74ac4e122563d84cc3e8d78c3246
---
gnu/packages.scm | 11 ++++++-----
guix/ui.scm | 14 --------------
guix/utils.scm | 15 +++++++++++++++
3 files changed, 21 insertions(+), 19 deletions(-)
Toggle diff (84 lines)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index bdd5d21940..d043d0616d 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -167,11 +167,12 @@ (define %patch-path
;; Define it after '%package-module-path' so that '%load-path' contains user
;; directories, allowing patches in $GUIX_PACKAGE_PATH to be found.
(make-parameter
- (map (lambda (directory)
- (if (string=? directory %distro-root-directory)
- (string-append directory "/gnu/packages/patches")
- directory))
- %load-path)))
+ (let ((root (try-canonicalize-path %distro-root-directory)))
+ (map (lambda (directory)
+ (if (string=? (try-canonicalize-path directory) root)
+ (string-append directory "/gnu/packages/patches")
+ directory))
+ %load-path))))
;; This procedure is used by Emacs-Guix up to 0.5.1.1, so keep it for now.
;; See <https://github.com/alezost/guix.el/issues/30>.
diff --git a/guix/ui.scm b/guix/ui.scm
index 87a448bf72..a3a9bf4e42 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -206,20 +206,6 @@ (define-syntax-rule (without-compiler-optimizations exp)
(parameterize (((@ (system base compile) default-optimization-level) 1))
exp))
-(define (try-canonicalize-path file)
- "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path'
-throws.
-
-This is necessary for corner cases where 'canonicalize-path' fails. One
-example is on Linux when a /dev/fd/N file denotes a pipe, represented as a
-symlink to a non-existent file like 'pipe:[1234]', as in this example:
-
- sh -c 'stat $(readlink -f /dev/fd/1)' | cat"
- (catch 'system-error
- (lambda ()
- (canonicalize-path file))
- (const file)))
-
(define* (load* file user-module
#:key (on-error 'nothing-special))
"Load the user provided Scheme source code FILE."
diff --git a/guix/utils.scm b/guix/utils.scm
index b6cf5aea4f..6e5b6b6caf 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -162,6 +162,7 @@ (define-module (guix utils)
compressed-output-port
call-with-compressed-output-port
canonical-newline-port
+ try-canonicalize-path
string-distance
string-closest
@@ -1150,6 +1151,20 @@ (define (canonical-newline-port port)
get-position
set-position!
close))
+
+(define (try-canonicalize-path file)
+ "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path'
+throws.
+
+This is necessary for corner cases where 'canonicalize-path' fails. One
+example is on Linux when a /dev/fd/N file denotes a pipe, represented as a
+symlink to a non-existent file like 'pipe:[1234]', as in this example:
+
+ sh -c 'stat $(readlink -f /dev/fd/1)' | cat"
+ (catch 'system-error
+ (lambda ()
+ (canonicalize-path file))
+ (const file)))
;;;
;;; Source location.
base-commit: 9c36d38614079611aebe4721b9e087f98e57b1b3
--
2.48.1