Re: ASDF, Windows, symlinks

(I inadvertently sent my reply to Kevin Layer via SMTP, though I
normally read cclan-list via gmane.  So I'm resending this through
gmane; sorry about the double-post, to anybody who gets this twice.)

Kevin Layer writes:
> Richard M Kreuter <[email protected]> wrote:
> 
> >> In any case, it's possible to control where compiled files go by
> >> supplying a custom method for ASDF:OUTPUT-FILES, so you need not
> >> build a tree of symlinks to keep outputs separate from inputs.
> 
> This is simply a non-starter.  I have dozens of imported .asd files
> and I don't want to modify them all (or any of them).

You can define a single, global :AFTER method for OUTPUT-FILES outside
of any .asd file.

> >> Now, I think it's worth pointing out that any change to ASDF that
> >> moves symlink resolution out of ASDF:DEFSYSTEM will not be upwardly
> >> compatible for people who use a custom system search routine that
> >> relies on the symlink resolution inside ASDF:DEFSYSTEM.
> 
> I'm not sure this would help me.  I'll check, though.

It does, if you also push a function that looks for .asd files using
*DEFAULT-PATHNAME-DEFAULTS* before searching the *CENTRAL-REGISTRY*.
(As mentioned, this is an incompatible change for other kinds of system
searches, however.)


$ cd /tmp
$ diff -u asdf.lisp.orig asdf.lisp
--- asdf.lisp.orig	2008-02-15 18:04:35.000000000 -0500
+++ asdf.lisp	2008-02-19 10:25:48.445307232 -0500
@@ -359,6 +359,8 @@
     #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
     #+nil "telent:asdf;systems;"))
 
+(defvar *sysdef-pathname*)
+
 (defun sysdef-central-registry-search (system)
   (let ((name (coerce-name system)))
     (block nil
@@ -369,7 +371,7 @@
                            :defaults defaults :version :newest
                            :name name :type "asd" :case :local))))
           (if (and file (probe-file file))
-              (return file)))))))
+              (return (resolve-symlinks file))))))))
 
 (defun make-temporary-package ()
   (flet ((try (counter)
@@ -389,7 +391,8 @@
                    (< (car in-memory) (file-write-date on-disk))))
       (let ((package (make-temporary-package)))
         (unwind-protect
-             (let ((*package* package))
+             (let ((*package* package)
+                   (*sysdef-pathname* on-disk))
                (format
                 *verbose-out*
                 "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
@@ -1005,10 +1008,9 @@
                                     ;; to avoid a note about unreachable code
                                     ,(if pathname-arg-p
                                          pathname
-                                         `(or (when *load-truename*
+                                         `(or (when *sysdef-pathname*
                                                 (pathname-sans-name+type
-                                                 (resolve-symlinks
-                                                  *load-truename*)))
+                                                 *sysdef-pathname*))
                                               *default-pathname-defaults*))
                                     ',component-options))))))
$ mkdir real-files
$ cat > real-files/my-system.asd
(defsystem my-system
  :components ((:file "my-file")))

$ cat > real-files/my-file.lisp
(in-package "CL-USER")
(defun foo () :foo)
$ mkdir symlinks
$ cd symlinks
$ ln -s ../real-files/my-file.lisp 
$ ln -s ../real-files/my-system.asd
$ ls
my-file.lisp  my-system.asd
$ sbcl --noinform
* (let ((*error-output* (make-broadcast-stream))) (load "../asdf.lisp"))

T
* (defun default-pathname-defaults-search (system-name)
  (let* ((name (asdf::coerce-name system-name))
         (pathname (make-pathname
                    :defaults *default-pathname-defaults*
                    :name name :type "asd" :version :newest
                    :case :local)))
    ;; PROBE-FILE resolves symlinks on some implementations, so don't
    ;; return what PROBE-FILE does, but just use it as an indicator of
    ;; whether the file exists.
    (when (probe-file pathname)
      pathname)))

DEFAULT-PATHNAME-DEFAULTS-SEARCH
* (push 'default-pathname-defaults-search asdf::*system-definition-search-functions*)

(DEFAULT-PATHNAME-DEFAULTS-SEARCH ASDF::SYSDEF-CENTRAL-REGISTRY-SEARCH)
* (asdf:find-system "my-system")

#<ASDF:SYSTEM "my-system" {5144D971}>
* (describe *)

#<ASDF:SYSTEM "my-system" {5144D971}>
is an instance of class #<STANDARD-CLASS ASDF:SYSTEM>.
The following slots have :INSTANCE allocation:
 NAME                       "my-system"
 VERSION                    #<unbound slot>
 IN-ORDER-TO                NIL
 DO-FIRST                   ((ASDF:COMPILE-OP (ASDF:LOAD-OP)))
 INLINE-METHODS             NIL
 PARENT                     NIL
 RELATIVE-PATHNAME          #P"/tmp/symlinks/"
 OPERATION-TIMES            #<HASH-TABLE :TEST EQL :COUNT 0 {5144DBB9}>
 PROPERTIES                 NIL
 COMPONENTS                 (#<ASDF:CL-SOURCE-FILE "my-file" {514E4631}>)
 IF-COMPONENT-DEP-FAILS     :FAIL
 DEFAULT-COMPONENT-CLASS    NIL
 DESCRIPTION                #<unbound slot>
 LONG-DESCRIPTION           #<unbound slot>
 AUTHOR                     #<unbound slot>
 MAINTAINER                 #<unbound slot>
 LICENCE                    #<unbound slot>
* (asdf:oos 'asdf:compile-op "my-system")

; compiling file "/tmp/real-files/my-file.lisp" (written 19 FEB 2008 10:27:15 AM):
; compiling (IN-PACKAGE "CL-USER")
; compiling (DEFUN FOO ...)

; /tmp/symlinks/my-file.fasl written
; compilation finished in 0:00:00
NIL
*   C-c C-z
[1]+  Stopped                 sbcl --noinform
$ ls -l
total 4
-rw-r--r--  1 kreuter kreuter 1887 2008-02-19 10:31 my-file.fasl
lrwxrwxrwx  1 kreuter kreuter   26 2008-02-19 10:27 my-file.lisp -> ../real-files/my-file.lisp
lrwxrwxrwx  1 kreuter kreuter   27 2008-02-19 10:27 my-system.asd -> ../real-files/my-system.asd


-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/