[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/08: utils: 'current-source-directory' resolves relative file names at
From: |
Ludovic Courtès |
Subject: |
03/08: utils: 'current-source-directory' resolves relative file names at run time. |
Date: |
Sun, 19 Jun 2016 22:53:14 +0000 (UTC) |
civodul pushed a commit to branch master
in repository guix.
commit cbbbb7be0fbaa11ff75bce92f2d82131ff8db104
Author: Ludovic Courtès <address@hidden>
Date: Sun Jun 19 22:15:15 2016 +0200
utils: 'current-source-directory' resolves relative file names at run time.
* guix/utils.scm (absolute-dirname): New procedure.
(current-source-directory): Emit code to use it instead of calling
'search-path'.
---
guix/utils.scm | 20 +++++++++++++++++---
1 file changed, 17 insertions(+), 3 deletions(-)
diff --git a/guix/utils.scm b/guix/utils.scm
index a642bd3..0e20be3 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -702,6 +702,18 @@ output port, and PROC's result is returned."
;;; Source location.
;;;
+(define (absolute-dirname file)
+ "Return the absolute name of the directory containing FILE, or #f upon
+failure."
+ (match (search-path %load-path file)
+ (#f #f)
+ ((? string? file)
+ ;; If there are relative names in %LOAD-PATH, FILE can be relative and
+ ;; needs to be canonicalized.
+ (if (string-prefix? "/" file)
+ (dirname file)
+ (canonicalize-path (dirname file))))))
+
(define-syntax current-source-directory
(lambda (s)
"Return the absolute name of the current directory, or #f if it could not
@@ -711,11 +723,13 @@ be determined."
(match (assq 'filename (syntax-source s))
(('filename . (? string? file-name))
;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME
- ;; can be relative. In that case, we try to find out the absolute
- ;; file name by looking at %LOAD-PATH.
+ ;; can be relative. In that case, we try to find out at run time
+ ;; the absolute file name by looking at %LOAD-PATH; doing this at
+ ;; run time rather than expansion time is necessary to allow files
+ ;; to be moved on the file system.
(if (string-prefix? "/" file-name)
(dirname file-name)
- (and=> (search-path %load-path file-name) dirname)))
+ #`(absolute-dirname #,file-name)))
(_
#f))))))
- branch master updated (3ebba94 -> ca7a68e), Ludovic Courtès, 2016/06/19
- 01/08: services: Add 'gc-root-service-type'., Ludovic Courtès, 2016/06/19
- 08/08: tests: Fix list of exports in (gnu tests)., Ludovic Courtès, 2016/06/19
- 02/08: store: 'register-path' no longer swallows 'system-error' exceptions., Ludovic Courtès, 2016/06/19
- 04/08: utils: 'current-source-directory' gracefully handles lack of source info., Ludovic Courtès, 2016/06/19
- 06/08: tests: Strengthen regexp in 'packages.scm'., Ludovic Courtès, 2016/06/19
- 07/08: tests: Export 'run-basic-test'., Ludovic Courtès, 2016/06/19
- 05/08: gnu: guix: Add 'current-guix' thunk., Ludovic Courtès, 2016/06/19
- 03/08: utils: 'current-source-directory' resolves relative file names at run time.,
Ludovic Courtès <=