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
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?)))))
 
 
 ;;;

Reply via email to