From: Nigko Yerden <nigko.yerden@gmail.com>
To: "pelzflorian (Florian Pelz)" <pelzflorian@pelzflorian.de>
Cc: Attila Lendvai <attila@lendvai.name>, guix-devel@gnu.org
Subject: Re: Cookbook recipe from "The Repository as a Channel" section does not work for Guix with properly configured GUILE_LOAD_PATH
Date: Wed, 28 Aug 2024 17:36:58 +0500 [thread overview]
Message-ID: <cb3417f8-1a85-423b-9af6-37e351b34250@gmail.com> (raw)
In-Reply-To: <87le0jsm56.fsf@pelzflorian.de>
[-- Attachment #1: Type: text/plain, Size: 921 bytes --]
Hello Florian,
pelzflorian (Florian Pelz) wrote:
> Still, when would your diff break someone else’s code?
Instead of answering this tough question I decided to make another
patch (see attachment) which is guaranteed not to break another's code:
- The patch adds 'follow-symlinks?' argument to 'current-source-directory'
macro and 'absolute-dirname' procedure.
- In case of 'current-source-directory' the argument is optional and defaults
to #f. Thus new API is backward compatible with the old one.
- In case of 'absolute-dirname' the argument is mandatory, but this procedure
is internal to (guix utils) module and therefore the modification does not
change public API. The usage of 'absolute-dirname' inside this module
(only two occurrences) is corrected accordingly.
- 'local-file' macro from (guix gexp) uses 'current-source-directory' with
follow-symlinks? argument set to #t.
Regards,
Nigko
[-- Attachment #2: diff3 --]
[-- Type: text/plain, Size: 3790 bytes --]
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 74b4c49f90..5911ca4815 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -508,7 +508,7 @@ (define-syntax local-file
(string? (syntax->datum #'file))
;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file
- (delay (absolute-file-name file (current-source-directory)))
+ (delay (absolute-file-name file (current-source-directory #t)))
rest ...))
((_ (assume-valid-file-name file) rest ...)
;; FILE is not a literal, so resolve it relative to the current
diff --git a/guix/utils.scm b/guix/utils.scm
index d8ce6ed886..b5fcf8cb28 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1110,41 +1110,47 @@ (define (canonical-newline-port port)
(define (%guix-source-root-directory)
"Return the source root directory of the Guix found in %load-path."
- (dirname (absolute-dirname "guix/packages.scm")))
+ (dirname (absolute-dirname "guix/packages.scm" #f)))
(define absolute-dirname
;; Memoize to avoid repeated 'stat' storms from 'search-path'.
- (mlambda (file)
+ (mlambda (file follow-symlinks?)
"Return the absolute name of the directory containing FILE, or #f upon
-failure."
+failure. Follow symlinks if FOLLOW-SYMLINKS? is true."
(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)))))))
+ (if follow-symlinks?
+ (dirname (canonicalize-path 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
-be determined."
+be determined. Do not follow symlinks if FOLLOW-SYMLINKS? is false (the default)."
+ (define (source-directory follow-symlinks?)
+ (match (assq 'filename (or (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 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 (if follow-symlinks?
+ (canonicalize-path file-name)
+ file-name))
+ #`(absolute-dirname #,file-name #,follow-symlinks?)))
+ ((or ('filename . #f) #f)
+ ;; raising an error would upset Geiser users
+ #f)))
(syntax-case s ()
- ((_)
- (match (assq 'filename (or (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 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)
- #`(absolute-dirname #,file-name)))
- ((or ('filename . #f) #f)
- ;; raising an error would upset Geiser users
- #f))))))
+ ((_) (source-directory #f))
+ ((_ follow-symlinks?) (source-directory #'follow-symlinks?)))))
\f
;;;
next prev parent reply other threads:[~2024-08-28 12:37 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-08-13 12:45 Cookbook recipe from "The Repository as a Channel" section does not work for Guix with properly configured GUILE_LOAD_PATH Nigko Yerden
2024-08-13 14:38 ` pelzflorian (Florian Pelz)
2024-08-13 15:06 ` Nigko Yerden
2024-08-13 17:25 ` pelzflorian (Florian Pelz)
2024-08-13 17:49 ` Nigko Yerden
2024-08-14 15:35 ` pelzflorian (Florian Pelz)
2024-08-14 16:40 ` pelzflorian (Florian Pelz)
2024-08-14 19:29 ` pelzflorian (Florian Pelz)
2024-08-15 4:11 ` Nigko Yerden
2024-08-18 21:33 ` pelzflorian (Florian Pelz)
2024-08-19 7:43 ` Nigko Yerden
2024-08-19 19:28 ` pelzflorian (Florian Pelz)
2024-08-20 7:18 ` Nigko Yerden
2024-08-20 16:49 ` pelzflorian (Florian Pelz)
2024-08-22 4:45 ` pelzflorian (Florian Pelz)
2024-08-22 9:53 ` Nigko Yerden
2024-08-22 13:22 ` Nigko Yerden
2024-08-22 16:00 ` pelzflorian (Florian Pelz)
2024-08-23 5:07 ` Nigko Yerden
2024-08-23 15:47 ` pelzflorian (Florian Pelz)
2024-08-23 16:25 ` pelzflorian (Florian Pelz)
2024-08-24 14:47 ` Nigko Yerden
2024-08-26 8:50 ` pelzflorian (Florian Pelz)
2024-08-28 12:36 ` Nigko Yerden [this message]
2024-08-28 16:40 ` pelzflorian (Florian Pelz)
2024-08-29 6:17 ` Nigko Yerden
2024-08-19 9:30 ` Nigko Yerden
2024-08-19 16:17 ` Nigko Yerden
2024-08-14 14:00 ` Attila Lendvai
2024-08-15 16:34 ` Nigko Yerden
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=cb3417f8-1a85-423b-9af6-37e351b34250@gmail.com \
--to=nigko.yerden@gmail.com \
--cc=attila@lendvai.name \
--cc=guix-devel@gnu.org \
--cc=pelzflorian@pelzflorian.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).